line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XML::Hash::LX; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
123178
|
use 5.006002; |
|
2
|
|
|
|
|
10
|
|
|
2
|
|
|
|
|
95
|
|
4
|
2
|
|
|
2
|
|
12
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
74
|
|
5
|
2
|
|
|
2
|
|
11
|
use warnings; |
|
2
|
|
|
|
|
19
|
|
|
2
|
|
|
|
|
752
|
|
6
|
2
|
|
|
2
|
|
3430
|
use XML::LibXML (); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $PARSER = XML::LibXML->new(); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub _croak { require Carp; goto &Carp::croak } |
11
|
|
|
|
|
|
|
sub import { |
12
|
|
|
|
|
|
|
my $me = shift; |
13
|
|
|
|
|
|
|
no strict 'refs'; |
14
|
|
|
|
|
|
|
my %e = ( xml2hash => 1, hash2xml => 1, ':inject' => 0 ); |
15
|
|
|
|
|
|
|
if (@_) { %e = map { $_=>1 } @_ } |
16
|
|
|
|
|
|
|
*{caller().'::xml2hash'} = \&xml2hash if delete $e{xml2hash}; |
17
|
|
|
|
|
|
|
*{caller().'::hash2xml'} = \&hash2xml if delete $e{hash2xml}; |
18
|
|
|
|
|
|
|
if ( delete $e{':inject'} ) { |
19
|
|
|
|
|
|
|
unless (defined &XML::LibXML::Node::toHash) { |
20
|
|
|
|
|
|
|
*XML::LibXML::Node::toHash = \&xml2hash; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
_croak "@{[keys %e]} is not exported by $me" if %e; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 NAME |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
XML::Hash::LX - Convert hash to xml and xml to hash using LibXML |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=cut |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our $VERSION = '0.0603'; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 SYNOPSIS |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
use XML::Hash::LX; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $hash = xml2hash $xmlstring, attr => '.', text => '~'; |
39
|
|
|
|
|
|
|
my $hash = xml2hash $xmldoc; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
my $xmlstr = hash2html $hash, attr => '+', text => '#text'; |
42
|
|
|
|
|
|
|
my $xmldoc = hash2html $hash, doc => 1, attr => '+'; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# Usage with XML::LibXML |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $doc = XML::LibXML->new->parse_string($xml); |
47
|
|
|
|
|
|
|
my $xp = XML::LibXML::XPathContext->new($doc); |
48
|
|
|
|
|
|
|
$xp->registerNs('rss', 'http://purl.org/rss/1.0/'); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# then process xpath |
51
|
|
|
|
|
|
|
for ($xp->findnodes('//rss:item')) { |
52
|
|
|
|
|
|
|
# and convert to hash concrete nodes |
53
|
|
|
|
|
|
|
my $item = xml2hash($_); |
54
|
|
|
|
|
|
|
print Dumper+$item |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 DESCRIPTION |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
This module is a companion for C. It operates with LibXML objects, could return or accept LibXML objects, and may be used for easy data transformations |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
It is faster in parsing then L, L, L and of course much slower than L ;) |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
It is faster in composing than L, but slower than L |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
Parse benchmark: |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Rate Simple Hash Twig Hash::LX Bare |
68
|
|
|
|
|
|
|
Simple 11.3/s -- -2% -16% -44% -97% |
69
|
|
|
|
|
|
|
Hash 11.6/s 2% -- -14% -43% -97% |
70
|
|
|
|
|
|
|
Twig 13.5/s 19% 16% -- -34% -96% |
71
|
|
|
|
|
|
|
Hash::LX 20.3/s 79% 75% 51% -- -95% |
72
|
|
|
|
|
|
|
Bare 370/s 3162% 3088% 2650% 1721% -- |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Compose benchmark: |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Rate Hash Hash::LX Simple |
77
|
|
|
|
|
|
|
Hash 49.2/s -- -18% -40% |
78
|
|
|
|
|
|
|
Hash::LX 60.1/s 22% -- -26% |
79
|
|
|
|
|
|
|
Simple 81.5/s 66% 36% -- |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Benchmark was done on L |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head1 EXPORT |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
C and C are exported by default |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head2 :inject |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Inject toHash method in the namespace of L and allow to call it on any subclass of L directly |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
By default is disabled |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
use XML::Hash::LX ':inject'; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
my $doc = XML::LibXML->new->parse_string($xml); |
96
|
|
|
|
|
|
|
my $hash = $doc->toHash(%opts); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head1 FUNCTIONS |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head2 xml2hash $xml, [ OPTIONS ] |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
XML could be L, L or string |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head2 hash2xml $hash, [ doc => 1, ] [ OPTIONS ] |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Id C option is true, then returned value is L, not string |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 OPTIONS |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Every option could be passed as arguments to function or set as global variable in C namespace |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 %XML::Hash::LX::X2H |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Options respecting convertations from xml to hash |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=over 4 |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=item order [ = 0 ] |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
B keep the output order. When enabled, structures become more complex, but xml could be completely reverted |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=item attr [ = '-' ] |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Attribute prefix |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=> { node => { -attr => "test" } } |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=item text [ = '#text' ] |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Key name for storing text |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
text => { node => { sub => '', '#text' => "test" } } |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item join [ = '' ] |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Join separator for text nodes, splitted by subnodes |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
Ignored when C in effect |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# default: |
141
|
|
|
|
|
|
|
xml2hash( '- Test1Test2
' ) |
142
|
|
|
|
|
|
|
: { item => { sub => '', '~' => 'Test1Test2' } }; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# global |
145
|
|
|
|
|
|
|
$XML::Hash::LX::X2H{join} = '+'; |
146
|
|
|
|
|
|
|
xml2hash( '- Test1Test2
' ) |
147
|
|
|
|
|
|
|
: { item => { sub => '', '~' => 'Test1+Test2' } }; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# argument |
150
|
|
|
|
|
|
|
xml2hash( '- Test1Test2
', join => '+' ) |
151
|
|
|
|
|
|
|
: { item => { sub => '', '~' => 'Test1+Test2' } }; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=item trim [ = 1 ] |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
Trim leading and trailing whitespace from text nodes |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=item cdata [ = undef ] |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
When defined, CDATA sections will be stored under this key |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# cdata = undef |
162
|
|
|
|
|
|
|
=> { node => 'test' } |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# cdata = '#' |
165
|
|
|
|
|
|
|
=> { node => { '#' => 'test' } } |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=item comm [ = undef ] |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
When defined, comments sections will be stored under this key |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
When undef, comments will be ignored |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# comm = undef |
174
|
|
|
|
|
|
|
=> { node => { sub => '' } } |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# comm = '/' |
177
|
|
|
|
|
|
|
=> { node => { sub => '', '/' => 'comm' } } |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=back |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head2 $XML::Hash::LX::X2A [ = 0 ] |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Global array casing |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Ignored when C in effect |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
As option should be passed as |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
xml2hash $xml, array => 1; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Effect: |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# $X2A = 0 |
194
|
|
|
|
|
|
|
=> { node => { sub => '' } } |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# $X2A = 1 |
197
|
|
|
|
|
|
|
=> { node => [ { sub => [ '' ] } ] } |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head2 %XML::Hash::LX::X2A |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
By element array casing |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
Ignored when C in effect |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
As option should be passed as |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
xml2hash $xml, array => [ nodes list ]; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
Effect: |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# %X2A = () |
212
|
|
|
|
|
|
|
=> { node => { sub => '' } } |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
# %X2A = ( sub => 1 ) |
215
|
|
|
|
|
|
|
=> { node => { sub => [ '' ] } } |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=cut |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
our $X2A = 0; |
220
|
|
|
|
|
|
|
our %X2A = (); |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
our %X2H; |
223
|
|
|
|
|
|
|
%X2H = ( |
224
|
|
|
|
|
|
|
order => 0, |
225
|
|
|
|
|
|
|
attr => '-', |
226
|
|
|
|
|
|
|
text => '#text', |
227
|
|
|
|
|
|
|
join => '', |
228
|
|
|
|
|
|
|
trim => 1, |
229
|
|
|
|
|
|
|
cdata => undef, |
230
|
|
|
|
|
|
|
comm => undef, |
231
|
|
|
|
|
|
|
#cdata => '#', |
232
|
|
|
|
|
|
|
#comm => '//', |
233
|
|
|
|
|
|
|
%X2H, # also inject previously user-defined options |
234
|
|
|
|
|
|
|
); |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub _x2h { |
237
|
|
|
|
|
|
|
my $doc = shift; |
238
|
|
|
|
|
|
|
my $res; |
239
|
|
|
|
|
|
|
if ($doc->hasChildNodes or $doc->hasAttributes) { |
240
|
|
|
|
|
|
|
if ($X2H{order}) { |
241
|
|
|
|
|
|
|
$res = []; |
242
|
|
|
|
|
|
|
my $attr = {}; |
243
|
|
|
|
|
|
|
for ($doc->attributes) { |
244
|
|
|
|
|
|
|
#warn " .> ".$_->nodeName.'='.$_->getValue; |
245
|
|
|
|
|
|
|
$attr->{ $X2H{attr} . $_->nodeName } = $_->getValue; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
push @$res, $attr if %$attr; |
248
|
|
|
|
|
|
|
} else { |
249
|
|
|
|
|
|
|
$res = {}; |
250
|
|
|
|
|
|
|
for ($doc->attributes) { |
251
|
|
|
|
|
|
|
#warn " .> ".$_->nodeName.'='.$_->getValue; |
252
|
|
|
|
|
|
|
$res->{ $X2H{attr} . $_->nodeName } = $_->getValue; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
for ($doc->childNodes) { |
256
|
|
|
|
|
|
|
my $ref = ref $_; |
257
|
|
|
|
|
|
|
my $nn; |
258
|
|
|
|
|
|
|
if ($ref eq 'XML::LibXML::Text') { |
259
|
|
|
|
|
|
|
$nn = $X2H{text} |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
elsif ($ref eq 'XML::LibXML::CDATASection') { |
262
|
|
|
|
|
|
|
$nn = defined $X2H{cdata} ? $X2H{cdata} : $X2H{text}; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
elsif ($ref eq 'XML::LibXML::Comment') { |
265
|
|
|
|
|
|
|
$nn = defined $X2H{comm} ? $X2H{comm} : next; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
else { |
268
|
|
|
|
|
|
|
$nn = $_->nodeName; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
my $chld = _x2h($_); |
271
|
|
|
|
|
|
|
if ($X2H{order}) { |
272
|
|
|
|
|
|
|
if ($nn eq $X2H{text}) { |
273
|
|
|
|
|
|
|
push @{ $res }, $chld if length $chld; |
274
|
|
|
|
|
|
|
} else { |
275
|
|
|
|
|
|
|
push @{ $res }, { $nn => $chld }; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
} else { |
278
|
|
|
|
|
|
|
if (( $X2A or $X2A{$nn} ) and !$res->{$nn}) { $res->{$nn} = [] } |
279
|
|
|
|
|
|
|
if (exists $res->{$nn} ) { |
280
|
|
|
|
|
|
|
#warn "Append to $res->{$nn}: $nn $chld"; |
281
|
|
|
|
|
|
|
$res->{$nn} = [ $res->{$nn} ] unless ref $res->{$nn} eq 'ARRAY'; |
282
|
|
|
|
|
|
|
push @{$res->{$nn}}, $chld if defined $chld; |
283
|
|
|
|
|
|
|
} else { |
284
|
|
|
|
|
|
|
if ($nn eq $X2H{text}) { |
285
|
|
|
|
|
|
|
$res->{$nn} = $chld if length $chld; |
286
|
|
|
|
|
|
|
} else { |
287
|
|
|
|
|
|
|
$res->{$nn} = $chld; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
if($X2H{order}) { |
293
|
|
|
|
|
|
|
#warn "Ordered mode, have res with ".(0+@$res)." children = @$res"; |
294
|
|
|
|
|
|
|
return $res->[0] if @$res == 1; |
295
|
|
|
|
|
|
|
} else { |
296
|
|
|
|
|
|
|
if (defined $X2H{join} and exists $res->{ $X2H{text} } and ref $res->{ $X2H{text} }) { |
297
|
|
|
|
|
|
|
$res->{ $X2H{text} } = join $X2H{join}, grep length, @{ $res->{ $X2H{text} } }; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
delete $res->{ $X2H{text} } if $X2H{trim} and keys %$res > 1 and exists $res->{ $X2H{text} } and !length $res->{ $X2H{text} }; |
300
|
|
|
|
|
|
|
return $res->{ $X2H{text} } if keys %$res == 1 and exists $res->{ $X2H{text} }; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
else { |
304
|
|
|
|
|
|
|
$res = $doc->textContent; |
305
|
|
|
|
|
|
|
if ($X2H{trim}) { |
306
|
|
|
|
|
|
|
$res =~ s{^\s+}{}s; |
307
|
|
|
|
|
|
|
$res =~ s{\s+$}{}s; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
$res; |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub xml2hash($;%) { |
315
|
|
|
|
|
|
|
my $doc = shift; |
316
|
|
|
|
|
|
|
defined $doc or _croak("Called xml2hash on undef"),return; |
317
|
|
|
|
|
|
|
my %opts = @_; |
318
|
|
|
|
|
|
|
my $arr = delete $opts{array}; |
319
|
|
|
|
|
|
|
local $X2A = 1 if defined $arr and !ref $arr; |
320
|
|
|
|
|
|
|
local @X2A{@$arr} = (1)x@$arr if defined $arr and ref $arr; |
321
|
|
|
|
|
|
|
local @X2H{keys %opts} = values %opts if @_; |
322
|
|
|
|
|
|
|
$doc = $PARSER->parse_string($doc) if !ref $doc; |
323
|
|
|
|
|
|
|
#use Data::Dumper; |
324
|
|
|
|
|
|
|
#warn Dumper \%X2H; |
325
|
|
|
|
|
|
|
my $root = $doc->isa('XML::LibXML::Document') ? $doc->documentElement : $doc; |
326
|
|
|
|
|
|
|
return { |
327
|
|
|
|
|
|
|
scalar $root->nodeName => $X2A || $X2A{$root->nodeName} ? [ _x2h($root) ] : _x2h($root), |
328
|
|
|
|
|
|
|
}; |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=head2 %XML::Hash::LX::H2X |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
Options respecting convertations from hash to xml |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=over 4 |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=item encoding [ = 'utf-8' ] |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
XML output encoding |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=item attr [ = '-' ] |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
Attribute prefix |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
{ node => { -attr => "test", sub => 'test' } } |
347
|
|
|
|
|
|
|
test |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=item text [ = '#text' ] |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
Key name for storing text |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
{ node => { sub => '', '#text' => "test" } } |
354
|
|
|
|
|
|
|
text |
355
|
|
|
|
|
|
|
# or |
356
|
|
|
|
|
|
|
text |
357
|
|
|
|
|
|
|
# order of keys is not predictable |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=item trim [ = 1 ] |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Trim leading and trailing whitespace from text nodes |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
# trim = 1 |
364
|
|
|
|
|
|
|
{ node => { sub => [ ' ', 'test' ], '#text' => "test" } } |
365
|
|
|
|
|
|
|
testtest |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# trim = 0 |
368
|
|
|
|
|
|
|
{ node => { sub => [ ' ', 'test' ], '#text' => "test" } } |
369
|
|
|
|
|
|
|
test test |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=item cdata [ = undef ] |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
When defined, such key elements will be saved as CDATA sections |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# cdata = undef |
376
|
|
|
|
|
|
|
{ node => { '#' => 'test' } } => <#>test#> # it's bad ;) |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
# cdata = '#' |
379
|
|
|
|
|
|
|
{ node => { '#' => 'test' } } => |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=item comm [ = undef ] |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
When defined, such key elements will be saved as comment sections |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
# comm = undef |
386
|
|
|
|
|
|
|
{ node => { '/' => 'test' } } => >test/> # it's very bad! ;) |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# comm = '/' |
389
|
|
|
|
|
|
|
{ node => { '/' => 'test' } } => |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=back |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=cut |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
our %H2X; |
396
|
|
|
|
|
|
|
%H2X = ( |
397
|
|
|
|
|
|
|
%X2H, |
398
|
|
|
|
|
|
|
#attr => '-', |
399
|
|
|
|
|
|
|
#text => '~', |
400
|
|
|
|
|
|
|
#trim => 1, |
401
|
|
|
|
|
|
|
# join => '+', # useless |
402
|
|
|
|
|
|
|
%H2X, |
403
|
|
|
|
|
|
|
); |
404
|
|
|
|
|
|
|
our $AL = length $H2X{attr}; |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
our $hd = '/'; |
407
|
|
|
|
|
|
|
sub _h2x { |
408
|
|
|
|
|
|
|
@_ or return; |
409
|
|
|
|
|
|
|
my ($data,$parent) = @_; |
410
|
|
|
|
|
|
|
#warn "> $d"; |
411
|
|
|
|
|
|
|
return unless defined $data; |
412
|
|
|
|
|
|
|
if ( !ref $data ) { |
413
|
|
|
|
|
|
|
if ($H2X{trim}) { |
414
|
|
|
|
|
|
|
$data =~ s/^\s+//s; |
415
|
|
|
|
|
|
|
$data =~ s/\s+$//s; |
416
|
|
|
|
|
|
|
#return unless length($data); |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
return XML::LibXML::Text->new($data) |
419
|
|
|
|
|
|
|
}; |
420
|
|
|
|
|
|
|
my @rv; |
421
|
|
|
|
|
|
|
if (ref $data eq 'ARRAY') { |
422
|
|
|
|
|
|
|
#warn "Map @$data"; |
423
|
|
|
|
|
|
|
@rv = map _h2x($_,$parent), @$data; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
elsif (ref $data eq 'HASH') { |
426
|
|
|
|
|
|
|
for (keys %$data) { |
427
|
|
|
|
|
|
|
#warn "$_ $data->{$_}"; |
428
|
|
|
|
|
|
|
#next if !defined $data->{$_} or ( !ref $data->{$_} and !length $data->{$_} ); |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
# What may be empty ? |
431
|
|
|
|
|
|
|
# - attribute |
432
|
|
|
|
|
|
|
# - node |
433
|
|
|
|
|
|
|
# - comment |
434
|
|
|
|
|
|
|
# Skip empty: text, cdata |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
my $cdata_or_text; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
if ($_ eq $H2X{text}) { |
439
|
|
|
|
|
|
|
$cdata_or_text = 'XML::LibXML::Text'; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
elsif (defined $H2X{cdata} and $_ eq $H2X{cdata}) { |
442
|
|
|
|
|
|
|
$cdata_or_text = 'XML::LibXML::CDATASection'; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
if (0) {} |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
elsif($cdata_or_text) { |
448
|
|
|
|
|
|
|
push @rv, map { |
449
|
|
|
|
|
|
|
defined($_) ? do { |
450
|
|
|
|
|
|
|
$H2X{trim} and s/(?:^\s+|\s+$)//sg; |
451
|
|
|
|
|
|
|
$H2X{trim} && !length($_) ? () : |
452
|
|
|
|
|
|
|
$cdata_or_text->new( $_ ) |
453
|
|
|
|
|
|
|
} : (), |
454
|
|
|
|
|
|
|
} ref $data->{$_} ? @{ $data->{$_} } : $data->{$_}; |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
elsif (defined $H2X{comm} and $_ eq $H2X{comm}) { |
458
|
|
|
|
|
|
|
push @rv, map XML::LibXML::Comment->new(defined $_ ? $_ : ''), ref $data->{$_} ? @{ $data->{$_} } : $data->{$_}; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
elsif (substr($_,0,$AL) eq $H2X{attr} ) { |
461
|
|
|
|
|
|
|
if ($parent) { |
462
|
|
|
|
|
|
|
$parent->setAttribute( substr($_,1),defined $data->{$_} ? $data->{$_} : '' ); |
463
|
|
|
|
|
|
|
} else { |
464
|
|
|
|
|
|
|
warn "attribute $_ without parent" |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
elsif ( !defined $data->{$_} or ( !ref $data->{$_} and !length $data->{$_} ) ) { |
468
|
|
|
|
|
|
|
push @rv,XML::LibXML::Element->new($_); |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
else { |
471
|
|
|
|
|
|
|
local $hd = $hd.'/'.$_; |
472
|
|
|
|
|
|
|
my $node = XML::LibXML::Element->new($_); |
473
|
|
|
|
|
|
|
#warn ("$hd << ".$_->nodeName), |
474
|
|
|
|
|
|
|
$node->appendChild($_) for _h2x($data->{$_},$node); |
475
|
|
|
|
|
|
|
push @rv,$node; |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
elsif (ref $data eq 'SCALAR') { # RAW |
480
|
|
|
|
|
|
|
my $node = eval { XML::LibXML->new->parse_string($$data) } or _croak "Malformed raw data on $hd: $@"; |
481
|
|
|
|
|
|
|
return $node->documentElement; |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
elsif (ref $data eq 'REF') { # LibXML Node |
484
|
|
|
|
|
|
|
if (ref $$data and eval{ $$data->isa('XML::LibXML::Node') }) { |
485
|
|
|
|
|
|
|
return $$data->cloneNode(1); |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
elsif ( ref $$data and do { no strict 'refs'; exists ${ ref($$data).'::' }{'(""'} } ) { |
488
|
|
|
|
|
|
|
return XML::LibXML::Text->new( "$$data" ); |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
else { |
491
|
|
|
|
|
|
|
_croak ("Bad reference ".ref( $$data ).": <$$data> on $hd"); |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
elsif ( do { no strict 'refs'; exists ${ ref($data).'::' }{'(""'} } ) { # have string overload |
495
|
|
|
|
|
|
|
return XML::LibXML::Text->new( "$data" ); |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
elsif (ref $data and eval{ $data->isa('XML::LibXML::Node') }) { |
498
|
|
|
|
|
|
|
return $data->cloneNode(1); |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
else { |
501
|
|
|
|
|
|
|
_croak "Bad reference ".ref( $data ).": <$data> on $hd"; |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
#warn "@rv"; |
504
|
|
|
|
|
|
|
return wantarray ? @rv : $rv[0]; |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
sub hash2xml($;%) { |
508
|
|
|
|
|
|
|
#warn "hash2xml(@_) from @{[ (caller)[1,2] ]}"; |
509
|
|
|
|
|
|
|
my $hash = shift; |
510
|
|
|
|
|
|
|
my %opts = @_; |
511
|
|
|
|
|
|
|
my $str = delete $opts{doc} ? 0 : 1; |
512
|
|
|
|
|
|
|
my $encoding = delete $opts{encoding} || delete $opts{enc} || 'utf-8'; |
513
|
|
|
|
|
|
|
my $doc = XML::LibXML::Document->new('1.0', $encoding); |
514
|
|
|
|
|
|
|
local @H2X{keys %opts} = values %opts if @_; |
515
|
|
|
|
|
|
|
local $AL = length $H2X{attr}; |
516
|
|
|
|
|
|
|
#use Data::Dumper; |
517
|
|
|
|
|
|
|
#warn Dumper \%H2X; |
518
|
|
|
|
|
|
|
my $root = _h2x($hash); |
519
|
|
|
|
|
|
|
$doc->setDocumentElement($root); |
520
|
|
|
|
|
|
|
return $str ? $doc->toString : $doc; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
=head1 BUGS |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
None known |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=head1 SEE ALSO |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
=over 4 |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
=item * L |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
With default settings should produce the same output as this module. Settings are similar by effect |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=back |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
=head1 AUTHOR |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
Mons Anderson, C<< >> |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Copyright 2009 Mons Anderson, all rights reserved. |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
547
|
|
|
|
|
|
|
under the same terms as Perl itself. |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=cut |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
1; # End of XML::Hash::LX |