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   24472 use strict;
  32         6668  
  32         3101  
6 32         6293 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   175 );
  32         60  
13 32     32   837 use 5.006;
  32         121  
  32         1866  
14 32     32   246 use Exporter;
  32         61  
  32         12650  
15              
16             BEGIN {
17 32     32   72 $VERSION = '1.28_01';
18 32         249 @EXPORT = qw( Dump Load DumpFile LoadFile );
19 32         92 @EXPORT_OK = qw( DumpInto );
20 32         533 @ISA = qw( Exporter );
21              
22 32         82 $SortKeys = 1;
23 32         62 $LoadBlessed = 1;
24              
25 32         62 local $@;
26             eval {
27 32         188 require XSLoader;
28 32         33438 XSLoader::load( __PACKAGE__, $VERSION );
29 32         14249 1;
30 32 50       73 } 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   254 };
  32         135  
  32         36839  
56              
57             sub __qr_helper {
58 4 50   4   25 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         122 qr/$_[0]/;
64             }
65             }
66              
67             sub Dump {
68 6         152 $#_
69 616 100   616 0 129457 ? join( '', map { YAML::Syck::DumpYAML($_) } @_ )
70             : YAML::Syck::DumpYAML( $_[0] );
71             }
72              
73             sub Load {
74 793 100   793 0 141460 if (wantarray) {
75 150         9993 my ($rv) = YAML::Syck::LoadYAML( $_[0] );
76 150         302 @{$rv};
  150         1124  
77             }
78             else {
79 643         1369 @_ = $_[0];
80 643         28416 goto &YAML::Syck::LoadYAML;
81             }
82             }
83              
84             sub _is_glob {
85 27     27   45 my $h = shift;
86              
87 27 100       125 return 1 if ( ref($h) eq 'GLOB' );
88 14 100       58 return 1 if ( ref( \$h ) eq 'GLOB' );
89 9 100       56 return 1 if ( ref($h) =~ m/^IO::/ );
90              
91 6         20 return;
92             }
93              
94             sub DumpFile {
95 6     6 0 27838 my $file = shift;
96 6 100       45 if ( _is_glob($file) ) {
97 5         16 for (@_) {
98 5         322 my $err = YAML::Syck::DumpYAMLFile( $_, $file );
99 5 50       31 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       350 open( my $fh, '>', $file ) or die "Cannot write to $file: $!";
107 1         4 for (@_) {
108 1         259 my $err = YAML::Syck::DumpYAMLFile( $_, $fh );
109 1 50       7 if ($err) {
110 0         0 $! = 0 + $err;
111 0         0 die "Error writing to file $file: $!\n";
112             }
113             }
114 1 50       220 close $fh
115             or die "Error writing to file $file: $!\n";
116             }
117 6         52 return 1;
118             }
119              
120             sub LoadFile {
121 11     11 0 12610 my $file = shift;
122 11 100       31 if ( _is_glob($file) ) {
123             Load(
124 8         13 do { local $/; <$file> }
  8         24  
  8         2176  
125             );
126             }
127             else {
128 3 100 66     136 if ( !-e $file || -z $file ) {
129 1         13 die("'$file' is empty or non-existent");
130             }
131 2 50       104 open( my $fh, '<', $file ) or die "Cannot read from $file: $!";
132             Load(
133 2         4 do { local $/; <$fh> }
  2         8  
  2         93  
134             );
135             }
136             }
137              
138             sub DumpInto {
139 8     8 0 46 my $bufref = shift;
140 8 50       28 ( ref $bufref ) or die "DumpInto not given reference to output buffer\n";
141 8         428 YAML::Syck::DumpYAMLInto( $_, $bufref ) for @_;
142 8         21 1;
143             }
144              
145             1;
146              
147             __END__