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__ |