File Coverage

blib/lib/ETL/Yertl/Format/yaml.pm
Criterion Covered Total %
statement 27 27 100.0
branch 6 6 100.0
condition n/a
subroutine 8 8 100.0
pod 4 4 100.0
total 45 45 100.0


line stmt bran cond sub pod time code
1             package ETL::Yertl::Format::yaml;
2             our $VERSION = '0.035';
3             # ABSTRACT: YAML read/write support for Yertl
4              
5 16     16   1516502 use ETL::Yertl;
  16         39  
  16         99  
6 16     16   514 use base 'ETL::Yertl::Format';
  16         29  
  16         5017  
7 16     16   103 use Module::Runtime qw( use_module );
  16         35  
  16         82  
8 16     16   775 use List::Util qw( pairs pairkeys pairfirst );
  16         31  
  16         12701  
9              
10             #pod =attr format_module
11             #pod
12             #pod The module being used for this format. Possible modules, in order of importance:
13             #pod
14             #pod =over 4
15             #pod
16             #pod =item L (any version)
17             #pod
18             #pod =item L (any version)
19             #pod
20             #pod =item L (any version)
21             #pod
22             #pod =item L (any version)
23             #pod
24             #pod =back
25             #pod
26             #pod =cut
27              
28             # Pairs of module => supported version
29             our @FORMAT_MODULES = (
30             'YAML::XS' => 0,
31             'YAML::Syck' => 0,
32             #'YAML' => 0, # Disabled: YAML::Old changes have broke something here...
33             'YAML::Tiny' => 0,
34             );
35              
36             sub format_module {
37 483     483 1 854 my ( $self ) = @_;
38 483 100       1459 return $self->{_format_module} if $self->{_format_module};
39 342         2447 for my $format_module ( pairs @FORMAT_MODULES ) {
40 344         582 eval {
41             # Prototypes on use_module() make @$format_module not work correctly
42 344         1029 use_module( $format_module->[0], $format_module->[1] );
43             };
44 344 100       46763 if ( !$@ ) {
45 341         1745 return $self->{_format_module} = $format_module->[0];
46             }
47             }
48             die "Could not load a formatter for YAML. Please install one of the following modules:\n"
49             . join( "",
50 1 100       8 map { sprintf "\t%s (%s)", $_->[0], $_->[1] ? "version $_->[1]" : "Any version" }
  3         19  
51             pairs @FORMAT_MODULES
52             )
53             . "\n";
54             }
55              
56              
57             # Hash of MODULE => formatter sub
58             my %FORMAT_SUB = (
59              
60             'YAML::XS' => {
61             decode => sub {
62             my ( $self, $msg ) = @_;
63             return YAML::XS::Load( $msg );
64             },
65              
66             write => sub {
67             my $self = shift;
68             return YAML::XS::Dump( @_ );
69             },
70              
71             read => sub {
72             my $self = shift;
73             my $yaml = do { local $/; readline $self->{input} };
74             return $yaml ? YAML::XS::Load( $yaml ) : ();
75             },
76              
77             },
78              
79             'YAML::Syck' => {
80             decode => sub {
81             my ( $self, $msg ) = @_;
82             return YAML::Syck::Load( $msg );
83             },
84              
85             write => sub {
86             my $self = shift;
87             return YAML::Syck::Dump( @_ );
88             },
89              
90             read => sub {
91             my $self = shift;
92             my $yaml = do { local $/; readline $self->{input} };
93             return $yaml ? YAML::Syck::Load( $yaml ) : ();
94             },
95              
96             },
97              
98             'YAML' => {
99             decode => sub {
100             my ( $self, $msg ) = @_;
101             return YAML::Load( $msg );
102             },
103              
104             write => sub {
105             my $self = shift;
106             return YAML::Dump( @_ );
107             },
108              
109             read => sub {
110             my $self = shift;
111             my $yaml = do { local $/; readline $self->{input} };
112             return $yaml ? YAML::Load( $yaml ) : ();
113             },
114              
115             },
116              
117             'YAML::Tiny' => {
118             decode => sub {
119             my ( $self, $msg ) = @_;
120             return YAML::Tiny::Load( $msg );
121             },
122              
123             write => sub {
124             my $self = shift;
125             return YAML::Tiny::Dump( @_ );
126             },
127              
128             read => sub {
129             my $self = shift;
130             my $yaml = do { local $/; readline $self->{input} };
131             return $yaml ? YAML::Tiny::Load( $yaml ) : ();
132             },
133              
134             },
135              
136             );
137              
138             #pod =method write( DOCUMENTS )
139             #pod
140             #pod Convert the given C to YAML. Returns a YAML string.
141             #pod
142             #pod =cut
143              
144             sub write {
145 261     261 1 5997 my $self = shift;
146 261         632 return $FORMAT_SUB{ $self->format_module }{write}->( $self, @_ );
147             }
148              
149             #pod =method read()
150             #pod
151             #pod Read a YAML string from L and return all the documents.
152             #pod
153             #pod =cut
154              
155             sub read {
156 217     217 1 841 my $self = shift;
157 217         565 return $FORMAT_SUB{ $self->format_module }{read}->( $self );
158             }
159              
160             #pod =method decode
161             #pod
162             #pod my $msg = $yaml->decode( $bytes );
163             #pod
164             #pod Decode the given bytes into a single data structure. C<$bytes> must be
165             #pod a single YAML document.
166             #pod
167             #pod =cut
168              
169             sub decode {
170 3     3 1 17 my ( $self, $msg ) = @_;
171 3         8 return $FORMAT_SUB{ $self->format_module }{decode}->( $self, $msg );
172             }
173              
174             1;
175              
176             __END__