File Coverage

blib/lib/YAML/Syck.pm
Criterion Covered Total %
statement 67 92 72.8
branch 24 32 75.0
condition 2 6 33.3
subroutine 13 13 100.0
pod 0 5 0.0
total 106 148 71.6


line stmt bran cond sub pod time code
1             package YAML::Syck;
2              
3             # See documentation after the __END__ mark.
4              
5 32     32   14340 use strict;
  32         48  
  32         1543  
6 32         4273 use vars qw(
7             @ISA @EXPORT @EXPORT_OK $VERSION
8             $Headless $SortKeys $SingleQuote
9             $ImplicitBinary $ImplicitTyping $ImplicitUnicode
10             $UseCode $LoadCode $DumpCode
11             $DeparseObject $LoadBlessed
12 32     32   134 );
  32         37  
13 32     32   764 use 5.006;
  32         83  
  32         1127  
14 32     32   135 use Exporter;
  32         49  
  32         4606  
15              
16             BEGIN {
17 32     32   76 $VERSION = '1.29_01';
18 32         78 @EXPORT = qw( Dump Load DumpFile LoadFile );
19 32         63 @EXPORT_OK = qw( DumpInto );
20 32         309 @ISA = qw( Exporter );
21              
22 32         63 $SortKeys = 1;
23 32         44 $LoadBlessed = 1;
24              
25 32         40 local $@;
26             eval {
27 32         148 require XSLoader;
28 32         19510 XSLoader::load( __PACKAGE__, $VERSION );
29 32         9633 1;
30 32 50       43 } or do {
31 0         0 require DynaLoader;
32 0         0 push @ISA, 'DynaLoader';
33 0         0 __PACKAGE__->bootstrap($VERSION);
34             };
35              
36             }
37              
38             use constant QR_MAP => {
39 0         0 '' => sub { qr{$_[0]} },
40 0         0 x => sub { qr{$_[0]}x },
41 0         0 i => sub { qr{$_[0]}i },
42 0         0 s => sub { qr{$_[0]}s },
43 0         0 m => sub { qr{$_[0]}m },
44 0         0 ix => sub { qr{$_[0]}ix },
45 0         0 sx => sub { qr{$_[0]}sx },
46 0         0 mx => sub { qr{$_[0]}mx },
47 0         0 si => sub { qr{$_[0]}si },
48 0         0 mi => sub { qr{$_[0]}mi },
49 0         0 ms => sub { qr{$_[0]}sm },
50 0         0 six => sub { qr{$_[0]}six },
51 0         0 mix => sub { qr{$_[0]}mix },
52 0         0 msx => sub { qr{$_[0]}msx },
53 0         0 msi => sub { qr{$_[0]}msi },
54 0         0 msix => sub { qr{$_[0]}msix },
55 32     32   195 };
  32         88  
  32         23106  
56              
57             sub __qr_helper {
58 4 50   4   33 if ( $_[0] =~ /\A \(\? ([ixsm]*) (?:- (?:[ixsm]*))? : (.*) \) \z/x ) {
59 0   0     0 my $sub = QR_MAP()->{$1} || QR_MAP()->{''};
60 0         0 &$sub($2);
61             }
62             else {
63 4         94 qr/$_[0]/;
64             }
65             }
66              
67             sub Dump {
68 6         112 $#_
69 616 100   616 0 86699 ? join( '', map { YAML::Syck::DumpYAML($_) } @_ )
70             : YAML::Syck::DumpYAML( $_[0] );
71             }
72              
73             sub Load {
74 793 100   793 0 119271 if (wantarray) {
75 150         7965 my ($rv) = YAML::Syck::LoadYAML( $_[0] );
76 150         212 @{$rv};
  150         860  
77             }
78             else {
79 643         1129 @_ = $_[0];
80 643         19643 goto &YAML::Syck::LoadYAML;
81             }
82             }
83              
84             sub _is_glob {
85 27     27   35 my $h = shift;
86              
87 27 100       108 return 1 if ( ref($h) eq 'GLOB' );
88 14 100       64 return 1 if ( ref( \$h ) eq 'GLOB' );
89 9 100       54 return 1 if ( ref($h) =~ m/^IO::/ );
90              
91 6         19 return;
92             }
93              
94             sub DumpFile {
95 6     6 0 8579 my $file = shift;
96 6 100       14 if ( _is_glob($file) ) {
97 5         12 for (@_) {
98 5         147 my $err = YAML::Syck::DumpYAMLFile( $_, $file );
99 5 50       21 if ($err) {
100 0         0 $! = 0 + $err;
101 0         0 die "Error writing to filehandle $file: $!\n";
102             }
103             }
104             }
105             else {
106 1 50       106 open( my $fh, '>', $file ) or die "Cannot write to $file: $!";
107 1         4 for (@_) {
108 1         81 my $err = YAML::Syck::DumpYAMLFile( $_, $fh );
109 1 50       5 if ($err) {
110 0         0 $! = 0 + $err;
111 0         0 die "Error writing to file $file: $!\n";
112             }
113             }
114 1 50       45 close $fh
115             or die "Error writing to file $file: $!\n";
116             }
117 6         35 return 1;
118             }
119              
120             sub LoadFile {
121 11     11 0 8411 my $file = shift;
122 11 100       21 if ( _is_glob($file) ) {
123             Load(
124 8         8 do { local $/; <$file> }
  8         21  
  8         171  
125             );
126             }
127             else {
128 3 100 66     80 if ( !-e $file || -z $file ) {
129 1         16 die("'$file' is empty or non-existent");
130             }
131 2 50       55 open( my $fh, '<', $file ) or die "Cannot read from $file: $!";
132             Load(
133 2         4 do { local $/; <$fh> }
  2         9  
  2         44  
134             );
135             }
136             }
137              
138             sub DumpInto {
139 8     8 0 46 my $bufref = shift;
140 8 50       17 ( ref $bufref ) or die "DumpInto not given reference to output buffer\n";
141 8         276 YAML::Syck::DumpYAMLInto( $_, $bufref ) for @_;
142 8         12 1;
143             }
144              
145             1;
146              
147             __END__