File Coverage

inc/YAML.pm
Criterion Covered Total %
statement 37 57 64.9
branch 4 16 25.0
condition 1 3 33.3
subroutine 9 14 64.2
pod 6 8 75.0
total 57 98 58.1


line stmt bran cond sub pod time code
1 2     2   1198 #line 1
  2         5  
  2         90  
2             use 5.008001;
3 2     2   1341 package YAML;
  2         7  
  2         12  
4             use YAML::Mo;
5              
6             our $VERSION = '0.80';
7 2     2   11  
  2         3  
  2         170  
8             use Exporter;
9             push @YAML::ISA, 'Exporter';
10             our @EXPORT = qw{ Dump Load };
11             our @EXPORT_OK = qw{ freeze thaw DumpFile LoadFile Bless Blessed };
12 2     2   1269  
  2         6  
  2         132  
13             use YAML::Node; # XXX This is a temp fix for Module::Build
14              
15 2     2   14 # XXX This VALUE nonsense needs to go.
  2         5  
  2         625  
16             use constant VALUE => "\x07YAML\x07VALUE\x07";
17              
18             # YAML Object Properties
19             has dumper_class => default => sub {'YAML::Dumper'};
20             has loader_class => default => sub {'YAML::Loader'};
21             has dumper_object => default => sub {$_[0]->init_action_object("dumper")};
22             has loader_object => default => sub {$_[0]->init_action_object("loader")};
23              
24 0     0 1 0 sub Dump {
25 0 0       0 my $yaml = YAML->new;
26             $yaml->dumper_class($YAML::DumperClass)
27 0         0 if $YAML::DumperClass;
28             return $yaml->dumper_object->dump(@_);
29             }
30              
31 2     2 1 28 sub Load {
32 2 50       9 my $yaml = YAML->new;
33             $yaml->loader_class($YAML::LoaderClass)
34 2         11 if $YAML::LoaderClass;
35             return $yaml->loader_object->load(@_);
36             }
37              
38 2     2   11 {
  2         3  
  2         1199  
39             no warnings 'once';
40             # freeze/thaw is the API for Storable string serialization. Some
41             # modules make use of serializing packages on if they use freeze/thaw.
42             *freeze = \ &Dump;
43             *thaw = \ &Load;
44             }
45              
46 0     0 1 0 sub DumpFile {
47 0         0 my $OUT;
48 0 0       0 my $filename = shift;
49 0         0 if (ref $filename eq 'GLOB') {
50             $OUT = $filename;
51             }
52 0         0 else {
53 0 0       0 my $mode = '>';
54 0         0 if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
55             ($mode, $filename) = ($1, $2);
56 0 0       0 }
57             open $OUT, $mode, $filename
58             or YAML::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, $!);
59 0         0 }
60 0         0 binmode $OUT, ':utf8'; # if $Config{useperlio} eq 'define';
61 0         0 local $/ = "\n"; # reset special to "sane"
62             print $OUT Dump(@_);
63             }
64              
65 2     2 1 14 sub LoadFile {
66 2         5 my $IN;
67 2 50       14 my $filename = shift;
68 0         0 if (ref $filename eq 'GLOB') {
69             $IN = $filename;
70             }
71 2 50       105 else {
72             open $IN, '<', $filename
73             or YAML::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, $!);
74 2         13 }
75 2         5 binmode $IN, ':utf8'; # if $Config{useperlio} eq 'define';
  2         9  
  2         138  
76             return Load(do { local $/; <$IN> });
77             }
78              
79 2     2 0 5 sub init_action_object {
80 2         5 my $self = shift;
81 2         11 my $object_class = (shift) . '_class';
82 2         150 my $module_name = $self->$object_class;
83 2 50 33     20 eval "require $module_name";
84             $self->die("Error in require $module_name - $@")
85 2         13 if $@ and "$@" !~ /Can't locate/;
86 2         18 my $object = $self->$object_class->new;
87 2         19 $object->set_global_options;
88             return $object;
89             }
90              
91             my $global = {};
92 0     0 1   sub Bless {
93 0           require YAML::Dumper::Base;
94             YAML::Dumper::Base::bless($global, @_)
95             }
96 0     0 1   sub Blessed {
97 0           require YAML::Dumper::Base;
98             YAML::Dumper::Base::blessed($global, @_)
99 0     0 0   }
100             sub global_object { $global }
101              
102             1;
103              
104             __END__