File Coverage

blib/lib/YAML.pm
Criterion Covered Total %
statement 58 61 95.0
branch 14 20 70.0
condition 1 3 33.3
subroutine 14 14 100.0
pod 6 8 75.0
total 93 106 87.7


line stmt bran cond sub pod time code
1             package YAML;
2             our $VERSION = '1.28_001';
3              
4 48     48   1820227 use YAML::Mo;
  48         128  
  48         236  
5              
6 48     48   293 use Exporter;
  48         85  
  48         8426  
7             push @YAML::ISA, 'Exporter';
8             our @EXPORT = qw{ Dump Load };
9             our @EXPORT_OK = qw{ freeze thaw DumpFile LoadFile Bless Blessed };
10             our (
11             $UseCode, $DumpCode, $LoadCode,
12             $SpecVersion,
13             $UseHeader, $UseVersion, $UseBlock, $UseFold, $UseAliases,
14             $Indent, $SortKeys, $Preserve,
15             $AnchorPrefix, $CompressSeries, $InlineSeries, $Purity,
16             $Stringify, $Numify, $LoadBlessed,
17             );
18              
19             $LoadBlessed = 1;
20              
21              
22 48     48   17966 use YAML::Node; # XXX This is a temp fix for Module::Build
  48         114  
  48         2491  
23 48     48   307 use Scalar::Util qw/ openhandle /;
  48         88  
  48         2736  
24              
25             # XXX This VALUE nonsense needs to go.
26 48     48   279 use constant VALUE => "\x07YAML\x07VALUE\x07";
  48         80  
  48         13042  
27              
28             # YAML Object Properties
29             has dumper_class => default => sub {'YAML::Dumper'};
30             has loader_class => default => sub {'YAML::Loader'};
31             has dumper_object => default => sub {$_[0]->init_action_object("dumper")};
32             has loader_object => default => sub {$_[0]->init_action_object("loader")};
33              
34             sub Dump {
35 158     158 1 227885 my $yaml = YAML->new;
36 158 50       545 $yaml->dumper_class($YAML::DumperClass)
37             if $YAML::DumperClass;
38 158         474 return $yaml->dumper_object->dump(@_);
39             }
40              
41             sub Load {
42 320     320 1 446177 my $yaml = YAML->new;
43 320 50       877 $yaml->loader_class($YAML::LoaderClass)
44             if $YAML::LoaderClass;
45 320         845 return $yaml->loader_object->load(@_);
46             }
47              
48             {
49 48     48   353 no warnings 'once';
  48         121  
  48         27320  
50             # freeze/thaw is the API for Storable string serialization. Some
51             # modules make use of serializing packages on if they use freeze/thaw.
52             *freeze = \ &Dump;
53             *thaw = \ &Load;
54             }
55              
56             sub DumpFile {
57 5     5 1 26701 my $OUT;
58 5         37 my $filename = shift;
59 5 100       73 if (openhandle $filename) {
60 2         6 $OUT = $filename;
61             }
62             else {
63 3         9 my $mode = '>';
64 3 50       18 if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
65 0         0 ($mode, $filename) = ($1, $2);
66             }
67 3 100       324 open $OUT, $mode, $filename
68             or YAML::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, "$!");
69             }
70 4         55 binmode $OUT, ':utf8'; # if $Config{useperlio} eq 'define';
71 4         55 local $/ = "\n"; # reset special to "sane"
72 4         63 print $OUT Dump(@_);
73 4 50       68 unless (ref $filename eq 'GLOB') {
74             close $OUT
75 4 50       286 or do {
76 0         0 my $errsav = $!;
77 0         0 YAML::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT_CLOSE', $filename, $errsav);
78             }
79             }
80             }
81              
82             sub LoadFile {
83 5     5 1 19165 my $IN;
84 5         43 my $filename = shift;
85 5 100       65 if (openhandle $filename) {
86 2         11 $IN = $filename;
87             }
88             else {
89 3 100       128 open $IN, '<', $filename
90             or YAML::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, "$!");
91             }
92 4         39 binmode $IN, ':utf8'; # if $Config{useperlio} eq 'define';
93 4         10 return Load(do { local $/; <$IN> });
  4         44  
  4         28702  
94             }
95              
96             sub init_action_object {
97 478     478 0 676 my $self = shift;
98 478         860 my $object_class = (shift) . '_class';
99 478         1396 my $module_name = $self->$object_class;
100 478         24309 eval "require $module_name";
101 478 50 33     2147 $self->die("Error in require $module_name - $@")
102             if $@ and "$@" !~ /Can't locate/;
103 478         1733 my $object = $self->$object_class->new;
104 478         1873 $object->set_global_options;
105 478         2079 return $object;
106             }
107              
108             my $global = {};
109             sub Bless {
110 4     4 1 6280 require YAML::Dumper::Base;
111 4         20 YAML::Dumper::Base::bless($global, @_)
112             }
113             sub Blessed {
114 1     1 1 8 require YAML::Dumper::Base;
115 1         5 YAML::Dumper::Base::blessed($global, @_)
116             }
117 509     509 0 1242 sub global_object { $global }
118              
119             1;