line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XML::Mini::Document; |
2
|
10
|
|
|
10
|
|
14135
|
use strict; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
476
|
|
3
|
|
|
|
|
|
|
$^W = 1; |
4
|
|
|
|
|
|
|
|
5
|
10
|
|
|
10
|
|
1886
|
use FileHandle; |
|
10
|
|
|
|
|
32970
|
|
|
10
|
|
|
|
|
80
|
|
6
|
|
|
|
|
|
|
|
7
|
10
|
|
|
10
|
|
10574
|
use XML::Mini; |
|
10
|
|
|
|
|
29
|
|
|
10
|
|
|
|
|
289
|
|
8
|
10
|
|
|
10
|
|
7522
|
use XML::Mini::Element; |
|
10
|
|
|
|
|
40
|
|
|
10
|
|
|
|
|
400
|
|
9
|
10
|
|
|
10
|
|
102
|
use XML::Mini::Element::Comment; |
|
10
|
|
|
|
|
21
|
|
|
10
|
|
|
|
|
307
|
|
10
|
10
|
|
|
10
|
|
6890
|
use XML::Mini::Element::Header; |
|
10
|
|
|
|
|
28
|
|
|
10
|
|
|
|
|
283
|
|
11
|
10
|
|
|
10
|
|
61
|
use XML::Mini::Element::CData; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
471
|
|
12
|
10
|
|
|
10
|
|
54
|
use XML::Mini::Element::DocType; |
|
10
|
|
|
|
|
17
|
|
|
10
|
|
|
|
|
299
|
|
13
|
10
|
|
|
10
|
|
55
|
use XML::Mini::Element::Entity; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
208
|
|
14
|
10
|
|
|
10
|
|
5839
|
use XML::Mini::Node; |
|
10
|
|
|
|
|
354
|
|
|
10
|
|
|
|
|
325
|
|
15
|
|
|
|
|
|
|
|
16
|
10
|
|
|
|
|
492
|
use vars qw ( $VERSION |
17
|
|
|
|
|
|
|
$TextBalancedAvailable |
18
|
10
|
|
|
10
|
|
60
|
); |
|
10
|
|
|
|
|
20
|
|
19
|
|
|
|
|
|
|
|
20
|
10
|
|
|
10
|
|
12699
|
use Text::Balanced; |
|
10
|
|
|
|
|
121890
|
|
|
10
|
|
|
|
|
54113
|
|
21
|
|
|
|
|
|
|
$TextBalancedAvailable = 1; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
$VERSION = '1.38'; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
if ($XML::Mini::IgnoreDeepRecursionWarnings) |
27
|
|
|
|
|
|
|
{ |
28
|
|
|
|
|
|
|
XML::Mini->ignoreDeepRecursionWarning(); |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub new |
32
|
|
|
|
|
|
|
{ |
33
|
9
|
|
|
9
|
1
|
1210
|
my $class = shift; |
34
|
9
|
|
|
|
|
25
|
my $string = shift; |
35
|
|
|
|
|
|
|
|
36
|
9
|
|
|
|
|
23
|
my $self = {}; |
37
|
9
|
|
33
|
|
|
154
|
bless $self, ref $class || $class; |
38
|
|
|
|
|
|
|
|
39
|
9
|
|
|
|
|
48
|
$self->init(); |
40
|
|
|
|
|
|
|
|
41
|
9
|
50
|
|
|
|
34
|
if (defined $string) |
42
|
|
|
|
|
|
|
{ |
43
|
0
|
|
|
|
|
0
|
$self->fromString($string); |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
9
|
|
|
|
|
28
|
return $self; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub init { |
50
|
15
|
|
|
15
|
0
|
1796
|
my $self = shift; |
51
|
15
|
|
|
|
|
898
|
delete $self->{'_xmlDoc'}; |
52
|
|
|
|
|
|
|
|
53
|
15
|
|
|
|
|
120
|
$self->{'_xmlDoc'} = XML::Mini::Element->new("PSYCHOGENIC_ROOT_ELEMENT"); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub getRoot |
58
|
|
|
|
|
|
|
{ |
59
|
1
|
|
|
1
|
1
|
6
|
my $self = shift; |
60
|
1
|
|
|
|
|
3
|
return $self->{'_xmlDoc'}; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub setRoot |
64
|
|
|
|
|
|
|
{ |
65
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
66
|
0
|
|
|
|
|
0
|
my $root = shift; |
67
|
|
|
|
|
|
|
|
68
|
0
|
0
|
|
|
|
0
|
return XML::Mini->Error("XML::Mini::Document::setRoot(): Trying to set non-XML::Mini::Element as root") |
69
|
|
|
|
|
|
|
unless ($self->isElement($root)); |
70
|
|
|
|
|
|
|
|
71
|
0
|
|
|
|
|
0
|
$self->{'_xmlDoc'} = $root; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub isElement |
75
|
|
|
|
|
|
|
{ |
76
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
77
|
0
|
|
0
|
|
|
0
|
my $element = shift || return undef; |
78
|
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
0
|
my $type = ref $element; |
80
|
|
|
|
|
|
|
|
81
|
0
|
0
|
|
|
|
0
|
return undef unless $type; |
82
|
|
|
|
|
|
|
|
83
|
0
|
0
|
|
|
|
0
|
return 0 unless ($type =~ /^XML::Mini::Element/); |
84
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
0
|
return 1; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub isNode |
89
|
|
|
|
|
|
|
{ |
90
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
91
|
0
|
|
0
|
|
|
0
|
my $element = shift || return undef; |
92
|
|
|
|
|
|
|
|
93
|
0
|
|
|
|
|
0
|
my $type = ref $element; |
94
|
|
|
|
|
|
|
|
95
|
0
|
0
|
|
|
|
0
|
return undef unless $type; |
96
|
|
|
|
|
|
|
|
97
|
0
|
0
|
|
|
|
0
|
return 0 unless ($type =~ /^XML::Mini::Node/); |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
0
|
return 1; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub createElement |
103
|
|
|
|
|
|
|
{ |
104
|
1
|
|
|
1
|
1
|
6
|
my $self = shift; |
105
|
1
|
|
|
|
|
3
|
my $name = shift; |
106
|
1
|
|
|
|
|
1
|
my $value = shift; # optional |
107
|
|
|
|
|
|
|
|
108
|
1
|
|
|
|
|
4
|
my $newElement = XML::Mini::Element->new($name); |
109
|
|
|
|
|
|
|
|
110
|
1
|
50
|
|
|
|
5
|
return XML::Mini->Error("Could not create new element named '$name'") |
111
|
|
|
|
|
|
|
unless ($newElement); |
112
|
|
|
|
|
|
|
|
113
|
1
|
50
|
|
|
|
6
|
if (defined $value) |
114
|
|
|
|
|
|
|
{ |
115
|
0
|
|
|
|
|
0
|
$newElement->text($value); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
1
|
|
|
|
|
2
|
return $newElement; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub getElementByPath |
122
|
|
|
|
|
|
|
{ |
123
|
4
|
|
|
4
|
1
|
1501
|
my $self = shift; |
124
|
4
|
|
|
|
|
12
|
my $path = shift; |
125
|
4
|
|
|
|
|
31
|
my @elementNumbers = @_; |
126
|
|
|
|
|
|
|
|
127
|
4
|
|
|
|
|
29
|
my $element = $self->{'_xmlDoc'}->getElementByPath($path, @elementNumbers); |
128
|
4
|
50
|
|
|
|
20
|
if ($XML::Mini::Debug) |
129
|
|
|
|
|
|
|
{ |
130
|
0
|
0
|
|
|
|
0
|
if ($element) |
131
|
|
|
|
|
|
|
{ |
132
|
0
|
|
|
|
|
0
|
XML::Mini->Log("XML::Mini::Document::getElementByPath(): element at $path found."); |
133
|
|
|
|
|
|
|
} else { |
134
|
0
|
|
|
|
|
0
|
XML::Mini->Log("XML::Mini::Document::getElement(): element at $path NOT found."); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
4
|
|
|
|
|
15
|
return $element; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub getElement |
142
|
|
|
|
|
|
|
{ |
143
|
4
|
|
|
4
|
1
|
665
|
my $self = shift; |
144
|
4
|
|
|
|
|
8
|
my $name = shift; |
145
|
4
|
|
|
|
|
7
|
my $elementNumber = shift; # optionally get only the ith element |
146
|
|
|
|
|
|
|
|
147
|
4
|
|
|
|
|
19
|
my $element = $self->{'_xmlDoc'}->getElement($name, $elementNumber); |
148
|
|
|
|
|
|
|
|
149
|
4
|
50
|
|
|
|
11
|
if ($XML::Mini::Debug) |
150
|
|
|
|
|
|
|
{ |
151
|
0
|
0
|
|
|
|
0
|
if ($element) |
152
|
|
|
|
|
|
|
{ |
153
|
0
|
|
|
|
|
0
|
XML::Mini->Log("XML::Mini::Document::getElement(): element named $name found."); |
154
|
|
|
|
|
|
|
} else { |
155
|
0
|
|
|
|
|
0
|
XML::Mini->Log("XML::Mini::Document::getElement(): element named $name NOT found."); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
4
|
|
|
|
|
16
|
return $element; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub fromString |
163
|
|
|
|
|
|
|
{ |
164
|
12
|
|
|
12
|
1
|
30
|
my $self = shift; |
165
|
12
|
|
|
|
|
23
|
my $string = shift; |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
|
168
|
12
|
50
|
|
|
|
48
|
if ($XML::Mini::CheckXMLBeforeParsing) |
169
|
|
|
|
|
|
|
{ |
170
|
12
|
|
|
|
|
25
|
my $copy = $string; |
171
|
|
|
|
|
|
|
|
172
|
12
|
|
|
|
|
512
|
$copy =~ s/<\s*\?\s*xml.*?\?>//smg; |
173
|
12
|
|
|
|
|
86
|
$copy =~ s///smg; |
174
|
|
|
|
|
|
|
|
175
|
12
|
|
|
|
|
56
|
$copy =~s/]*>//smg; |
176
|
12
|
|
|
|
|
87
|
$copy =~ s/]*>//smg; |
177
|
12
|
|
|
|
|
51
|
$copy =~ s/]*>//smg; |
178
|
12
|
|
|
|
|
2925
|
$copy =~ s/<\s*[^\s>]+[^>]*\/\s*>//smg; # get rid of tags |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# get rid of all pairs of tags... |
181
|
12
|
|
|
|
|
32
|
my %counts; |
182
|
12
|
|
|
|
|
96
|
while ($copy =~ m/<\s*([^\/\s>]+)[^>]*>/smg) |
183
|
|
|
|
|
|
|
{ |
184
|
850
|
100
|
|
|
|
2450
|
$counts{$1}->{'open'} = 0 unless (exists $counts{$1}->{'open'}); |
185
|
850
|
|
|
|
|
3808
|
$counts{$1}->{'open'}++; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
12
|
|
|
|
|
104
|
while ($copy =~ m/<\s*\/\s*([^\s>]+)(\s[^>]*)?>/smg) |
189
|
|
|
|
|
|
|
{ |
190
|
848
|
100
|
|
|
|
2155
|
$counts{$1}->{'close'} = 0 unless (exists $counts{$1}->{'close'}); |
191
|
848
|
|
|
|
|
3621
|
$counts{$1}->{'close'}++; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# anything left |
195
|
12
|
|
|
|
|
29
|
my @unmatched; |
196
|
12
|
|
|
|
|
82
|
while (my ($tag, $res) = each %counts) |
197
|
|
|
|
|
|
|
{ |
198
|
157
|
100
|
66
|
|
|
1487
|
unless ($res->{'open'} && $res->{'close'} |
|
|
|
66
|
|
|
|
|
199
|
|
|
|
|
|
|
&& $res->{'open'} == $res->{'close'} ) |
200
|
|
|
|
|
|
|
{ |
201
|
1
|
|
|
|
|
5
|
push @unmatched, $tag; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
12
|
100
|
|
|
|
142
|
if (scalar @unmatched) |
206
|
|
|
|
|
|
|
{ |
207
|
1
|
50
|
|
|
|
4
|
if ($XML::Mini::DieOnBadXML) |
208
|
|
|
|
|
|
|
{ |
209
|
0
|
|
|
|
|
0
|
XML::Mini->Error("Found unmatched tags in your XML... " . join(',', @unmatched)); |
210
|
|
|
|
|
|
|
} else { |
211
|
|
|
|
|
|
|
|
212
|
1
|
|
|
|
|
9
|
XML::Mini->Log("Found unmatched tags in your XML... " . join(',', @unmatched)); |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
1
|
|
|
|
|
9
|
return 0; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# passed our basic check... |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
|
222
|
11
|
|
|
|
|
63
|
$self->fromSubString($self->{'_xmlDoc'}, $string); |
223
|
|
|
|
|
|
|
|
224
|
11
|
|
|
|
|
85
|
return $self->{'_xmlDoc'}->numChildren(); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub fromFile |
228
|
|
|
|
|
|
|
{ |
229
|
9
|
|
|
9
|
1
|
36
|
my $self = shift; |
230
|
9
|
|
|
|
|
17
|
my $filename = shift; |
231
|
|
|
|
|
|
|
|
232
|
9
|
|
|
|
|
19
|
my $fRef = \$filename; |
233
|
9
|
|
|
|
|
15
|
my $contents; |
234
|
9
|
100
|
66
|
|
|
89
|
if (ref($filename) && UNIVERSAL::isa($filename, 'IO::Handle')) |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
235
|
|
|
|
|
|
|
{ |
236
|
1
|
|
|
|
|
116
|
$contents = join("", $filename->getlines()); |
237
|
1
|
|
|
|
|
211
|
$filename->close(); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
} elsif (ref $fRef eq 'GLOB') { |
240
|
|
|
|
|
|
|
|
241
|
1
|
|
|
|
|
48
|
$contents = join('', $fRef->getlines()); |
242
|
1
|
|
|
|
|
211
|
$fRef->close(); |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
} elsif (ref $fRef eq 'SCALAR') { |
245
|
|
|
|
|
|
|
|
246
|
7
|
50
|
|
|
|
254
|
return XML::Mini->Error("XML::Mini::Document::fromFile() Can't find file $filename") |
247
|
|
|
|
|
|
|
unless (-e $filename); |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
|
250
|
7
|
50
|
|
|
|
118
|
return XML::Mini->Error("XML::Mini::Document::fromFile() Can't read file $filename") |
251
|
|
|
|
|
|
|
unless (-r $filename); |
252
|
|
|
|
|
|
|
|
253
|
7
|
|
|
|
|
73
|
my $infile = FileHandle->new(); |
254
|
7
|
50
|
|
|
|
392
|
$infile->open( "<$filename") |
255
|
|
|
|
|
|
|
|| return XML::Mini->Error("XML::Mini::Document::fromFile() Could not open $filename for read: $!"); |
256
|
7
|
|
|
|
|
822
|
$contents = join("", $infile->getlines()); |
257
|
7
|
|
|
|
|
1186
|
$infile->close(); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
9
|
|
|
|
|
261
|
return $self->fromString($contents); |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub parse |
264
|
|
|
|
|
|
|
{ |
265
|
7
|
|
|
7
|
1
|
667
|
my $self = shift; |
266
|
7
|
|
|
|
|
14
|
my $input = shift; |
267
|
|
|
|
|
|
|
|
268
|
7
|
|
|
|
|
14
|
my $inRef = \$input; |
269
|
7
|
|
|
|
|
19
|
my $type = ref($inRef); |
270
|
|
|
|
|
|
|
|
271
|
7
|
100
|
100
|
|
|
62
|
if ($type eq 'SCALAR' && $input =~ m|<[^>]+>|sm) |
272
|
|
|
|
|
|
|
{ |
273
|
|
|
|
|
|
|
# we have some XML |
274
|
3
|
|
|
|
|
18
|
return $self->fromString($input); |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
} else { |
277
|
|
|
|
|
|
|
# hope it's a file name or handle |
278
|
4
|
|
|
|
|
17
|
return $self->fromFile($input); |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
sub fromHash { |
285
|
2
|
|
|
2
|
1
|
1317
|
my $self = shift; |
286
|
2
|
|
50
|
|
|
10
|
my $href = shift || return XML::Mini->Error("XML::Mini::Document::fromHash - must pass a hash reference"); |
287
|
2
|
|
50
|
|
|
7
|
my $params = shift || {}; |
288
|
|
|
|
|
|
|
|
289
|
2
|
|
|
|
|
13
|
$self->init(); |
290
|
|
|
|
|
|
|
|
291
|
2
|
50
|
|
|
|
8
|
if ($params->{'attributes'}) |
292
|
|
|
|
|
|
|
{ |
293
|
2
|
|
|
|
|
4
|
my %attribs; |
294
|
2
|
|
|
|
|
4
|
while (my ($attribName, $value) = each %{$params->{'attributes'}}) |
|
7
|
|
|
|
|
34
|
|
295
|
|
|
|
|
|
|
{ |
296
|
5
|
|
100
|
|
|
23
|
my $vType = ref $value || ""; |
297
|
5
|
100
|
|
|
|
10
|
if ($vType) |
298
|
|
|
|
|
|
|
{ |
299
|
2
|
50
|
|
|
|
9
|
if ($vType eq 'ARRAY') |
300
|
|
|
|
|
|
|
{ |
301
|
2
|
|
|
|
|
2
|
foreach my $v (@{$value}) |
|
2
|
|
|
|
|
5
|
|
302
|
|
|
|
|
|
|
{ |
303
|
5
|
|
|
|
|
17
|
$attribs{$attribName}->{$v}++; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
} else { |
308
|
3
|
|
|
|
|
13
|
$attribs{$attribName}->{$value}++; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
2
|
|
|
|
|
6
|
$params->{'attributes'} = \%attribs; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
|
317
|
2
|
|
|
|
|
8
|
while (my ($keyname, $value) = each %{$href}) |
|
4
|
|
|
|
|
18
|
|
318
|
|
|
|
|
|
|
{ |
319
|
|
|
|
|
|
|
|
320
|
2
|
|
|
|
|
12
|
my $sub = $self->_fromHash_getExtractSub(ref $value); |
321
|
|
|
|
|
|
|
|
322
|
2
|
|
|
|
|
12
|
$self->$sub($keyname, $value, $self->{'_xmlDoc'}, $params); |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
2
|
|
|
|
|
27
|
return $self->{'_xmlDoc'}->numChildren(); |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub _fromHash_getExtractSub { |
331
|
49
|
|
|
49
|
|
70
|
my $self = shift; |
332
|
49
|
|
100
|
|
|
160
|
my $valType = shift || 'STRING'; |
333
|
|
|
|
|
|
|
|
334
|
49
|
|
|
|
|
85
|
my $sub = "_fromHash_extract$valType"; |
335
|
|
|
|
|
|
|
|
336
|
49
|
50
|
|
|
|
184
|
return XML::Mini->Error("XML::Mini::Document::fromHash Don't know how to interpret '$valType' values") |
337
|
|
|
|
|
|
|
unless ($self->can($sub)); |
338
|
|
|
|
|
|
|
|
339
|
49
|
|
|
|
|
98
|
return $sub; |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub _fromHash_extractHASH { |
345
|
11
|
|
|
11
|
|
13
|
my $self = shift; |
346
|
11
|
|
|
|
|
12
|
my $name = shift; |
347
|
11
|
|
50
|
|
|
25
|
my $value = shift || return XML::Mini->Error("XML::Mini::Document::extractHASHref No value passed!"); |
348
|
11
|
|
50
|
|
|
22
|
my $parent = shift || return XML::Mini->Error("XML::Mini::Document::extractHASHref No parent element passed!"); |
349
|
11
|
|
50
|
|
|
24
|
my $params = shift || {}; |
350
|
|
|
|
|
|
|
|
351
|
11
|
50
|
|
|
|
18
|
return XML::Mini->Error("XML::Mini::Document::extractHASHref No element name passed!") |
352
|
|
|
|
|
|
|
unless (defined $name); |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
|
355
|
11
|
|
|
|
|
34
|
my $thisElement = $parent->createChild($name); |
356
|
|
|
|
|
|
|
|
357
|
11
|
|
|
|
|
15
|
while (my ($key, $val) = each %{$value}) |
|
50
|
|
|
|
|
167
|
|
358
|
|
|
|
|
|
|
{ |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
|
361
|
39
|
|
|
|
|
86
|
my $sub = $self->_fromHash_getExtractSub(ref $val); |
362
|
|
|
|
|
|
|
|
363
|
39
|
|
|
|
|
101
|
$self->$sub($key, $val, $thisElement, $params); |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
11
|
|
|
|
|
35
|
return ; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub _fromHash_extractARRAY { |
371
|
3
|
|
|
3
|
|
5
|
my $self = shift; |
372
|
3
|
|
|
|
|
4
|
my $name = shift; |
373
|
3
|
|
50
|
|
|
8
|
my $values = shift || return XML::Mini->Error("XML::Mini::Document::extractARRAYref No value passed!"); |
374
|
3
|
|
50
|
|
|
10
|
my $parent = shift || return XML::Mini->Error("XML::Mini::Document::extractARRAYref No parent element passed!"); |
375
|
3
|
|
50
|
|
|
7
|
my $params = shift || {}; |
376
|
|
|
|
|
|
|
|
377
|
3
|
50
|
|
|
|
8
|
return XML::Mini->Error("XML::Mini::Document::extractARRAYref No element name passed!") |
378
|
|
|
|
|
|
|
unless (defined $name); |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
# every element in an array ref is a child element of the parent |
381
|
3
|
|
|
|
|
5
|
foreach my $val (@{$values}) |
|
3
|
|
|
|
|
7
|
|
382
|
|
|
|
|
|
|
{ |
383
|
9
|
|
|
|
|
16
|
my $valRef = ref $val; |
384
|
|
|
|
|
|
|
|
385
|
9
|
100
|
|
|
|
19
|
if ($valRef) |
386
|
|
|
|
|
|
|
{ |
387
|
|
|
|
|
|
|
# this is a complex element |
388
|
|
|
|
|
|
|
#my $childElement = $parent->createChild($name); |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
# process sub elements |
391
|
8
|
|
|
|
|
20
|
my $sub = $self->_fromHash_getExtractSub($valRef); |
392
|
|
|
|
|
|
|
|
393
|
8
|
|
|
|
|
24
|
$self->$sub($name, $val, $parent, $params); |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
} else { |
396
|
|
|
|
|
|
|
# simple string |
397
|
1
|
|
|
|
|
3
|
$self->_fromHash_extractSTRING($name, $val, $parent, $params); |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
|
404
|
3
|
|
|
|
|
11
|
return; |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub _fromHash_extractSTRING { |
409
|
36
|
|
|
36
|
|
46
|
my $self = shift; |
410
|
36
|
|
|
|
|
41
|
my $name = shift; |
411
|
36
|
|
|
|
|
38
|
my $val = shift ; |
412
|
36
|
|
50
|
|
|
73
|
my $parent = shift || return XML::Mini->Error("XML::Mini::Document::extractSTRING No parent element passed!"); |
413
|
36
|
|
50
|
|
|
67
|
my $params = shift || {}; |
414
|
|
|
|
|
|
|
|
415
|
36
|
50
|
|
|
|
80
|
return XML::Mini->Error("XML::Mini::Document::extractSTRING No element name passed!") |
416
|
|
|
|
|
|
|
unless (defined $name); |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
|
419
|
36
|
50
|
|
|
|
62
|
return XML::Mini->Error("XML::Mini::Document::extractSTRING No value passed!") |
420
|
|
|
|
|
|
|
unless (defined $val); |
421
|
|
|
|
|
|
|
|
422
|
36
|
|
|
|
|
98
|
my $pname = $parent->name(); |
423
|
|
|
|
|
|
|
|
424
|
36
|
100
|
100
|
|
|
207
|
if ($params->{'attributes'}->{$pname}->{$name} || $params->{'attributes'}->{'-all'}->{$name}) |
|
|
100
|
|
|
|
|
|
425
|
|
|
|
|
|
|
{ |
426
|
14
|
|
|
|
|
40
|
$parent->attribute($name, $val); |
427
|
|
|
|
|
|
|
} elsif ($name eq '-content') { |
428
|
|
|
|
|
|
|
|
429
|
4
|
|
|
|
|
13
|
$parent->text($val); |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
} else { |
432
|
18
|
|
|
|
|
55
|
$parent->createChild($name, $val); |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
36
|
|
|
|
|
95
|
return ; |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
sub toHash { |
443
|
2
|
|
|
2
|
1
|
1056
|
my $self = shift; |
444
|
|
|
|
|
|
|
|
445
|
2
|
|
|
|
|
13
|
my $retVal = $self->{'_xmlDoc'}->toStructure(); |
446
|
|
|
|
|
|
|
|
447
|
2
|
|
|
|
|
6
|
my $type = ref $retVal; |
448
|
|
|
|
|
|
|
|
449
|
2
|
50
|
33
|
|
|
18
|
if ($type && $type eq 'HASH') |
450
|
|
|
|
|
|
|
{ |
451
|
2
|
|
|
|
|
8
|
return $retVal; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
0
|
|
|
|
|
0
|
my $retHash = { |
455
|
|
|
|
|
|
|
'-content' => $retVal, |
456
|
|
|
|
|
|
|
}; |
457
|
|
|
|
|
|
|
|
458
|
0
|
|
|
|
|
0
|
return $retHash; |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
sub toString |
465
|
|
|
|
|
|
|
{ |
466
|
3
|
|
|
3
|
1
|
1299
|
my $self = shift; |
467
|
3
|
|
50
|
|
|
25
|
my $depth = shift || 0; |
468
|
|
|
|
|
|
|
|
469
|
3
|
|
|
|
|
21
|
my $retString = $self->{'_xmlDoc'}->toString($depth); |
470
|
|
|
|
|
|
|
|
471
|
3
|
|
|
|
|
51
|
$retString =~ s/<\/PSYCHOGENIC_ROOT_ELEMENT>//smi; |
472
|
3
|
|
|
|
|
27
|
$retString =~ s/]*)?>\s*//smi; |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
|
475
|
3
|
|
|
|
|
21
|
return $retString; |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
sub fromSubStringBT { |
479
|
1632
|
|
|
1632
|
0
|
2298
|
my $self = shift; |
480
|
1632
|
|
|
|
|
1772
|
my $parentElement = shift; |
481
|
1632
|
|
|
|
|
1939
|
my $XMLString = shift; |
482
|
1632
|
|
|
|
|
1697
|
my $useIgnore = shift; |
483
|
|
|
|
|
|
|
|
484
|
1632
|
50
|
|
|
|
7525
|
if ($XML::Mini::Debug) |
485
|
|
|
|
|
|
|
{ |
486
|
0
|
|
|
|
|
0
|
XML::Mini->Log("Called fromSubStringBT() with parent '" . $parentElement->name() . "'\n"); |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
|
489
|
1632
|
|
|
|
|
1679
|
my @res; |
490
|
1632
|
100
|
|
|
|
2445
|
if ($useIgnore) |
491
|
|
|
|
|
|
|
{ |
492
|
70
|
|
|
|
|
227
|
my $ignore = [ '<\s*[^\s>]+[^>]*\/\s*>', # |
493
|
|
|
|
|
|
|
'<\?\s*[^\s>]+\s*[^>]*\?>', # |
494
|
|
|
|
|
|
|
'', # |
495
|
|
|
|
|
|
|
'\s*', # CDATA |
496
|
|
|
|
|
|
|
']*)(\[.*?\])?\s*>', # DOCTYPE |
497
|
|
|
|
|
|
|
']+>' |
498
|
|
|
|
|
|
|
]; |
499
|
|
|
|
|
|
|
|
500
|
70
|
|
|
|
|
380
|
@res = Text::Balanced::extract_tagged($XMLString, undef, undef, undef, { 'ignore' => $ignore }); |
501
|
|
|
|
|
|
|
} else { |
502
|
1562
|
|
|
|
|
4105
|
@res = Text::Balanced::extract_tagged($XMLString); |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
|
505
|
1632
|
100
|
|
|
|
1771279
|
if ($#res == 5) |
506
|
|
|
|
|
|
|
{ |
507
|
|
|
|
|
|
|
# We've extracted a balanced .. |
508
|
|
|
|
|
|
|
|
509
|
847
|
|
|
|
|
1607
|
my $extracted = $res[0]; # the entire .. |
510
|
847
|
|
|
|
|
1210
|
my $remainder = $res[1]; # stuff after the ..HERE - 3 |
511
|
847
|
|
|
|
|
993
|
my $prefix = $res[3]; # the itself - 1 |
512
|
847
|
|
|
|
|
1078
|
my $contents = $res[4]; # the '..' between .. - 2 |
513
|
847
|
|
|
|
|
1020
|
my $suffix = $res[5]; # the |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
#XML::Mini->Log("Grabbed prefix '$prefix'..."); |
516
|
847
|
|
|
|
|
998
|
my $newElement; |
517
|
|
|
|
|
|
|
|
518
|
847
|
50
|
|
|
|
4373
|
if ($prefix =~ m|<\s*([^\s>]+)\s*([^>]*)>|) |
519
|
|
|
|
|
|
|
{ |
520
|
847
|
|
|
|
|
1593
|
my $name = $1; |
521
|
847
|
|
|
|
|
1334
|
my $attribs = $2; |
522
|
847
|
|
|
|
|
3052
|
$newElement = $parentElement->createChild($name); |
523
|
847
|
100
|
|
|
|
1977
|
$self->_extractAttributesFromString($newElement, $attribs) if ($attribs); |
524
|
|
|
|
|
|
|
|
525
|
847
|
50
|
|
|
|
4928
|
$self->fromSubStringBT($newElement, $contents) if ($contents =~ m|\S|); |
526
|
|
|
|
|
|
|
|
527
|
847
|
100
|
|
|
|
5729
|
$self->fromSubStringBT($parentElement, $remainder) if ($remainder =~ m|\S|); |
528
|
|
|
|
|
|
|
} else { |
529
|
|
|
|
|
|
|
|
530
|
0
|
|
|
|
|
0
|
XML::Mini->Log("XML::Mini::Document::fromSubStringBT extracted balanced text from invalid tag '$prefix' - ignoring"); |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
} else { |
533
|
|
|
|
|
|
|
|
534
|
785
|
|
|
|
|
3276
|
$XMLString =~ s/>\s*\n/>/gsm; |
535
|
785
|
100
|
|
|
|
14615
|
if ($XMLString =~ m/^\s*<\s*([^\s>]+)([^>]*>).*<\s*\/\1\s*>/osm) |
536
|
|
|
|
|
|
|
{ |
537
|
|
|
|
|
|
|
# starts with a normal ... but has some ?? in it |
538
|
|
|
|
|
|
|
|
539
|
91
|
|
|
|
|
277
|
my $startTag = $2; |
540
|
91
|
100
|
|
|
|
715
|
return $self->fromSubStringBT($parentElement, $XMLString, 'USEIGNORE') |
541
|
|
|
|
|
|
|
unless ($startTag =~ m|/\s*>$|); |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
# not a ... |
545
|
|
|
|
|
|
|
#it's either a |
546
|
715
|
50
|
|
|
|
3773
|
if ($XMLString =~ m/^\s*(<\s*([^\s>]+)([^>]+)\/\s*>| # |
547
|
|
|
|
|
|
|
<\?\s*([^\s>]+)\s*([^>]*)\?>| # |
548
|
|
|
|
|
|
|
| # |
549
|
|
|
|
|
|
|
\s*| # CDATA |
550
|
|
|
|
|
|
|
]*)(\[.*?\])?\s*>\s*| # DOCTYPE |
551
|
|
|
|
|
|
|
]+)\s*(["'])([^\11]+)\11\s*>\s*| # ENTITY |
552
|
|
|
|
|
|
|
([^<]+))(.*)/xogsmi) # plain text |
553
|
|
|
|
|
|
|
{ |
554
|
715
|
|
|
|
|
1509
|
my $firstPart = $1; |
555
|
715
|
|
|
|
|
1052
|
my $unaryName = $2; |
556
|
715
|
|
|
|
|
1184
|
my $unaryAttribs = $3; |
557
|
715
|
|
|
|
|
1114
|
my $headerName = $4; |
558
|
715
|
|
|
|
|
882
|
my $headerAttribs= $5; |
559
|
715
|
|
|
|
|
866
|
my $comment = $6; |
560
|
715
|
|
|
|
|
900
|
my $cdata = $7; |
561
|
715
|
|
|
|
|
849
|
my $doctype = $8; |
562
|
715
|
|
|
|
|
900
|
my $doctypeCont = $9; |
563
|
715
|
|
|
|
|
877
|
my $entityName = $10; |
564
|
715
|
|
|
|
|
828
|
my $entityCont = $12; |
565
|
715
|
|
|
|
|
1124
|
my $plainText = $13; |
566
|
715
|
|
|
|
|
2143
|
my $remainder = $14; |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
# There is some duplication here that should be merged with that in fromSubString() |
571
|
715
|
100
|
66
|
|
|
6737
|
if ($unaryName) |
|
|
100
|
33
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
572
|
|
|
|
|
|
|
{ |
573
|
125
|
|
|
|
|
452
|
my $newElement = $parentElement->createChild($unaryName); |
574
|
125
|
50
|
|
|
|
450
|
$self->_extractAttributesFromString($newElement, $unaryAttribs) if ($unaryAttribs); |
575
|
|
|
|
|
|
|
} elsif ($headerName) |
576
|
|
|
|
|
|
|
{ |
577
|
11
|
|
|
|
|
115
|
my $newElement = XML::Mini::Element::Header->new($headerName); |
578
|
11
|
50
|
|
|
|
66
|
$self->_extractAttributesFromString($newElement, $headerAttribs) if ($headerAttribs); |
579
|
11
|
|
|
|
|
59
|
$parentElement->appendChild($newElement); |
580
|
|
|
|
|
|
|
} elsif (defined $comment) { |
581
|
2
|
|
|
|
|
12
|
$parentElement->comment($comment); |
582
|
|
|
|
|
|
|
} elsif (defined $cdata) { |
583
|
0
|
|
|
|
|
0
|
my $newElement = XML::Mini::Element::CData->new($cdata); |
584
|
0
|
|
|
|
|
0
|
$parentElement->appendChild($newElement); |
585
|
|
|
|
|
|
|
} elsif ($doctype || defined $doctypeCont) { |
586
|
7
|
|
|
|
|
71
|
my $newElement = XML::Mini::Element::DocType->new($doctype); |
587
|
7
|
|
|
|
|
31
|
$parentElement->appendChild($newElement); |
588
|
7
|
50
|
|
|
|
31
|
if ($doctypeCont) |
589
|
|
|
|
|
|
|
{ |
590
|
0
|
|
|
|
|
0
|
$doctypeCont =~ s/^\s*\[//smg; |
591
|
0
|
|
|
|
|
0
|
$doctypeCont =~ s/\]\s*$//smg; |
592
|
|
|
|
|
|
|
|
593
|
0
|
|
|
|
|
0
|
$self->fromSubStringBT($newElement, $doctypeCont); |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
} elsif (defined $entityName) { |
596
|
0
|
|
|
|
|
0
|
my $newElement = XML::Mini::Element::Entity->new($entityName, $entityCont); |
597
|
0
|
|
|
|
|
0
|
$parentElement->appendChild($newElement); |
598
|
|
|
|
|
|
|
} elsif (defined $plainText && $plainText =~ m|\S|sm) |
599
|
|
|
|
|
|
|
{ |
600
|
570
|
|
|
|
|
1736
|
$parentElement->createNode($plainText); |
601
|
|
|
|
|
|
|
} else { |
602
|
0
|
0
|
|
|
|
0
|
XML::Mini->Log("NO MATCH???") if ($XML::Mini::Debug); |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
|
606
|
715
|
100
|
66
|
|
|
4545
|
if (defined $remainder && $remainder =~ m|\S|sm) |
607
|
|
|
|
|
|
|
{ |
608
|
119
|
|
|
|
|
783
|
$self->fromSubStringBT($parentElement, $remainder); |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
} else { |
612
|
|
|
|
|
|
|
# No match here either... |
613
|
0
|
0
|
|
|
|
0
|
XML::Mini->Log("No match in fromSubStringBT() for '$XMLString'") if ($XML::Mini::Debug); |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
} # end if it matches one of our other tags or plain text |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
} # end if Text::Balanced returned a match |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
} # end fromSubStringBT() |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
sub fromSubString |
626
|
|
|
|
|
|
|
{ |
627
|
11
|
|
|
11
|
0
|
24
|
my $self = shift; |
628
|
11
|
|
|
|
|
19
|
my $parentElement = shift; |
629
|
11
|
|
|
|
|
20
|
my $XMLString = shift; |
630
|
|
|
|
|
|
|
|
631
|
11
|
50
|
|
|
|
35
|
if ($XML::Mini::Debug) |
632
|
|
|
|
|
|
|
{ |
633
|
0
|
|
|
|
|
0
|
XML::Mini->Log("Called fromSubString() with parent '" . $parentElement->name() . "'\n"); |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# The heart of the parsing is here, in our mega regex |
638
|
|
|
|
|
|
|
# The sections are for: |
639
|
|
|
|
|
|
|
# ... |
640
|
|
|
|
|
|
|
# |
641
|
|
|
|
|
|
|
# |
642
|
|
|
|
|
|
|
# |
643
|
|
|
|
|
|
|
# |
644
|
|
|
|
|
|
|
# |
645
|
|
|
|
|
|
|
# plain text |
646
|
|
|
|
|
|
|
#=~/<\s*([^\s>]+)([^>]+)?>(.*?)<\s*\/\\1\s*>\s*([^<]+)?(.*) |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
|
649
|
11
|
50
|
|
|
|
40
|
if ($TextBalancedAvailable) |
650
|
|
|
|
|
|
|
{ |
651
|
11
|
|
|
|
|
39
|
return $self->fromSubStringBT($parentElement, $XMLString); |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
|
654
|
0
|
|
|
|
|
0
|
while ($XMLString =~/\s*<\s*([^\s>]+)([^>]+)?>(.*?)<\s*\/\1\s*>\s*([^<]+)?(.*)| |
655
|
|
|
|
|
|
|
\s*\s*| |
656
|
|
|
|
|
|
|
\s*<\s*([^\s>]+)\s*([^>]*)\/\s*>\s*([^<>]+)?| |
657
|
|
|
|
|
|
|
\s*\s*| |
658
|
|
|
|
|
|
|
\s*]*)(\[.*?\])?\s*>\s*| |
659
|
|
|
|
|
|
|
\s*]+)\s*(["'])([^\14]+)\14\s*>\s*| |
660
|
|
|
|
|
|
|
\s*<\?\s*([^\s>]+)\s*([^>]*)\?>| |
661
|
|
|
|
|
|
|
^([^<]+)(.*)/xogsmi) |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
{ |
665
|
|
|
|
|
|
|
# Check which string matched.' |
666
|
0
|
|
|
|
|
0
|
my $uname = $7; |
667
|
0
|
|
|
|
|
0
|
my $comment = $6; |
668
|
0
|
|
|
|
|
0
|
my $cdata = $10; |
669
|
0
|
|
|
|
|
0
|
my $doctypedef = $11; |
670
|
0
|
0
|
|
|
|
0
|
if ($12) |
671
|
|
|
|
|
|
|
{ |
672
|
0
|
0
|
|
|
|
0
|
if ($doctypedef) |
673
|
|
|
|
|
|
|
{ |
674
|
0
|
|
|
|
|
0
|
$doctypedef .= ' ' . $12; |
675
|
|
|
|
|
|
|
} else { |
676
|
0
|
|
|
|
|
0
|
$doctypedef = $12; |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
|
680
|
0
|
|
|
|
|
0
|
my $entityname = $13; |
681
|
0
|
|
|
|
|
0
|
my $headername = $16; |
682
|
0
|
|
|
|
|
0
|
my $headerAttribs = $17; |
683
|
0
|
|
|
|
|
0
|
my $plaintext = $18; |
684
|
|
|
|
|
|
|
|
685
|
0
|
0
|
|
|
|
0
|
if (defined $uname) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
686
|
|
|
|
|
|
|
{ |
687
|
0
|
|
|
|
|
0
|
my $ufinaltxt = $9; |
688
|
0
|
|
|
|
|
0
|
my $newElement = $parentElement->createChild($uname); |
689
|
0
|
|
|
|
|
0
|
$self->_extractAttributesFromString($newElement, $8); |
690
|
0
|
0
|
0
|
|
|
0
|
if (defined $ufinaltxt && $ufinaltxt =~ m|\S+|) |
691
|
|
|
|
|
|
|
{ |
692
|
0
|
|
|
|
|
0
|
$parentElement->createNode($ufinaltxt); |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
} elsif (defined $headername) |
695
|
|
|
|
|
|
|
{ |
696
|
0
|
|
|
|
|
0
|
my $newElement = XML::Mini::Element::Header->new($headername); |
697
|
0
|
0
|
|
|
|
0
|
$self->_extractAttributesFromString($newElement, $headerAttribs) if ($headerAttribs); |
698
|
0
|
|
|
|
|
0
|
$parentElement->appendChild($newElement); |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
} elsif (defined $comment) { |
701
|
|
|
|
|
|
|
#my $newElement = XML::Mini::Element::Comment->new('!--'); |
702
|
|
|
|
|
|
|
#$newElement->createNode($comment); |
703
|
0
|
|
|
|
|
0
|
$parentElement->comment($comment); |
704
|
|
|
|
|
|
|
} elsif (defined $cdata) { |
705
|
0
|
|
|
|
|
0
|
my $newElement = XML::Mini::Element::CData->new($cdata); |
706
|
0
|
|
|
|
|
0
|
$parentElement->appendChild($newElement); |
707
|
|
|
|
|
|
|
} elsif (defined $doctypedef) { |
708
|
|
|
|
|
|
|
|
709
|
0
|
|
|
|
|
0
|
my $newElement = XML::Mini::Element::DocType->new($11); |
710
|
0
|
|
|
|
|
0
|
$parentElement->appendChild($newElement); |
711
|
0
|
|
|
|
|
0
|
$self->fromSubString($newElement, $doctypedef); |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
} elsif (defined $entityname) { |
714
|
|
|
|
|
|
|
|
715
|
0
|
|
|
|
|
0
|
my $newElement = XML::Mini::Element::Entity->new($entityname, $15); |
716
|
0
|
|
|
|
|
0
|
$parentElement->appendChild($newElement); |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
} elsif (defined $plaintext) { |
719
|
|
|
|
|
|
|
|
720
|
0
|
|
|
|
|
0
|
my $afterTxt = $19; |
721
|
0
|
0
|
|
|
|
0
|
if ($plaintext !~ /^\s+$/) |
722
|
|
|
|
|
|
|
{ |
723
|
0
|
|
|
|
|
0
|
$parentElement->createNode($plaintext); |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
|
726
|
0
|
0
|
|
|
|
0
|
if (defined $afterTxt) |
727
|
|
|
|
|
|
|
{ |
728
|
0
|
|
|
|
|
0
|
$self->fromSubString($parentElement, $afterTxt); |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
} elsif ($1) { |
731
|
|
|
|
|
|
|
|
732
|
0
|
|
|
|
|
0
|
my $nencl = $3; |
733
|
0
|
|
|
|
|
0
|
my $finaltxt = $4; |
734
|
0
|
|
|
|
|
0
|
my $otherTags = $5; |
735
|
0
|
|
|
|
|
0
|
my $newElement = $parentElement->createChild($1); |
736
|
0
|
|
|
|
|
0
|
$self->_extractAttributesFromString($newElement, $2); |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
|
739
|
0
|
0
|
|
|
|
0
|
if ($nencl =~ /^\s*([^\s<][^<]*)/) |
740
|
|
|
|
|
|
|
{ |
741
|
0
|
|
|
|
|
0
|
my $txt = $1; |
742
|
0
|
|
|
|
|
0
|
$newElement->createNode($txt); |
743
|
0
|
|
|
|
|
0
|
$nencl =~ s/^\s*[^<]+//; |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
|
746
|
0
|
|
|
|
|
0
|
$self->fromSubString($newElement, $nencl); |
747
|
|
|
|
|
|
|
|
748
|
0
|
0
|
|
|
|
0
|
if (defined $finaltxt) |
749
|
|
|
|
|
|
|
{ |
750
|
0
|
|
|
|
|
0
|
$parentElement->createNode($finaltxt); |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
|
753
|
0
|
0
|
|
|
|
0
|
if (defined $otherTags) |
754
|
|
|
|
|
|
|
{ |
755
|
0
|
|
|
|
|
0
|
$self->fromSubString($parentElement, $otherTags); |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
} # end while matches |
759
|
|
|
|
|
|
|
} #* end method fromSubString */ |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
sub toFile |
762
|
|
|
|
|
|
|
{ |
763
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
764
|
0
|
|
0
|
|
|
0
|
my $filename = shift || return XML::Mini->Error("XML::Mini::Document::toFile - must pass a filename to save to"); |
765
|
0
|
|
|
|
|
0
|
my $safe = shift; |
766
|
|
|
|
|
|
|
|
767
|
0
|
|
|
|
|
0
|
my $dir = $filename; |
768
|
|
|
|
|
|
|
|
769
|
0
|
|
|
|
|
0
|
$dir =~ s|(.+/)?[^/]+$|$1|; |
770
|
|
|
|
|
|
|
|
771
|
0
|
0
|
|
|
|
0
|
if ($dir) |
772
|
|
|
|
|
|
|
{ |
773
|
0
|
0
|
0
|
|
|
0
|
return XML::Mini->Error("XML::Mini::Document::toFile - called with file '$filename' but cannot find director $dir") |
774
|
|
|
|
|
|
|
unless (-e $dir && -d $dir); |
775
|
0
|
0
|
|
|
|
0
|
return XML::Mini->Error("XML::Mini::Document::toFile - called with file '$filename' but no permission to write to dir $dir") |
776
|
|
|
|
|
|
|
unless (-w $dir); |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
|
779
|
0
|
|
|
|
|
0
|
my $contents = $self->toString(); |
780
|
|
|
|
|
|
|
|
781
|
0
|
0
|
|
|
|
0
|
return XML::Mini->Error("XML::Mini::Document::toFile - got nothing back from call to toString()") |
782
|
|
|
|
|
|
|
unless ($contents); |
783
|
|
|
|
|
|
|
|
784
|
0
|
|
|
|
|
0
|
my $outfile = FileHandle->new(); |
785
|
|
|
|
|
|
|
|
786
|
0
|
0
|
|
|
|
0
|
if ($safe) |
787
|
|
|
|
|
|
|
{ |
788
|
0
|
0
|
0
|
|
|
0
|
if ($filename =~ m|/\.\./| || $filename =~ m|#;`\*|) |
789
|
|
|
|
|
|
|
{ |
790
|
0
|
|
|
|
|
0
|
return XML::Mini->Error("XML::Mini::Document::toFile() Filename '$filename' invalid with SAFE flag on"); |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
|
793
|
0
|
0
|
|
|
|
0
|
if (-e $filename) |
794
|
|
|
|
|
|
|
{ |
795
|
0
|
0
|
|
|
|
0
|
if ($safe =~ /NOOVERWRITE/i) |
796
|
|
|
|
|
|
|
{ |
797
|
0
|
|
|
|
|
0
|
return XML::Mini->Error("XML::Mini::Document::toFile() file '$filename' exists and SAFE flag is '$safe'"); |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
|
800
|
0
|
0
|
|
|
|
0
|
if (-l $filename) |
801
|
|
|
|
|
|
|
{ |
802
|
0
|
|
|
|
|
0
|
return XML::Mini->Error("XML::Mini::Document::toFile() file '$filename' is a " |
803
|
|
|
|
|
|
|
. "symbolic link and SAFE flag is on"); |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
0
|
0
|
|
|
|
0
|
$outfile->open( ">$filename") |
809
|
|
|
|
|
|
|
|| return XML::Mini->Error("XML::Mini::Document::toFile() Could not open $filename for write: $!"); |
810
|
0
|
|
|
|
|
0
|
$outfile->print($contents); |
811
|
0
|
|
|
|
|
0
|
$outfile->close(); |
812
|
0
|
|
|
|
|
0
|
return length($contents); |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
sub getValue |
816
|
|
|
|
|
|
|
{ |
817
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
818
|
0
|
|
|
|
|
0
|
return $self->{'_xmlDoc'}->getValue(); |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
sub dump |
822
|
|
|
|
|
|
|
{ |
823
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
824
|
0
|
|
|
|
|
0
|
return Dumper($self); |
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
#// _extractAttributesFromString |
828
|
|
|
|
|
|
|
#// private method for extracting and setting the attributs from a |
829
|
|
|
|
|
|
|
#// ' a="b" c = "d"' string |
830
|
|
|
|
|
|
|
sub _extractAttributesFromString |
831
|
|
|
|
|
|
|
{ |
832
|
356
|
|
|
356
|
|
467
|
my $self = shift; |
833
|
356
|
|
|
|
|
403
|
my $element = shift; |
834
|
356
|
|
|
|
|
455
|
my $attrString = shift; |
835
|
|
|
|
|
|
|
|
836
|
356
|
50
|
|
|
|
703
|
return undef unless (defined $attrString); |
837
|
356
|
|
|
|
|
413
|
my $count = 0; |
838
|
356
|
|
|
|
|
2604
|
while ($attrString =~ /([^\s]+)\s*=\s*(['"])([^\2]*?)\2/g) |
839
|
|
|
|
|
|
|
{ |
840
|
381
|
|
|
|
|
672
|
my $attrname = $1; |
841
|
381
|
|
|
|
|
597
|
my $attrval = $3; |
842
|
|
|
|
|
|
|
|
843
|
381
|
50
|
|
|
|
784
|
if (defined $attrname) |
844
|
|
|
|
|
|
|
{ |
845
|
381
|
100
|
66
|
|
|
1635
|
$attrval = '' unless (defined $attrval && length($attrval)); |
846
|
381
|
|
|
|
|
1171
|
$element->attribute($attrname, $attrval, ''); |
847
|
381
|
|
|
|
|
1345
|
$count++; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
} |
850
|
|
|
|
|
|
|
|
851
|
356
|
|
|
|
|
694
|
return $count; |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
1; |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
__END__ |