line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Dump::XML; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
5966
|
use Class::Easy; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
51
|
|
4
|
|
|
|
|
|
|
|
5
|
5
|
|
|
5
|
|
3116
|
use XML::LibXML (); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '1.19'; # avoid locale issues by stringified version |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
require XSLoader; |
10
|
|
|
|
|
|
|
XSLoader::load ('Data::Dump::XML', $VERSION); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $defaults = { |
13
|
|
|
|
|
|
|
# xml configuration |
14
|
|
|
|
|
|
|
encoding => 'utf-8', |
15
|
|
|
|
|
|
|
dtd_location => '', |
16
|
|
|
|
|
|
|
namespace => {}, |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# xml tree namespace |
19
|
|
|
|
|
|
|
dump_config => 1, |
20
|
|
|
|
|
|
|
root_name => 'data', |
21
|
|
|
|
|
|
|
hash_element => 'key', |
22
|
|
|
|
|
|
|
array_element => 'item', |
23
|
|
|
|
|
|
|
ref_element => 'ref', |
24
|
|
|
|
|
|
|
empty_array => 'empty-array', |
25
|
|
|
|
|
|
|
empty_hash => 'empty-hash', |
26
|
|
|
|
|
|
|
undef => 'undef', |
27
|
|
|
|
|
|
|
key_as_hash_element => 1, |
28
|
|
|
|
|
|
|
hash_element_attribute_name => '_name', |
29
|
|
|
|
|
|
|
at_key_as_attribute => 1, |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# options |
32
|
|
|
|
|
|
|
sort_keys => 0, |
33
|
|
|
|
|
|
|
granted_restore => 1, |
34
|
|
|
|
|
|
|
ignore_bless => 0, |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# internal structure |
37
|
|
|
|
|
|
|
doc_object => undef, |
38
|
|
|
|
|
|
|
references => {}, |
39
|
|
|
|
|
|
|
ref_count => 0, |
40
|
|
|
|
|
|
|
used => {}, |
41
|
|
|
|
|
|
|
}; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
1; |
44
|
|
|
|
|
|
|
############################################################ |
45
|
|
|
|
|
|
|
sub new { |
46
|
|
|
|
|
|
|
my $class = shift; |
47
|
|
|
|
|
|
|
my $params = {@_}; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
my $config = {%$defaults}; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
foreach my $key (keys %$params) { |
52
|
|
|
|
|
|
|
if (exists $config->{$key}) { |
53
|
|
|
|
|
|
|
$config->{$key} = $params->{$key}; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
if (exists $config->{'@key_as_attribute'}) { |
58
|
|
|
|
|
|
|
$config->{at_key_as_attribute} = delete $config->{'@key_as_attribute'}; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
bless $config, $class; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
return $config; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
############################################################ |
66
|
|
|
|
|
|
|
sub dump_xml { |
67
|
|
|
|
|
|
|
my $self = shift; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
my $structure; |
70
|
|
|
|
|
|
|
my $root; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
my $dom = XML::LibXML->createDocument ('1.0', $self->{encoding}); |
73
|
|
|
|
|
|
|
$self->{doc_object} = $dom; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
if ($self->{dtd_location} ne '') { |
77
|
|
|
|
|
|
|
$dom->createInternalSubset ('data', undef, $self->{dtd_location}); |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
$root = $dom->createElement ($self->{root_name}); |
81
|
|
|
|
|
|
|
$dom->setDocumentElement ($root); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
if ((scalar @_) == 1) { |
85
|
|
|
|
|
|
|
$structure = shift; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
if (blessed ($structure) and $structure->can ('TO_XML')) { |
88
|
|
|
|
|
|
|
$root->setAttribute (_class => blessed ($structure)); |
89
|
|
|
|
|
|
|
$structure = $structure->TO_XML; |
90
|
|
|
|
|
|
|
$root->setAttribute (_to_xml => 1); |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
} else { |
94
|
|
|
|
|
|
|
$structure = \@_; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# dump config options if any |
99
|
|
|
|
|
|
|
foreach (qw(ref_element hash_element array_element empty_array empty_hash undef key_as_hash_element at_key_as_attribute)) { |
100
|
|
|
|
|
|
|
$root->setAttribute ("_$_", $self->{$_}) |
101
|
|
|
|
|
|
|
if $self->{$_} ne $defaults->{$_}; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
if (scalar keys %{$self->{namespace}}) { |
105
|
|
|
|
|
|
|
foreach my $key (keys %{$self->{namespace}}) { |
106
|
|
|
|
|
|
|
$root->setAttribute ($key, $self->{namespace}->{$key}); |
107
|
|
|
|
|
|
|
#debug "add '$key' namespace"; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
$self->{references} = {}; |
112
|
|
|
|
|
|
|
$self->{ref_count} = 0; |
113
|
|
|
|
|
|
|
$self->{used} = {}; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# $self->analyze ($structure); |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
#my $refs = $self->{'references'}; |
118
|
|
|
|
|
|
|
# |
119
|
|
|
|
|
|
|
#foreach (keys %$refs) |
120
|
|
|
|
|
|
|
#{ |
121
|
|
|
|
|
|
|
# delete $refs->{$_} unless ($refs->{$_}); |
122
|
|
|
|
|
|
|
#} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
$self->simple_dump ($structure); |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
return $self->{doc_object}; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
############################################################ |
130
|
|
|
|
|
|
|
sub simple_dump { |
131
|
|
|
|
|
|
|
my $self = shift; |
132
|
|
|
|
|
|
|
my $rval = \$_[0]; shift; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
my $dom = $self->{doc_object}; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
my $tag = shift || $dom->documentElement; |
137
|
|
|
|
|
|
|
my $deref = shift; |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
$rval = $$rval if $deref; |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
my $ref_element = $self->{ref_element}; |
142
|
|
|
|
|
|
|
my $array_element = $self->{array_element}; |
143
|
|
|
|
|
|
|
my $hash_element = $self->{hash_element}; |
144
|
|
|
|
|
|
|
my $empty_array = $self->{empty_array}; |
145
|
|
|
|
|
|
|
my $undef = $self->{undef}; |
146
|
|
|
|
|
|
|
my $empty_hash = $self->{empty_hash}; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
my ($class, $type, $id) = ( |
149
|
|
|
|
|
|
|
blessed ($rval), |
150
|
|
|
|
|
|
|
reftype ($rval), |
151
|
|
|
|
|
|
|
refaddr ($rval) |
152
|
|
|
|
|
|
|
); |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
if (defined $class) { |
155
|
|
|
|
|
|
|
if ($class eq 'XML::LibXML::Element') { |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
if ($rval->localname eq 'include' and ( |
158
|
|
|
|
|
|
|
$rval->lookupNamespacePrefix ('http://www.w3.org/2003/XInclude') |
159
|
|
|
|
|
|
|
or $rval->lookupNamespacePrefix ('http://www.w3.org/2001/XInclude') |
160
|
|
|
|
|
|
|
)) { |
161
|
|
|
|
|
|
|
#my $node = $tag->addNewChild ('', 'include'); |
162
|
|
|
|
|
|
|
#$node->setNamespace ('http://www.w3.org/2003/XInclude', 'xi'); |
163
|
|
|
|
|
|
|
#$node->setAttribute ('href', $rval->getAttribute ('href')); |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
my $parser = XML::LibXML->new; |
166
|
|
|
|
|
|
|
$parser->expand_xinclude(0); # we try this later |
167
|
|
|
|
|
|
|
$parser->load_ext_dtd(0); |
168
|
|
|
|
|
|
|
$parser->expand_entities(0); |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
my $include; |
171
|
|
|
|
|
|
|
eval { |
172
|
|
|
|
|
|
|
$include = $parser->parse_file ($rval->getAttribute ('href')); |
173
|
|
|
|
|
|
|
}; |
174
|
|
|
|
|
|
|
#my $xinclude_result; |
175
|
|
|
|
|
|
|
#eval {$xinclude_result = $parser->process_xincludes ($include);}; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
#debug "XInclude processing result is: $xinclude_result, error is: $@"; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
$tag->addChild ($include->documentElement) |
180
|
|
|
|
|
|
|
if not $@ and defined $include; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
} else { |
183
|
|
|
|
|
|
|
$tag->addChild ($rval); |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
return; |
187
|
|
|
|
|
|
|
} elsif ($class ne '') { |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
$tag->setAttribute (_class => $class); |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
if ($rval->can ('TO_XML')) { |
192
|
|
|
|
|
|
|
$rval = $rval->TO_XML; |
193
|
|
|
|
|
|
|
$tag->setAttribute (_to_xml => 1); |
194
|
|
|
|
|
|
|
($class, $type, $id) = ( |
195
|
|
|
|
|
|
|
blessed ($rval), |
196
|
|
|
|
|
|
|
reftype ($rval), |
197
|
|
|
|
|
|
|
refaddr ($rval) |
198
|
|
|
|
|
|
|
); |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
#if (my $ref_no = $self->refs ($id)) { |
206
|
|
|
|
|
|
|
# if (defined $self->{'used'}->{$id} |
207
|
|
|
|
|
|
|
# and $self->{'used'}->{$id} eq 'yea' |
208
|
|
|
|
|
|
|
# ) { |
209
|
|
|
|
|
|
|
# |
210
|
|
|
|
|
|
|
# my $node = $tag->addNewChild ('', $ref_element); |
211
|
|
|
|
|
|
|
# $node->setAttribute ('to', $ref_no); |
212
|
|
|
|
|
|
|
# return; |
213
|
|
|
|
|
|
|
# |
214
|
|
|
|
|
|
|
# } else { |
215
|
|
|
|
|
|
|
# |
216
|
|
|
|
|
|
|
# $tag->setAttribute ('id', $ref_no); |
217
|
|
|
|
|
|
|
# $self->{'used'}->{$id} = 'yea'; |
218
|
|
|
|
|
|
|
# |
219
|
|
|
|
|
|
|
# } |
220
|
|
|
|
|
|
|
#} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
if ($type eq "SCALAR" || $type eq "REF"){ |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
my $rval_ref = ref $$rval; |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
if ($rval_ref) { |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
if (($rval_ref eq 'SCALAR') or ($rval_ref eq 'REF')) { |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
my $node = $tag->addNewChild ('', $ref_element); |
231
|
|
|
|
|
|
|
return $self->simple_dump ($$rval, $node, 1); |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
return $self->simple_dump ($$rval, $tag, 1); |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
} elsif ( |
237
|
|
|
|
|
|
|
not defined $$rval and defined $rval |
238
|
|
|
|
|
|
|
and defined $class and $class ne '' |
239
|
|
|
|
|
|
|
) { |
240
|
|
|
|
|
|
|
# regexp. 100% ? |
241
|
|
|
|
|
|
|
# debug "has undefined deref '$$rval' and defined '$rval'"; |
242
|
|
|
|
|
|
|
$tag->addNewChild ('', $rval); |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
} elsif (not defined $$rval) { |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
$tag->addNewChild ('', $self->{undef}); |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
} else { |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
$tag->appendText ($$rval); |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
#debug $rval, $$rval, ref $rval, ref $$rval; |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
return; |
257
|
|
|
|
|
|
|
} elsif ($type eq "ARRAY") { |
258
|
|
|
|
|
|
|
my @array; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
unless (scalar @$rval){ |
261
|
|
|
|
|
|
|
$tag->addNewChild ('', $self->{empty_array}); |
262
|
|
|
|
|
|
|
return; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
my $level_up = 0; |
266
|
|
|
|
|
|
|
my $option_attr = $tag->getAttribute ('_opt'); |
267
|
|
|
|
|
|
|
if (defined $option_attr and $option_attr eq 'up') { |
268
|
|
|
|
|
|
|
$level_up = 1; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
my $idx = 0; |
272
|
|
|
|
|
|
|
my $tag_name = $tag->nodeName; |
273
|
|
|
|
|
|
|
# debug "tag mane is : $tag_name, level up is : $level_up"; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
foreach (@$rval) { |
276
|
|
|
|
|
|
|
my $node; |
277
|
|
|
|
|
|
|
if ($level_up) { |
278
|
|
|
|
|
|
|
if ($idx) { |
279
|
|
|
|
|
|
|
$node = $tag->parentNode->addNewChild ('', $tag_name); |
280
|
|
|
|
|
|
|
} else { |
281
|
|
|
|
|
|
|
$node = $tag; |
282
|
|
|
|
|
|
|
$tag->removeAttribute ('_opt'); |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
# $tag->setAttribute ('idx', $idx); |
285
|
|
|
|
|
|
|
} else { |
286
|
|
|
|
|
|
|
$node = $tag->addNewChild ('', $array_element); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
$idx++; |
290
|
|
|
|
|
|
|
$self->simple_dump ($_, $node); |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
return; |
294
|
|
|
|
|
|
|
} elsif ($type eq "HASH") { |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
my @keys = keys %$rval; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
unless (scalar @keys) { |
299
|
|
|
|
|
|
|
$tag->addNewChild ('', $self->{empty_hash}); |
300
|
|
|
|
|
|
|
return; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
@keys = sort @keys |
304
|
|
|
|
|
|
|
if $self->{sort_keys}; |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
#$self->dump_hashref ($rval, \@keys, $tag); |
307
|
|
|
|
|
|
|
$self->dump_hashref_pp ($rval, \@keys, $tag); |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
return; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
} elsif ($type eq "GLOB") { |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
$tag->addNewChild ('', 'glob'); |
314
|
|
|
|
|
|
|
return; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
} elsif ($type eq "CODE") { |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
$tag->addNewChild ('', 'code'); |
319
|
|
|
|
|
|
|
return; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
} else { |
322
|
|
|
|
|
|
|
my $comment = $dom->createComment ("unknown type: '$type'"); |
323
|
|
|
|
|
|
|
$tag->addChild ($comment); |
324
|
|
|
|
|
|
|
return; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
die "Assert"; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
############################################################ |
330
|
|
|
|
|
|
|
sub key_info_pp { |
331
|
|
|
|
|
|
|
my $self = shift; |
332
|
|
|
|
|
|
|
my ($rval, $key, $val_ref) = @_; |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
my $key_prefix = substr $key, 0, 1; |
335
|
|
|
|
|
|
|
my $key_name = substr $key, 1; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
if ($key_prefix ne '@' and $key_prefix ne '#' and $key_prefix ne '<') { |
338
|
|
|
|
|
|
|
$key_name = $key; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
my $val_type = reftype ($val_ref); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# [4] NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6] | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF] | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF] |
344
|
|
|
|
|
|
|
# [4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040] |
345
|
|
|
|
|
|
|
my $key_can_be_tag = $key_name =~ /^[a-zA-Z\:\_][\w\d\_\-\:\.]$/; |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
return ($key_prefix, $key_name, $val_type, $key_can_be_tag); |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
############################################################ |
351
|
|
|
|
|
|
|
sub dump_hashref_pp { |
352
|
|
|
|
|
|
|
my $self = shift; |
353
|
|
|
|
|
|
|
my ($rval, $keys, $tag) = @_; |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
foreach my $key (@$keys) { |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
my $val = \$rval->{$key}; |
358
|
|
|
|
|
|
|
my $node; |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
my ($key_prefix, $key_name, $val_type, $key_can_be_tag) = |
361
|
|
|
|
|
|
|
$self->key_info ($rval, $key, $$val); |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
if ($key_can_be_tag) { |
364
|
|
|
|
|
|
|
if (defined $key_prefix and $key_prefix eq '@' and $self->{at_key_as_attribute}) { |
365
|
|
|
|
|
|
|
# TODO: make something with values other than scalar ref |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
unless (defined $val_type) { |
368
|
|
|
|
|
|
|
$tag->setAttribute ($key_name, $$val); |
369
|
|
|
|
|
|
|
next; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
} elsif (defined $key_prefix and $key_prefix eq '#' and $key_name eq 'text') { |
373
|
|
|
|
|
|
|
unless (defined $val_type) { |
374
|
|
|
|
|
|
|
$tag->appendText ($$val); |
375
|
|
|
|
|
|
|
next; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
} elsif ( |
378
|
|
|
|
|
|
|
$self->{key_as_hash_element} |
379
|
|
|
|
|
|
|
and $key ne $self->{array_element} # for RSS |
380
|
|
|
|
|
|
|
and $key ne $self->{hash_element} |
381
|
|
|
|
|
|
|
and $key ne $self->{ref_element} |
382
|
|
|
|
|
|
|
and $key ne $self->{empty_array} |
383
|
|
|
|
|
|
|
and $key ne $self->{empty_hash} |
384
|
|
|
|
|
|
|
and $key ne $self->{undef} |
385
|
|
|
|
|
|
|
) { |
386
|
|
|
|
|
|
|
$node = $tag->addNewChild ('', $key_name); |
387
|
|
|
|
|
|
|
if (defined $key_prefix and $key_prefix eq '<') { |
388
|
|
|
|
|
|
|
$node->setAttribute (_opt => 'up'); |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
} else { |
392
|
|
|
|
|
|
|
$node = $tag->addNewChild ('', $self->{hash_element}); |
393
|
|
|
|
|
|
|
$node->setAttribute ($self->{hash_element_attribute_name}, $key); |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
$self->simple_dump ($$val, $node); |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
############################################################ |
402
|
|
|
|
|
|
|
__END__ |