File Coverage

blib/lib/YAML/Safe.pm
Criterion Covered Total %
statement 36 51 70.5
branch 3 4 75.0
condition 1 3 33.3
subroutine 9 10 90.0
pod n/a
total 49 68 72.0


line stmt bran cond sub pod time code
1 50     50   321896 use strict; use warnings;
  50     50   149  
  50         1366  
  50         289  
  50         116  
  50         4015  
2              
3             package YAML::Safe;
4             our $VERSION = '0.82';
5             our $XS_VERSION = $VERSION;
6             $VERSION = eval $VERSION;
7              
8 50     50   348 use base 'Exporter';
  50         142  
  50         1391  
9             @YAML::Safe::EXPORT = qw(Load Dump);
10             @YAML::Safe::EXPORT_OK = qw(LoadFile DumpFile);
11             %YAML::Safe::EXPORT_TAGS = (
12             all => [qw(Dump Load LoadFile DumpFile)],
13             );
14              
15 50     50   404 use XSLoader;
  50         109  
  50         36641  
16              
17             # XXX The following code should be moved from Perl to C.
18             $YAML::Safe::coderef2text = sub {
19             my $coderef = shift;
20             require B::Deparse;
21             my $deparse = B::Deparse->new();
22             my $text;
23             eval {
24             local $^W = 0;
25             $text = $deparse->coderef2text($coderef);
26             };
27             if ($@) {
28             warn "YAML::Safe failed to dump code ref:\n$@";
29             return;
30             }
31             $text =~ s[BEGIN \{\$\{\^WARNING_BITS\} = "UUUUUUUUUUUU\\001"\}]
32             [use warnings;]g;
33              
34             return $text;
35             };
36              
37             $YAML::Safe::glob2hash = sub {
38             my $hash = {};
39             for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
40             my $value = *{$_[0]}{$type};
41             $value = $$value if $type eq 'SCALAR';
42             if (defined $value) {
43             if ($type eq 'IO') {
44             my @stats = qw(device inode mode links uid gid rdev size
45             atime mtime ctime blksize blocks);
46             undef $value;
47             $value->{stat} = {};
48             map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
49             $value->{fileno} = fileno(*{$_[0]});
50             {
51             local $^W;
52             $value->{tell} = tell(*{$_[0]});
53             }
54             }
55             $hash->{$type} = $value;
56             }
57             }
58             return $hash;
59             };
60              
61 5         66 use constant _QR_MAP => {
62 0         0 '' => sub { qr{$_[0]} },
63 0         0 x => sub { qr{$_[0]}x },
64 0         0 i => sub { qr{$_[0]}i },
65 0         0 s => sub { qr{$_[0]}s },
66 0         0 m => sub { qr{$_[0]}m },
67 0         0 ix => sub { qr{$_[0]}ix },
68 0         0 sx => sub { qr{$_[0]}sx },
69 0         0 mx => sub { qr{$_[0]}mx },
70 1         12 si => sub { qr{$_[0]}si },
71 0         0 mi => sub { qr{$_[0]}mi },
72 0         0 ms => sub { qr{$_[0]}sm },
73 0         0 six => sub { qr{$_[0]}six },
74 0         0 mix => sub { qr{$_[0]}mix },
75 0         0 msx => sub { qr{$_[0]}msx },
76 2         57 msi => sub { qr{$_[0]}msi },
77 50     50   402 msix => sub { qr{$_[0]}msix },
  50         101  
  50         18912  
78             };
79              
80 11 100   11   16507 sub __qr_loader {
81 8         38 if ($_[0] =~ /\A \(\? ([\^uixsm]*) (?:- (?:[ixsm]*))? : (.*) \) \z/x) {
82 8         34 my ($flags, $re) = ($1, $2);
83 8         23 $flags =~ s/^\^//;
84 8   33     34 $flags =~ tr/u//d;
85 8         34 my $sub = _QR_MAP->{$flags} || _QR_MAP->{''};
86 8         26928 my $qr = &$sub($re);
87             return $qr;
88 3         101 }
89             return qr/$_[0]/;
90             }
91              
92 5     5   544 sub __code_loader {
93 5     2   366 my ($string) = @_;
  2     1   624  
  2         17  
  2         51  
  1         5  
  1         2  
  1         44  
94 5 50       22 my $sub = eval "sub $string";
95 0         0 if ($@) {
96 0     0   0 warn "YAML::Safe failed to load sub: $@";
97             return sub {};
98 5         111 }
99             return $sub;
100             }
101              
102             XSLoader::load 'YAML::Safe', $XS_VERSION;
103              
104             1;
105             __END__