File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/XML/Bare.pm |
Statements Executed | 102 |
Statement Execution Time | 4.54ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 2 | 557µs | 557µs | bootstrap (xsub) | XML::Bare::
1 | 1 | 1 | 242µs | 245µs | BEGIN@6 | XML::Bare::
1 | 1 | 1 | 187µs | 190µs | BEGIN@524 | XML::Bare::
3 | 1 | 1 | 113µs | 424µs | xmlin | XML::Bare::
3 | 1 | 1 | 71µs | 185µs | simple | XML::Bare::
3 | 1 | 2 | 66µs | 66µs | xml2obj_simple (xsub) | XML::Bare::
3 | 1 | 1 | 58µs | 112µs | new | XML::Bare::
3 | 1 | 2 | 53µs | 53µs | c_parse (xsub) | XML::Bare::
3 | 1 | 1 | 26µs | 41µs | free_tree | XML::Bare::
1 | 1 | 1 | 16µs | 51µs | BEGIN@3 | XML::Bare::
3 | 1 | 1 | 16µs | 16µs | DESTROY | XML::Bare::
3 | 1 | 2 | 14µs | 14µs | free_tree_c (xsub) | XML::Bare::
1 | 1 | 1 | 8µs | 38µs | BEGIN@15 | XML::Bare::
1 | 1 | 1 | 8µs | 10µs | BEGIN@4 | XML::Bare::
3 | 1 | 2 | 7µs | 7µs | get_root (xsub) | XML::Bare::
1 | 1 | 1 | 5µs | 52µs | BEGIN@5 | XML::Bare::
0 | 0 | 0 | 0s | 0s | add_node | XML::Bare::
0 | 0 | 0 | 0s | 0s | add_node_after | XML::Bare::
0 | 0 | 0 | 0s | 0s | check | XML::Bare::
0 | 0 | 0 | 0s | 0s | checkone | XML::Bare::
0 | 0 | 0 | 0s | 0s | clean | XML::Bare::
0 | 0 | 0 | 0s | 0s | del_by_perl | XML::Bare::
0 | 0 | 0 | 0s | 0s | del_node | XML::Bare::
0 | 0 | 0 | 0s | 0s | find_by_perl | XML::Bare::
0 | 0 | 0 | 0s | 0s | find_node | XML::Bare::
0 | 0 | 0 | 0s | 0s | forcearray | XML::Bare::
0 | 0 | 0 | 0s | 0s | html | XML::Bare::
0 | 0 | 0 | 0s | 0s | lineinfo | XML::Bare::
0 | 0 | 0 | 0s | 0s | merge | XML::Bare::
0 | 0 | 0 | 0s | 0s | new_node | XML::Bare::
0 | 0 | 0 | 0s | 0s | newhash | XML::Bare::
0 | 0 | 0 | 0s | 0s | obj2html | XML::Bare::
0 | 0 | 0 | 0s | 0s | obj2xml | XML::Bare::
0 | 0 | 0 | 0s | 0s | parse | XML::Bare::
0 | 0 | 0 | 0s | 0s | readxbs | XML::Bare::
0 | 0 | 0 | 0s | 0s | save | XML::Bare::
0 | 0 | 0 | 0s | 0s | simplify | XML::Bare::
0 | 0 | 0 | 0s | 0s | tohtml | XML::Bare::
0 | 0 | 0 | 0s | 0s | xget | XML::Bare::
0 | 0 | 0 | 0s | 0s | xml | XML::Bare::
0 | 0 | 0 | 0s | 0s | xval | XML::Bare::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package XML::Bare; | ||||
2 | |||||
3 | 3 | 31µs | 2 | 86µs | # spent 51µs (16+35) within XML::Bare::BEGIN@3 which was called
# once (16µs+35µs) by SimpleDB::Client::BEGIN@48 at line 3 # spent 51µs making 1 call to XML::Bare::BEGIN@3
# spent 35µs making 1 call to Exporter::import |
4 | 3 | 21µs | 2 | 12µs | # spent 10µs (8+2) within XML::Bare::BEGIN@4 which was called
# once (8µs+2µs) by SimpleDB::Client::BEGIN@48 at line 4 # spent 10µs making 1 call to XML::Bare::BEGIN@4
# spent 2µs making 1 call to strict::import |
5 | 3 | 21µs | 2 | 99µs | # spent 52µs (5+47) within XML::Bare::BEGIN@5 which was called
# once (5µs+47µs) by SimpleDB::Client::BEGIN@48 at line 5 # spent 52µs making 1 call to XML::Bare::BEGIN@5
# spent 47µs making 1 call to vars::import |
6 | 3 | 279µs | 2 | 248µs | # spent 245µs (242+3) within XML::Bare::BEGIN@6 which was called
# once (242µs+3µs) by SimpleDB::Client::BEGIN@48 at line 6 # spent 245µs making 1 call to XML::Bare::BEGIN@6
# spent 3µs making 1 call to utf8::import |
7 | 1 | 800ns | require Exporter; | ||
8 | 1 | 800ns | require DynaLoader; | ||
9 | 1 | 13µs | @ISA = qw(Exporter DynaLoader); | ||
10 | |||||
11 | |||||
12 | 1 | 300ns | $VERSION = "0.45"; | ||
13 | |||||
14 | |||||
15 | 3 | 2.17ms | 2 | 68µs | # spent 38µs (8+30) within XML::Bare::BEGIN@15 which was called
# once (8µs+30µs) by SimpleDB::Client::BEGIN@48 at line 15 # spent 38µs making 1 call to XML::Bare::BEGIN@15
# spent 30µs making 1 call to vars::import |
16 | |||||
17 | 1 | 4µs | *AUTOLOAD = \&XML::Bare::AUTOLOAD; | ||
18 | 1 | 5µs | 1 | 20.3ms | bootstrap XML::Bare $VERSION; # spent 20.3ms making 1 call to DynaLoader::bootstrap |
19 | |||||
20 | |||||
21 | |||||
22 | 1 | 1µs | @EXPORT = qw( ); | ||
23 | 1 | 5µs | @EXPORT_OK = qw( xget merge clean add_node del_node find_node del_node forcearray del_by_perl xmlin xval ); | ||
24 | |||||
25 | =head1 NAME | ||||
26 | |||||
27 | XML::Bare - Minimal XML parser implemented via a C state engine | ||||
28 | |||||
29 | =head1 VERSION | ||||
30 | |||||
31 | 0.45 | ||||
32 | |||||
33 | =cut | ||||
34 | |||||
35 | # spent 112µs (58+53) within XML::Bare::new which was called 3 times, avg 37µs/call:
# 3 times (58µs+53µs) by XML::Bare::xmlin at line 125, avg 37µs/call | ||||
36 | 3 | 2µs | my $class = shift; | ||
37 | 3 | 10µs | my $self = { @_ }; | ||
38 | |||||
39 | 3 | 76µs | 3 | 53µs | if( $self->{ 'text' } ) { # spent 53µs making 3 calls to XML::Bare::c_parse, avg 18µs/call |
40 | XML::Bare::c_parse( $self->{'text'} ); | ||||
41 | } | ||||
42 | else { | ||||
43 | my $res = open( XML, $self->{ 'file' } ); | ||||
44 | if( !$res ) { | ||||
45 | $self->{ 'xml' } = 0; | ||||
46 | return 0; | ||||
47 | } | ||||
48 | { | ||||
49 | local $/ = undef; | ||||
50 | $self->{'text'} = <XML>; | ||||
51 | } | ||||
52 | close( XML ); | ||||
53 | XML::Bare::c_parse( $self->{'text'} ); | ||||
54 | } | ||||
55 | 3 | 12µs | bless $self, $class; | ||
56 | 3 | 16µs | return $self if( !wantarray ); | ||
57 | return ( $self, $self->parse() ); | ||||
58 | } | ||||
59 | |||||
60 | # spent 16µs within XML::Bare::DESTROY which was called 3 times, avg 5µs/call:
# 3 times (16µs+0s) by XML::Bare::xmlin at line 245 of ../lib/SimpleDB/Client.pm, avg 5µs/call | ||||
61 | 3 | 2µs | my $self = shift; | ||
62 | 3 | 15µs | undef $self->{'xml'}; | ||
63 | } | ||||
64 | |||||
65 | sub xget { | ||||
66 | my $hash = shift; | ||||
67 | return map $_->{'value'}, @{%$hash}{@_}; | ||||
68 | } | ||||
69 | |||||
70 | sub forcearray { | ||||
71 | my $ref = shift; | ||||
72 | return [] if( !$ref ); | ||||
73 | return $ref if( ref( $ref ) eq 'ARRAY' ); | ||||
74 | return [ $ref ]; | ||||
75 | } | ||||
76 | |||||
77 | sub merge { | ||||
78 | # shift in the two array references as well as the field to merge on | ||||
79 | my ( $a, $b, $id ) = @_; | ||||
80 | my %hash = map { $_->{ $id } ? ( $_->{ $id }->{ 'value' } => $_ ) : ( 0 => 0 ) } @$a; | ||||
81 | for my $one ( @$b ) { | ||||
82 | next if( !$one->{ $id } ); | ||||
83 | my $short = $hash{ $one->{ $id }->{ 'value' } }; | ||||
84 | next if( !$short ); | ||||
85 | foreach my $key ( keys %$one ) { | ||||
86 | next if( $key eq '_pos' || $key eq 'id' ); | ||||
87 | my $cur = $short->{ $key }; | ||||
88 | my $add = $one->{ $key }; | ||||
89 | if( !$cur ) { $short->{ $key } = $add; } | ||||
90 | else { | ||||
91 | my $type = ref( $cur ); | ||||
92 | if( $type eq 'HASH' ) { | ||||
93 | my @arr; | ||||
94 | $short->{ $key } = \@arr; | ||||
95 | push( @arr, $cur ); | ||||
96 | } | ||||
97 | if( ref( $add ) eq 'HASH' ) { | ||||
98 | push( @{$short->{ $key }}, $add ); | ||||
99 | } | ||||
100 | else { # we are merging an array | ||||
101 | push( @{$short->{ $key }}, @$add ); | ||||
102 | } | ||||
103 | } | ||||
104 | # we need to deal with the case where this node | ||||
105 | # is already there, either alone or as an array | ||||
106 | } | ||||
107 | } | ||||
108 | return $a; | ||||
109 | } | ||||
110 | |||||
111 | sub clean { | ||||
112 | my $ob = new XML::Bare( @_ ); | ||||
113 | my $root = $ob->parse(); | ||||
114 | if( $ob->{'save'} ) { | ||||
115 | $ob->{'file'} = $ob->{'save'} if( "$ob->{'save'}" ne "1" ); | ||||
116 | $ob->save(); | ||||
117 | return; | ||||
118 | } | ||||
119 | return $ob->xml( $root ); | ||||
120 | } | ||||
121 | |||||
122 | # spent 424µs (113+312) within XML::Bare::xmlin which was called 3 times, avg 142µs/call:
# 3 times (113µs+312µs) by SimpleDB::Client::handle_response at line 245 of ../lib/SimpleDB/Client.pm, avg 142µs/call | ||||
123 | 3 | 3µs | my $text = shift; | ||
124 | 3 | 4µs | my %ops = ( @_ ); | ||
125 | 3 | 19µs | 3 | 112µs | my $ob = new XML::Bare( text => $text ); # spent 112µs making 3 calls to XML::Bare::new, avg 37µs/call |
126 | 3 | 14µs | 3 | 185µs | my $simple = $ob->simple(); # spent 185µs making 3 calls to XML::Bare::simple, avg 62µs/call |
127 | 3 | 3µs | if( !$ops{'keeproot'} ) { | ||
128 | 3 | 12µs | my @keys = keys %$simple; | ||
129 | 3 | 2µs | my $first = $keys[0]; | ||
130 | 3 | 5µs | $simple = $simple->{ $first } if( $first ); | ||
131 | } | ||||
132 | 3 | 20µs | return $simple; | ||
133 | } | ||||
134 | |||||
135 | sub tohtml { | ||||
136 | my %ops = ( @_ ); | ||||
137 | my $ob = new XML::Bare( %ops ); | ||||
138 | return $ob->html( $ob->parse(), $ops{'root'} || 'xml' ); | ||||
139 | } | ||||
140 | |||||
141 | # Load a file using XML::DOM, convert it to a hash, and return the hash | ||||
142 | sub parse { | ||||
143 | my $self = shift; | ||||
144 | |||||
145 | my $res = XML::Bare::xml2obj(); | ||||
146 | $self->{'structroot'} = XML::Bare::get_root(); | ||||
147 | $self->free_tree(); | ||||
148 | |||||
149 | if( defined( $self->{'scheme'} ) ) { | ||||
150 | $self->{'xbs'} = new XML::Bare( %{ $self->{'scheme'} } ); | ||||
151 | } | ||||
152 | if( defined( $self->{'xbs'} ) ) { | ||||
153 | my $xbs = $self->{'xbs'}; | ||||
154 | my $ob = $xbs->parse(); | ||||
155 | $self->{'xbso'} = $ob; | ||||
156 | readxbs( $ob ); | ||||
157 | } | ||||
158 | |||||
159 | if( $res < 0 ) { croak "Error at ".$self->lineinfo( -$res ); } | ||||
160 | $self->{ 'xml' } = $res; | ||||
161 | |||||
162 | if( defined( $self->{'xbso'} ) ) { | ||||
163 | my $ob = $self->{'xbso'}; | ||||
164 | my $cres = $self->check( $res, $ob ); | ||||
165 | croak( $cres ) if( $cres ); | ||||
166 | } | ||||
167 | |||||
168 | return $self->{ 'xml' }; | ||||
169 | } | ||||
170 | |||||
171 | sub lineinfo { | ||||
172 | my $self = shift; | ||||
173 | my $res = shift; | ||||
174 | my $line = 1; | ||||
175 | my $j = 0; | ||||
176 | for( my $i=0;$i<$res;$i++ ) { | ||||
177 | my $let = substr( $self->{'text'}, $i, 1 ); | ||||
178 | if( ord($let) == 10 ) { | ||||
179 | $line++; | ||||
180 | $j = $i; | ||||
181 | } | ||||
182 | } | ||||
183 | my $part = substr( $self->{'text'}, $res, 10 ); | ||||
184 | $part =~ s/\n//g; | ||||
185 | $res -= $j; | ||||
186 | if( $self->{'offset'} ) { | ||||
187 | my $off = $self->{'offset'}; | ||||
188 | $line += $off; | ||||
189 | return "$off line $line char $res \"$part\""; | ||||
190 | } | ||||
191 | return "line $line char $res \"$part\""; | ||||
192 | } | ||||
193 | |||||
194 | # xml bare schema | ||||
195 | sub check { | ||||
196 | my ( $self, $node, $scheme, $parent ) = @_; | ||||
197 | |||||
198 | my $fail = ''; | ||||
199 | if( ref( $scheme ) eq 'ARRAY' ) { | ||||
200 | for my $one ( @$scheme ) { | ||||
201 | my $res = $self->checkone( $node, $one, $parent ); | ||||
202 | return 0 if( !$res ); | ||||
203 | $fail .= "$res\n"; | ||||
204 | } | ||||
205 | } | ||||
206 | else { return $self->checkone( $node, $scheme, $parent ); } | ||||
207 | return $fail; | ||||
208 | } | ||||
209 | |||||
210 | sub checkone { | ||||
211 | my ( $self, $node, $scheme, $parent ) = @_; | ||||
212 | |||||
213 | for my $key ( keys %$node ) { | ||||
214 | next if( substr( $key, 0, 1 ) eq '_' || $key eq '_att' || $key eq 'comment' ); | ||||
215 | if( $key eq 'value' ) { | ||||
216 | my $val = $node->{ 'value' }; | ||||
217 | my $regexp = $scheme->{'value'}; | ||||
218 | if( $regexp ) { | ||||
219 | if( $val !~ m/^($regexp)$/ ) { | ||||
220 | my $linfo = $self->lineinfo( $node->{'_i'} ); | ||||
221 | return "Value of '$parent' node ($val) does not match /$regexp/ [$linfo]"; | ||||
222 | } | ||||
223 | } | ||||
224 | next; | ||||
225 | } | ||||
226 | my $sub = $node->{ $key }; | ||||
227 | my $ssub = $scheme->{ $key }; | ||||
228 | if( !$ssub ) { #&& ref( $schemesub ) ne 'HASH' | ||||
229 | my $linfo = $self->lineinfo( $sub->{'_i'} ); | ||||
230 | return "Invalid node '$key' in xml [$linfo]"; | ||||
231 | } | ||||
232 | if( ref( $sub ) eq 'HASH' ) { | ||||
233 | my $res = $self->check( $sub, $ssub, $key ); | ||||
234 | return $res if( $res ); | ||||
235 | } | ||||
236 | if( ref( $sub ) eq 'ARRAY' ) { | ||||
237 | my $asub = $ssub; | ||||
238 | if( ref( $asub ) eq 'ARRAY' ) { | ||||
239 | $asub = $asub->[0]; | ||||
240 | } | ||||
241 | if( $asub->{'_t'} ) { | ||||
242 | my $max = $asub->{'_max'} || 0; | ||||
243 | if( $#$sub >= $max ) { | ||||
244 | my $linfo = $self->lineinfo( $sub->[0]->{'_i'} ); | ||||
245 | return "Too many nodes of type '$key'; max $max; [$linfo]" | ||||
246 | } | ||||
247 | my $min = $asub->{'_min'} || 0; | ||||
248 | if( ($#$sub+1)<$min ) { | ||||
249 | my $linfo = $self->lineinfo( $sub->[0]->{'_i'} ); | ||||
250 | return "Not enough nodes of type '$key'; min $min [$linfo]" | ||||
251 | } | ||||
252 | } | ||||
253 | for( @$sub ) { | ||||
254 | my $res = $self->check( $_, $ssub, $key ); | ||||
255 | return $res if( $res ); | ||||
256 | } | ||||
257 | } | ||||
258 | } | ||||
259 | if( my $dem = $scheme->{'_demand'} ) { | ||||
260 | for my $req ( @{$scheme->{'_demand'}} ) { | ||||
261 | my $ck = $node->{ $req }; | ||||
262 | if( !$ck ) { | ||||
263 | my $linfo = $self->lineinfo( $node->{'_i'} ); | ||||
264 | return "Required node '$req' does not exist [$linfo]" | ||||
265 | } | ||||
266 | if( ref( $ck ) eq 'ARRAY' ) { | ||||
267 | my $linfo = $self->lineinfo( $node->{'_i'} ); | ||||
268 | return "Required node '$req' is empty array [$linfo]" if( $#$ck == -1 ); | ||||
269 | } | ||||
270 | } | ||||
271 | } | ||||
272 | return 0; | ||||
273 | } | ||||
274 | |||||
275 | |||||
276 | sub readxbs { # xbs = xml bare schema | ||||
277 | my $node = shift; | ||||
278 | my @demand; | ||||
279 | for my $key ( keys %$node ) { | ||||
280 | next if( substr( $key, 0, 1 ) eq '_' || $key eq '_att' || $key eq 'comment' ); | ||||
281 | if( $key eq 'value' ) { | ||||
282 | my $val = $node->{'value'}; | ||||
283 | delete $node->{'value'} if( $val =~ m/^\W*$/ ); | ||||
284 | next; | ||||
285 | } | ||||
286 | my $sub = $node->{ $key }; | ||||
287 | |||||
288 | if( $key =~ m/([a-z_]+)([^a-z_]+)/ ) { | ||||
289 | my $name = $1; | ||||
290 | my $t = $2; | ||||
291 | my $min; | ||||
292 | my $max; | ||||
293 | if( $t eq '+' ) { | ||||
294 | $min = 1; | ||||
295 | $max = 1000; | ||||
296 | } | ||||
297 | elsif( $t eq '*' ) { | ||||
298 | $min = 0; | ||||
299 | $max = 1000; | ||||
300 | } | ||||
301 | elsif( $t eq '?' ) { | ||||
302 | $min = 0; | ||||
303 | $max = 1; | ||||
304 | } | ||||
305 | elsif( $t eq '@' ) { | ||||
306 | $name = 'multi_'.$name; | ||||
307 | $min = 1; | ||||
308 | $max = 1; | ||||
309 | } | ||||
310 | elsif( $t =~ m/\{([0-9]+),([0-9]+)\}/ ) { | ||||
311 | $min = $1; | ||||
312 | $max = $2; | ||||
313 | $t = 'r'; # range | ||||
314 | } | ||||
315 | |||||
316 | if( ref( $sub ) eq 'HASH' ) { | ||||
317 | my $res = readxbs( $sub ); | ||||
318 | $sub->{'_t'} = $t; | ||||
319 | $sub->{'_min'} = $min; | ||||
320 | $sub->{'_max'} = $max; | ||||
321 | } | ||||
322 | if( ref( $sub ) eq 'ARRAY' ) { | ||||
323 | for my $item ( @$sub ) { | ||||
324 | my $res = readxbs( $item ); | ||||
325 | $item->{'_t'} = $t; | ||||
326 | $item->{'_min'} = $min; | ||||
327 | $item->{'_max'} = $max; | ||||
328 | } | ||||
329 | } | ||||
330 | |||||
331 | push( @demand, $name ) if( $min ); | ||||
332 | $node->{$name} = $node->{$key}; | ||||
333 | delete $node->{$key}; | ||||
334 | } | ||||
335 | else { | ||||
336 | if( ref( $sub ) eq 'HASH' ) { | ||||
337 | readxbs( $sub ); | ||||
338 | $sub->{'_t'} = 'r'; | ||||
339 | $sub->{'_min'} = 1; | ||||
340 | $sub->{'_max'} = 1; | ||||
341 | } | ||||
342 | if( ref( $sub ) eq 'ARRAY' ) { | ||||
343 | for my $item ( @$sub ) { | ||||
344 | readxbs( $item ); | ||||
345 | $item->{'_t'} = 'r'; | ||||
346 | $item->{'_min'} = 1; | ||||
347 | $item->{'_max'} = 1; | ||||
348 | } | ||||
349 | } | ||||
350 | |||||
351 | push( @demand, $key ); | ||||
352 | } | ||||
353 | } | ||||
354 | if( @demand ) { $node->{'_demand'} = \@demand; } | ||||
355 | } | ||||
356 | |||||
357 | # spent 185µs (71+114) within XML::Bare::simple which was called 3 times, avg 62µs/call:
# 3 times (71µs+114µs) by XML::Bare::xmlin at line 126, avg 62µs/call | ||||
358 | 3 | 2µs | my $self = shift; | ||
359 | |||||
360 | 3 | 84µs | 3 | 66µs | my $res = XML::Bare::xml2obj_simple();#$self->xml2obj(); # spent 66µs making 3 calls to XML::Bare::xml2obj_simple, avg 22µs/call |
361 | 3 | 24µs | 3 | 7µs | $self->{'structroot'} = XML::Bare::get_root(); # spent 7µs making 3 calls to XML::Bare::get_root, avg 2µs/call |
362 | 3 | 10µs | 3 | 41µs | $self->free_tree(); # spent 41µs making 3 calls to XML::Bare::free_tree, avg 14µs/call |
363 | |||||
364 | 3 | 3µs | if( $res < 0 ) { croak "Error at ".$self->lineinfo( -$res ); } | ||
365 | 3 | 5µs | $self->{ 'xml' } = $res; | ||
366 | |||||
367 | 3 | 14µs | return $self->{ 'xml' }; | ||
368 | } | ||||
369 | |||||
370 | sub add_node { | ||||
371 | my ( $self, $node, $name ) = @_; | ||||
372 | my @newar; | ||||
373 | my %blank; | ||||
374 | $node->{ 'multi_'.$name } = \%blank if( ! $node->{ 'multi_'.$name } ); | ||||
375 | $node->{ $name } = \@newar if( ! $node->{ $name } ); | ||||
376 | my $newnode = new_node( 0, splice( @_, 3 ) ); | ||||
377 | push( @{ $node->{ $name } }, $newnode ); | ||||
378 | return $newnode; | ||||
379 | } | ||||
380 | |||||
381 | sub add_node_after { | ||||
382 | my ( $self, $node, $prev, $name ) = @_; | ||||
383 | my @newar; | ||||
384 | my %blank; | ||||
385 | $node->{ 'multi_'.$name } = \%blank if( ! $node->{ 'multi_'.$name } ); | ||||
386 | $node->{ $name } = \@newar if( ! $node->{ $name } ); | ||||
387 | my $newnode = $self->new_node( splice( @_, 4 ) ); | ||||
388 | |||||
389 | my $cur = 0; | ||||
390 | for my $anode ( @{ $node->{ $name } } ) { | ||||
391 | $anode->{'_pos'} = $cur if( !$anode->{'_pos'} ); | ||||
392 | $cur++; | ||||
393 | } | ||||
394 | my $opos = $prev->{'_pos'}; | ||||
395 | for my $anode ( @{ $node->{ $name } } ) { | ||||
396 | $anode->{'_pos'}++ if( $anode->{'_pos'} > $opos ); | ||||
397 | } | ||||
398 | $newnode->{'_pos'} = $opos + 1; | ||||
399 | |||||
400 | push( @{ $node->{ $name } }, $newnode ); | ||||
401 | |||||
402 | return $newnode; | ||||
403 | } | ||||
404 | |||||
405 | sub find_by_perl { | ||||
406 | my $arr = shift; | ||||
407 | my $cond = shift; | ||||
408 | $cond =~ s/-([a-z]+)/\$ob->\{'$1'\}->\{'value'\}/g; | ||||
409 | my @res; | ||||
410 | foreach my $ob ( @$arr ) { push( @res, $ob ) if( eval( $cond ) ); } | ||||
411 | return \@res; | ||||
412 | } | ||||
413 | |||||
414 | sub find_node { | ||||
415 | my $self = shift; | ||||
416 | my $node = shift; | ||||
417 | my $name = shift; | ||||
418 | my %match = @_; | ||||
419 | #croak "Cannot search empty node for $name" if( !$node ); | ||||
420 | #$node = $node->{ $name } or croak "Cannot find $name"; | ||||
421 | $node = $node->{ $name } or return 0; | ||||
422 | return 0 if( !$node ); | ||||
423 | if( ref( $node ) eq 'HASH' ) { | ||||
424 | foreach my $key ( keys %match ) { | ||||
425 | my $val = $match{ $key }; | ||||
426 | next if ( !$val ); | ||||
427 | if( $node->{ $key }->{'value'} eq $val ) { | ||||
428 | return $node; | ||||
429 | } | ||||
430 | } | ||||
431 | } | ||||
432 | if( ref( $node ) eq 'ARRAY' ) { | ||||
433 | for( my $i = 0; $i <= $#$node; $i++ ) { | ||||
434 | my $one = $node->[ $i ]; | ||||
435 | foreach my $key ( keys %match ) { | ||||
436 | my $val = $match{ $key }; | ||||
437 | croak('undefined value in find') unless defined $val; | ||||
438 | if( $one->{ $key }->{'value'} eq $val ) { | ||||
439 | return $node->[ $i ]; | ||||
440 | } | ||||
441 | } | ||||
442 | } | ||||
443 | } | ||||
444 | return 0; | ||||
445 | } | ||||
446 | |||||
447 | sub del_node { | ||||
448 | my $self = shift; | ||||
449 | my $node = shift; | ||||
450 | my $name = shift; | ||||
451 | my %match = @_; | ||||
452 | $node = $node->{ $name }; | ||||
453 | return if( !$node ); | ||||
454 | for( my $i = 0; $i <= $#$node; $i++ ) { | ||||
455 | my $one = $node->[ $i ]; | ||||
456 | foreach my $key ( keys %match ) { | ||||
457 | my $val = $match{ $key }; | ||||
458 | if( $one->{ $key }->{'value'} eq $val ) { | ||||
459 | delete $node->[ $i ]; | ||||
460 | } | ||||
461 | } | ||||
462 | } | ||||
463 | } | ||||
464 | |||||
465 | sub del_by_perl { | ||||
466 | my $arr = shift; | ||||
467 | my $cond = shift; | ||||
468 | $cond =~ s/-value/\$ob->\{'value'\}/g; | ||||
469 | $cond =~ s/-([a-z]+)/\$ob->\{'$1'\}->\{'value'\}/g; | ||||
470 | my @res; | ||||
471 | for( my $i = 0; $i <= $#$arr; $i++ ) { | ||||
472 | my $ob = $arr->[ $i ]; | ||||
473 | delete $arr->[ $i ] if( eval( $cond ) ); | ||||
474 | } | ||||
475 | return \@res; | ||||
476 | } | ||||
477 | |||||
478 | # Created a node of XML hash with the passed in variables already set | ||||
479 | sub new_node { | ||||
480 | my $self = shift; | ||||
481 | my %parts = @_; | ||||
482 | |||||
483 | my %newnode; | ||||
484 | foreach( keys %parts ) { | ||||
485 | my $val = $parts{$_}; | ||||
486 | if( m/^_/ || ref( $val ) eq 'HASH' ) { | ||||
487 | $newnode{ $_ } = $val; | ||||
488 | } | ||||
489 | else { | ||||
490 | $newnode{ $_ } = { value => $val }; | ||||
491 | } | ||||
492 | } | ||||
493 | |||||
494 | return \%newnode; | ||||
495 | } | ||||
496 | |||||
497 | sub newhash { shift; return { value => shift }; } | ||||
498 | |||||
499 | sub simplify { | ||||
500 | my $self = shift; | ||||
501 | my $root = shift; | ||||
502 | my %ret; | ||||
503 | foreach my $name ( keys %$root ) { | ||||
504 | next if( $name =~ m|^_| || $name eq 'comment' || $name eq 'value' ); | ||||
505 | my $val = xval $root->{$name}; | ||||
506 | $ret{ $name } = $val; | ||||
507 | } | ||||
508 | return \%ret; | ||||
509 | } | ||||
510 | |||||
511 | sub xval { | ||||
512 | return $_[0] ? $_[0]->{'value'} : ( $_[1] || '' ); | ||||
513 | } | ||||
514 | |||||
515 | # Save an XML hash tree into a file | ||||
516 | sub save { | ||||
517 | my $self = shift; | ||||
518 | return if( ! $self->{ 'xml' } ); | ||||
519 | |||||
520 | my $xml = $self->xml( $self->{'xml'} ); | ||||
521 | |||||
522 | my $len; | ||||
523 | { | ||||
524 | 3 | 1.56ms | 2 | 193µs | # spent 190µs (187+3) within XML::Bare::BEGIN@524 which was called
# once (187µs+3µs) by SimpleDB::Client::BEGIN@48 at line 524 # spent 190µs making 1 call to XML::Bare::BEGIN@524
# spent 3µs making 1 call to bytes::import |
525 | $len = length( $xml ); | ||||
526 | } | ||||
527 | return if( !$len ); | ||||
528 | |||||
529 | open F, '>:utf8', $self->{ 'file' }; | ||||
530 | print F $xml; | ||||
531 | |||||
532 | seek( F, 0, 2 ); | ||||
533 | my $cursize = tell( F ); | ||||
534 | if( $cursize != $len ) { # concurrency; we are writing a smaller file | ||||
535 | warn "Truncating File $self->{'file'}"; | ||||
536 | truncate( F, $len ); | ||||
537 | } | ||||
538 | seek( F, 0, 2 ); | ||||
539 | $cursize = tell( F ); | ||||
540 | if( $cursize != $len ) { # still not the right size even after truncate?? | ||||
541 | die "Write problem; $cursize != $len"; | ||||
542 | } | ||||
543 | close F; | ||||
544 | } | ||||
545 | |||||
546 | sub xml { | ||||
547 | my ( $self, $obj, $name ) = @_; | ||||
548 | if( !$name ) { | ||||
549 | my %hash; | ||||
550 | $hash{0} = $obj; | ||||
551 | return obj2xml( \%hash, '', 0 ); | ||||
552 | } | ||||
553 | my %hash; | ||||
554 | $hash{$name} = $obj; | ||||
555 | return obj2xml( \%hash, '', 0 ); | ||||
556 | } | ||||
557 | |||||
558 | sub html { | ||||
559 | my ( $self, $obj, $name ) = @_; | ||||
560 | my $pre = ''; | ||||
561 | if( $self->{'style'} ) { | ||||
562 | $pre = "<style type='text/css'>\@import '$self->{'style'}';</style>"; | ||||
563 | } | ||||
564 | if( !$name ) { | ||||
565 | my %hash; | ||||
566 | $hash{0} = $obj; | ||||
567 | return $pre.obj2html( \%hash, '', 0 ); | ||||
568 | } | ||||
569 | my %hash; | ||||
570 | $hash{$name} = $obj; | ||||
571 | return $pre.obj2html( \%hash, '', 0 ); | ||||
572 | } | ||||
573 | |||||
574 | sub obj2xml { | ||||
575 | my ( $objs, $name, $pad, $level, $pdex ) = @_; | ||||
576 | $level = 0 if( !$level ); | ||||
577 | $pad = '' if( $level <= 2 ); | ||||
578 | my $xml = ''; | ||||
579 | my $att = ''; | ||||
580 | my $imm = 1; | ||||
581 | return '' if( !$objs ); | ||||
582 | #return $objs->{'_raw'} if( $objs->{'_raw'} ); | ||||
583 | my @dex = sort { | ||||
584 | my $oba = $objs->{ $a }; | ||||
585 | my $obb = $objs->{ $b }; | ||||
586 | my $posa = 0; | ||||
587 | my $posb = 0; | ||||
588 | $oba = $oba->[0] if( ref( $oba ) eq 'ARRAY' ); | ||||
589 | $obb = $obb->[0] if( ref( $obb ) eq 'ARRAY' ); | ||||
590 | if( ref( $oba ) eq 'HASH' ) { $posa = $oba->{'_pos'} || 0; } | ||||
591 | if( ref( $obb ) eq 'HASH' ) { $posb = $obb->{'_pos'} || 0; } | ||||
592 | return $posa <=> $posb; | ||||
593 | } keys %$objs; | ||||
594 | for my $i ( @dex ) { | ||||
595 | my $obj = $objs->{ $i } || ''; | ||||
596 | my $type = ref( $obj ); | ||||
597 | if( $type eq 'ARRAY' ) { | ||||
598 | $imm = 0; | ||||
599 | |||||
600 | my @dex2 = sort { | ||||
601 | if( !$a ) { return 0; } | ||||
602 | if( !$b ) { return 0; } | ||||
603 | if( ref( $a ) eq 'HASH' && ref( $b ) eq 'HASH' ) { | ||||
604 | my $posa = $a->{'_pos'}; | ||||
605 | my $posb = $b->{'_pos'}; | ||||
606 | if( !$posa ) { $posa = 0; } | ||||
607 | if( !$posb ) { $posb = 0; } | ||||
608 | return $posa <=> $posb; | ||||
609 | } | ||||
610 | return 0; | ||||
611 | } @$obj; | ||||
612 | |||||
613 | for my $j ( @dex2 ) { | ||||
614 | $xml .= obj2xml( $j, $i, $pad.' ', $level+1, $#dex ); | ||||
615 | } | ||||
616 | } | ||||
617 | elsif( $type eq 'HASH' && $i !~ /^_/ ) { | ||||
618 | if( $obj->{ '_att' } ) { | ||||
619 | $att .= ' ' . $i . '="' . $obj->{ 'value' } . '"' if( $i !~ /^_/ );; | ||||
620 | } | ||||
621 | else { | ||||
622 | $imm = 0; | ||||
623 | $xml .= obj2xml( $obj , $i, $pad.' ', $level+1, $#dex ); | ||||
624 | } | ||||
625 | } | ||||
626 | else { | ||||
627 | if( $i eq 'comment' ) { $xml .= '<!--' . $obj . '-->' . "\n"; } | ||||
628 | elsif( $i eq 'value' ) { | ||||
629 | if( $level > 1 ) { # $#dex < 4 && | ||||
630 | if( $obj && $obj =~ /[<>&;]/ ) { $xml .= '<![CDATA[' . $obj . ']]>'; } | ||||
631 | else { $xml .= $obj if( $obj =~ /\S/ ); } | ||||
632 | } | ||||
633 | } | ||||
634 | elsif( $i =~ /^_/ ) {} | ||||
635 | else { $xml .= '<' . $i . '>' . $obj . '</' . $i . '>'; } | ||||
636 | } | ||||
637 | } | ||||
638 | my $pad2 = $imm ? '' : $pad; | ||||
639 | my $cr = $imm ? '' : "\n"; | ||||
640 | if( substr( $name, 0, 1 ) ne '_' ) { | ||||
641 | if( $name ) { | ||||
642 | if( $xml ) { | ||||
643 | $xml = $pad . '<' . $name . $att . '>' . $cr . $xml . $pad2 . '</' . $name . '>'; | ||||
644 | } | ||||
645 | else { | ||||
646 | $xml = $pad . '<' . $name . $att . ' />'; | ||||
647 | } | ||||
648 | } | ||||
649 | return $xml."\n" if( $level > 1 ); | ||||
650 | return $xml; | ||||
651 | } | ||||
652 | return ''; | ||||
653 | } | ||||
654 | |||||
655 | sub obj2html { | ||||
656 | my ( $objs, $name, $pad, $level, $pdex ) = @_; | ||||
657 | |||||
658 | my $less = "<span class='ang'><</span>"; | ||||
659 | my $more = "<span class='ang'>></span>"; | ||||
660 | my $tn0 = "<span class='tname'>"; | ||||
661 | my $tn1 = "</span>"; | ||||
662 | my $eq0 = "<span class='eq'>"; | ||||
663 | my $eq1 = "</span>"; | ||||
664 | my $qo0 = "<span class='qo'>"; | ||||
665 | my $qo1 = "</span>"; | ||||
666 | my $sp0 = "<span class='sp'>"; | ||||
667 | my $sp1 = "</span>"; | ||||
668 | my $cd0 = ""; | ||||
669 | my $cd1 = ""; | ||||
670 | |||||
671 | $level = 0 if( !$level ); | ||||
672 | $pad = '' if( $level == 1 ); | ||||
673 | my $xml = ''; | ||||
674 | my $att = ''; | ||||
675 | my $imm = 1; | ||||
676 | return '' if( !$objs ); | ||||
677 | my @dex = sort { | ||||
678 | my $oba = $objs->{ $a }; | ||||
679 | my $obb = $objs->{ $b }; | ||||
680 | my $posa = 0; | ||||
681 | my $posb = 0; | ||||
682 | $oba = $oba->[0] if( ref( $oba ) eq 'ARRAY' ); | ||||
683 | $obb = $obb->[0] if( ref( $obb ) eq 'ARRAY' ); | ||||
684 | if( ref( $oba ) eq 'HASH' ) { $posa = $oba->{'_pos'} || 0; } | ||||
685 | if( ref( $obb ) eq 'HASH' ) { $posb = $obb->{'_pos'} || 0; } | ||||
686 | return $posa <=> $posb; | ||||
687 | } keys %$objs; | ||||
688 | |||||
689 | if( $objs->{'_cdata'} ) { | ||||
690 | my $val = $objs->{'value'}; | ||||
691 | $val =~ s/^(\s*\n)+//; | ||||
692 | $val =~ s/\s+$//; | ||||
693 | $val =~ s/&/&/g; | ||||
694 | $val =~ s/</</g; | ||||
695 | $objs->{'value'} = $val; | ||||
696 | #$xml = "$less![CDATA[<div class='node'><div class='cdata'>$val</div></div>]]$more"; | ||||
697 | $cd0 = "$less![CDATA[<div class='node'><div class='cdata'>"; | ||||
698 | $cd1 = "</div></div>]]$more"; | ||||
699 | } | ||||
700 | for my $i ( @dex ) { | ||||
701 | my $obj = $objs->{ $i } || ''; | ||||
702 | my $type = ref( $obj ); | ||||
703 | if( $type eq 'ARRAY' ) { | ||||
704 | $imm = 0; | ||||
705 | |||||
706 | my @dex2 = sort { | ||||
707 | if( !$a ) { return 0; } | ||||
708 | if( !$b ) { return 0; } | ||||
709 | if( ref( $a ) eq 'HASH' && ref( $b ) eq 'HASH' ) { | ||||
710 | my $posa = $a->{'_pos'}; | ||||
711 | my $posb = $b->{'_pos'}; | ||||
712 | if( !$posa ) { $posa = 0; } | ||||
713 | if( !$posb ) { $posb = 0; } | ||||
714 | return $posa <=> $posb; | ||||
715 | } | ||||
716 | return 0; | ||||
717 | } @$obj; | ||||
718 | |||||
719 | for my $j ( @dex2 ) { $xml .= obj2html( $j, $i, $pad.' ', $level+1, $#dex ); } | ||||
720 | } | ||||
721 | elsif( $type eq 'HASH' && $i !~ /^_/ ) { | ||||
722 | if( $obj->{ '_att' } ) { | ||||
723 | my $val = $obj->{ 'value' }; | ||||
724 | $val =~ s/</</g; | ||||
725 | if( $val eq '' ) { | ||||
726 | $att .= " <span class='aname'>$i</span>" if( $i !~ /^_/ ); | ||||
727 | } | ||||
728 | else { | ||||
729 | $att .= " <span class='aname'>$i</span>$eq0=$eq1$qo0\"$qo1$val$qo0\"$qo1" if( $i !~ /^_/ ); | ||||
730 | } | ||||
731 | } | ||||
732 | else { | ||||
733 | $imm = 0; | ||||
734 | $xml .= obj2html( $obj , $i, $pad.' ', $level+1, $#dex ); | ||||
735 | } | ||||
736 | } | ||||
737 | else { | ||||
738 | if( $i eq 'comment' ) { $xml .= "$less!--" . $obj . "--$more" . "<br>\n"; } | ||||
739 | elsif( $i eq 'value' ) { | ||||
740 | if( $level > 1 ) { | ||||
741 | if( $obj && $obj =~ /[<>&;]/ && ! $objs->{'_cdata'} ) { $xml .= "$less![CDATA[$obj]]$more"; } | ||||
742 | else { $xml .= $obj if( $obj =~ /\S/ ); } | ||||
743 | } | ||||
744 | } | ||||
745 | elsif( $i =~ /^_/ ) {} | ||||
746 | else { $xml .= "$less$tn0$i$tn1$more$obj$less/$tn0$i$tn1$more"; } | ||||
747 | } | ||||
748 | } | ||||
749 | my $pad2 = $imm ? '' : $pad; | ||||
750 | if( substr( $name, 0, 1 ) ne '_' ) { | ||||
751 | if( $name ) { | ||||
752 | if( $imm ) { | ||||
753 | if( $xml =~ /\S/ ) { | ||||
754 | $xml = "$sp0$pad$sp1$less$tn0$name$tn1$att$more$cd0$xml$cd1$less/$tn0$name$tn1$more"; | ||||
755 | } | ||||
756 | else { | ||||
757 | $xml = "$sp0$pad$sp1$less$tn0$name$tn1$att/$more"; | ||||
758 | } | ||||
759 | } | ||||
760 | else { | ||||
761 | if( $xml =~ /\S/ ) { | ||||
762 | $xml = "$sp0$pad$sp1$less$tn0$name$tn1$att$more<div class='node'>$xml</div>$sp0$pad$sp1$less/$tn0$name$tn1$more"; | ||||
763 | } | ||||
764 | else { $xml = "$sp0$pad$sp1$less$tn0$name$tn1$att/$more"; } | ||||
765 | } | ||||
766 | } | ||||
767 | $xml .= "<br>" if( $objs->{'_br'} ); | ||||
768 | if( $objs->{'_note'} ) { | ||||
769 | $xml .= "<br>"; | ||||
770 | my $note = $objs->{'_note'}{'value'}; | ||||
771 | my @notes = split( /\|/, $note ); | ||||
772 | for( @notes ) { | ||||
773 | $xml .= "<div class='note'>$sp0$pad$sp1<span class='com'><!--</span> $_ <span class='com'>--></span></div>"; | ||||
774 | } | ||||
775 | } | ||||
776 | return $xml."<br>\n" if( $level ); | ||||
777 | return $xml; | ||||
778 | } | ||||
779 | return ''; | ||||
780 | } | ||||
781 | |||||
782 | 6 | 43µs | 3 | 14µs | # spent 41µs (26+14) within XML::Bare::free_tree which was called 3 times, avg 14µs/call:
# 3 times (26µs+14µs) by XML::Bare::simple at line 362, avg 14µs/call # spent 14µs making 3 calls to XML::Bare::free_tree_c, avg 5µs/call |
783 | |||||
784 | 1 | 25µs | 1; | ||
785 | |||||
786 | __END__ | ||||
787 | |||||
788 | =head1 SYNOPSIS | ||||
789 | |||||
790 | use XML::Bare; | ||||
791 | |||||
792 | my $ob = new XML::Bare( text => '<xml><name>Bob</name></xml>' ); | ||||
793 | |||||
794 | # Parse the xml into a hash tree | ||||
795 | my $root = $ob->parse(); | ||||
796 | |||||
797 | # Print the content of the name node | ||||
798 | print $root->{xml}->{name}->{value}; | ||||
799 | |||||
800 | --- | ||||
801 | |||||
802 | # Load xml from a file ( assume same contents as first example ) | ||||
803 | my $ob2 = new XML::Bare( file => 'test.xml' ); | ||||
804 | |||||
805 | my $root2 = $ob2->parse(); | ||||
806 | |||||
807 | $root2->{xml}->{name}->{value} = 'Tim'; | ||||
808 | |||||
809 | # Save the changes back to the file | ||||
810 | $ob2->save(); | ||||
811 | |||||
812 | --- | ||||
813 | |||||
814 | # Load xml and verify against XBS ( XML Bare Schema ) | ||||
815 | my $xml_text = '<xml><item name=bob/></xml>'' | ||||
816 | my $schema_text = '<xml><item* name=[a-z]+></item*></xml>' | ||||
817 | my $ob = new XML::Bare( text => $xml_text, schema => { text => $schema_text } ); | ||||
818 | $ob->parse(); # this will error out if schema is invalid | ||||
819 | |||||
820 | =head1 DESCRIPTION | ||||
821 | |||||
822 | This module is a 'Bare' XML parser. It is implemented in C. The parser | ||||
823 | itself is a simple state engine that is less than 500 lines of C. The | ||||
824 | parser builds a C struct tree from input text. That C struct tree is | ||||
825 | converted to a Perl hash by a Perl function that makes basic calls back | ||||
826 | to the C to go through the nodes sequentially. | ||||
827 | |||||
828 | The parser itself will only cease parsing if it encounters tags that | ||||
829 | are not closed properly. All other inputs will parse, even invalid | ||||
830 | inputs. To allowing checking for validity, a schema checker is included | ||||
831 | in the module as well. | ||||
832 | |||||
833 | The schema format is custom and is meant to be as simple as possible. | ||||
834 | It is based loosely around the way multiplicity is handled in Perl | ||||
835 | regular expressions. | ||||
836 | |||||
837 | =head2 Supported XML | ||||
838 | |||||
839 | To demonstrate what sort of XML is supported, consider the following | ||||
840 | examples. Each of the PERL statements evaluates to true. | ||||
841 | |||||
842 | =over 2 | ||||
843 | |||||
844 | =item * Node containing just text | ||||
845 | |||||
846 | XML: <xml>blah</xml> | ||||
847 | PERL: $root->{xml}->{value} eq "blah"; | ||||
848 | |||||
849 | =item * Subset nodes | ||||
850 | |||||
851 | XML: <xml><name>Bob</name></xml> | ||||
852 | PERL: $root->{xml}->{name}->{value} eq "Bob"; | ||||
853 | |||||
854 | =item * Attributes unquoted | ||||
855 | |||||
856 | XML: <xml><a href=index.htm>Link</a></xml> | ||||
857 | PERL: $root->{xml}->{a}->{href}->{value} eq "index.htm"; | ||||
858 | |||||
859 | =item * Attributes quoted | ||||
860 | |||||
861 | XML: <xml><a href="index.htm">Link</a></xml> | ||||
862 | PERL: $root->{xml}->{a}->{href}->{value} eq "index.htm"; | ||||
863 | |||||
864 | =item * CDATA nodes | ||||
865 | |||||
866 | XML: <xml><raw><![CDATA[some raw $~<!bad xml<>]]></raw></xml> | ||||
867 | PERL: $root->{xml}->{raw}->{value} eq "some raw \$~<!bad xml<>"; | ||||
868 | |||||
869 | =item * Multiple nodes; form array | ||||
870 | |||||
871 | XML: <xml><item>1</item><item>2</item></xml> | ||||
872 | PERL: $root->{xml}->{item}->[0]->{value} eq "1"; | ||||
873 | |||||
874 | =item * Forcing array creation | ||||
875 | |||||
876 | XML: <xml><multi_item/><item>1</item></xml> | ||||
877 | PERL: $root->{xml}->{item}->[0]->{value} eq "1"; | ||||
878 | |||||
879 | =item * One comment supported per node | ||||
880 | |||||
881 | XML: <xml><!--test--></xml> | ||||
882 | PERL: $root->{xml}->{comment} eq 'test'; | ||||
883 | |||||
884 | =back | ||||
885 | |||||
886 | =head2 Schema Checking | ||||
887 | |||||
888 | Schema checking is done by providing the module with an XBS (XML::Bare Schema) to check | ||||
889 | the XML against. If the XML checks as valid against the schema, parsing will continue as | ||||
890 | normal. If the XML is invalid, the parse function will die, providing information about | ||||
891 | the failure. | ||||
892 | |||||
893 | The following information is provided in the error message: | ||||
894 | |||||
895 | =over 2 | ||||
896 | |||||
897 | =item * The type of error | ||||
898 | |||||
899 | =item * Where the error occured ( line and char ) | ||||
900 | |||||
901 | =item * A short snippet of the XML at the point of failure | ||||
902 | |||||
903 | =back | ||||
904 | |||||
905 | =head2 XBS ( XML::Bare Schema ) Format | ||||
906 | |||||
907 | =over 2 | ||||
908 | |||||
909 | =item * Required nodes | ||||
910 | |||||
911 | XML: <xml></xml> | ||||
912 | XBS: <xml/> | ||||
913 | |||||
914 | =item * Optional nodes - allow one | ||||
915 | |||||
916 | XML: <xml></xml> | ||||
917 | XBS: <xml item?/> | ||||
918 | or XBS: <xml><item?/></xml> | ||||
919 | |||||
920 | =item * Optional nodes - allow 0 or more | ||||
921 | |||||
922 | XML: <xml><item/></xml> | ||||
923 | XBS: <xml item*/> | ||||
924 | |||||
925 | =item * Required nodes - allow 1 or more | ||||
926 | |||||
927 | XML: <xml><item/><item/></xml> | ||||
928 | XBS: <xml item+/> | ||||
929 | |||||
930 | =item * Nodes - specified minimum and maximum number | ||||
931 | |||||
932 | XML: <xml><item/><item/></xml> | ||||
933 | XBS: <xml item{1,2}/> | ||||
934 | or XBS: <xml><item{1,2}/></xml> | ||||
935 | or XBS: <xml><item{1,2}></item{1,2}></xml> | ||||
936 | |||||
937 | =item * Multiple acceptable node formats | ||||
938 | |||||
939 | XML: <xml><item type=box volume=20/><item type=line length=10/></xml> | ||||
940 | XBS: <xml><item type=box volume/><item type=line length/></xml> | ||||
941 | |||||
942 | =item * Regular expressions checking for values | ||||
943 | |||||
944 | XML: <xml name=Bob dir=up num=10/> | ||||
945 | XBS: <xml name=[A-Za-z]+ dir=up|down num=[0-9]+/> | ||||
946 | |||||
947 | =item * Require multi_ tags | ||||
948 | |||||
949 | XML: <xml><multi_item/></xml> | ||||
950 | XBS: <xml item@/> | ||||
951 | |||||
952 | =back | ||||
953 | |||||
954 | =head2 Parsed Hash Structure | ||||
955 | |||||
956 | The hash structure returned from XML parsing is created in a specific format. | ||||
957 | Besides as described above, the structure contains some additional nodes in | ||||
958 | order to preserve information that will allow that structure to be correctly | ||||
959 | converted back to XML. | ||||
960 | |||||
961 | Nodes may contain the following 3 additional subnodes: | ||||
962 | |||||
963 | =over 2 | ||||
964 | |||||
965 | =item * _i | ||||
966 | |||||
967 | The character offset within the original parsed XML of where the node | ||||
968 | begins. This is used to provide line information for errors when XML | ||||
969 | fails a schema check. | ||||
970 | |||||
971 | =item * _pos | ||||
972 | |||||
973 | This is a number indicating the ordering of nodes. It is used to allow | ||||
974 | items in a perl hash to be sorted when writing back to xml. Note that | ||||
975 | items are not sorted after parsing in order to save time if all you | ||||
976 | are doing is reading and you do not care about the order. | ||||
977 | |||||
978 | In future versions of this module an option will be added to allow | ||||
979 | you to sort your nodes so that you can read them in order. | ||||
980 | ( note that multiple nodes of the same name are stored in order ) | ||||
981 | |||||
982 | =item * _att | ||||
983 | |||||
984 | This is a boolean value that exists and is 1 iff the node is an | ||||
985 | attribute. | ||||
986 | |||||
987 | =back | ||||
988 | |||||
989 | =head2 Parsing Limitations / Features | ||||
990 | |||||
991 | =over 2 | ||||
992 | |||||
993 | =item * CDATA parsed correctly, but stripped if unneeded | ||||
994 | |||||
995 | Currently the contents of a node that are CDATA are read and | ||||
996 | put into the value hash, but the hash structure does not have | ||||
997 | a value indicating the node contains CDATA. | ||||
998 | |||||
999 | When converting back to XML, the contents of the value hash | ||||
1000 | are parsed to check for xml incompatible data using a regular | ||||
1001 | expression. If 'CDATA like' stuff is encountered, the node | ||||
1002 | is output as CDATA. | ||||
1003 | |||||
1004 | =item * Node position stored, but hash remains unsorted | ||||
1005 | |||||
1006 | The ordering of nodes is noted using the '_pos' value, but | ||||
1007 | the hash itself is not ordered after parsing. Currently | ||||
1008 | items will be out of order when looking at them in the | ||||
1009 | hash. | ||||
1010 | |||||
1011 | Note that when converted back to XML, the nodes are then | ||||
1012 | sorted and output in the correct order to XML. Note that | ||||
1013 | nodes of the same name with the same parent will be | ||||
1014 | grouped together; the position of the first item to | ||||
1015 | appear will determine the output position of the group. | ||||
1016 | |||||
1017 | =item * Comments are parsed but only one is stored per node. | ||||
1018 | |||||
1019 | For each node, there can be a comment within it, and that | ||||
1020 | comment will be saved and output back when dumping to XML. | ||||
1021 | |||||
1022 | =item * Comments override output of immediate value | ||||
1023 | |||||
1024 | If a node contains only a comment node and a text value, | ||||
1025 | only the comment node will be displayed. This is in line | ||||
1026 | with treating a comment node as a node and only displaying | ||||
1027 | immediate values when a node contains no subnodes. | ||||
1028 | |||||
1029 | =item * PI sections are parsed, but discarded | ||||
1030 | |||||
1031 | =item * Unknown C<< <! >> sections are parsed, but discarded | ||||
1032 | |||||
1033 | =item * Attributes may use no quotes, single quotes, quotes | ||||
1034 | |||||
1035 | =item * Quoted attributes cannot contain escaped quotes | ||||
1036 | |||||
1037 | No escape character is recognized within quotes. As a result, | ||||
1038 | regular quotes cannot be stored to XML, or the written XML | ||||
1039 | will not be correct, due to all attributes always being written | ||||
1040 | using quotes. | ||||
1041 | |||||
1042 | =item * Attributes are always written back to XML with quotes | ||||
1043 | |||||
1044 | =item * Nodes cannot contain subnodes as well as an immediate value | ||||
1045 | |||||
1046 | Actually nodes can in fact contain a value as well, but that | ||||
1047 | value will be discarded if you write back to XML. That value is | ||||
1048 | equal to the first continuous string of text besides a subnode. | ||||
1049 | |||||
1050 | <node>text<subnode/>text2</node> | ||||
1051 | ( the value of node is text ) | ||||
1052 | |||||
1053 | <node><subnode/>text</node> | ||||
1054 | ( the value of node is text ) | ||||
1055 | |||||
1056 | <node> | ||||
1057 | <subnode/>text | ||||
1058 | </node> | ||||
1059 | ( the value of node is "\n " ) | ||||
1060 | |||||
1061 | =back | ||||
1062 | |||||
1063 | =head2 Module Functions | ||||
1064 | |||||
1065 | =over 2 | ||||
1066 | |||||
1067 | =item * C<< $ob = new XML::Bare( text => "[some xml]" ) >> | ||||
1068 | |||||
1069 | Create a new XML object, with the given text as the xml source. | ||||
1070 | |||||
1071 | =item * C<< $object = new XML::Bare( file => "[filename]" ) >> | ||||
1072 | |||||
1073 | Create a new XML object, with the given filename/path as the xml source | ||||
1074 | |||||
1075 | =item * C<< $object = new XML::Bare( text => "[some xml]", file => "[filename]" ) >> | ||||
1076 | |||||
1077 | Create a new XML object, with the given text as the xml input, and the given | ||||
1078 | filename/path as the potential output ( used by save() ) | ||||
1079 | |||||
1080 | =item * C<< $object = new XML::Bare( file => "data.xml", scheme => { file => "scheme.xbs" } ) >> | ||||
1081 | |||||
1082 | Create a new XML object and check to ensure it is valid xml by way of the XBS scheme. | ||||
1083 | |||||
1084 | =item * C<< $tree = $object->parse() >> | ||||
1085 | |||||
1086 | Parse the xml of the object and return a tree reference | ||||
1087 | |||||
1088 | =item * C<< $tree = $object->simple() >> | ||||
1089 | |||||
1090 | Alternate to the parse function which generates a tree similar to that | ||||
1091 | generated by XML::Simple. Note that the sets of nodes are turned into | ||||
1092 | arrays always, regardless of whether they have a 'name' attribute, unlike | ||||
1093 | XML::Simple. | ||||
1094 | |||||
1095 | Note that currently the generated tree cannot be used with any of the | ||||
1096 | functions in this module that operate upon trees. The function is provided | ||||
1097 | purely as a quick and dirty way to read simple XML files. | ||||
1098 | |||||
1099 | =item * C<< $tree = xmlin( $xmlext, keeproot => 1 ) >> | ||||
1100 | |||||
1101 | The xmlin function is a shortcut to creating an XML::Bare object and | ||||
1102 | parsing it using the simple function. It behaves similarly to the | ||||
1103 | XML::Simple function by the same name. The keeproot option is optional | ||||
1104 | and if left out the root node will be discarded, same as the function | ||||
1105 | in XML::Simple. | ||||
1106 | |||||
1107 | =item * C<< $text = $object->xml( [root] ) >> | ||||
1108 | |||||
1109 | Take the hash tree in [root] and turn it into cleanly indented ( 2 spaces ) | ||||
1110 | XML text. | ||||
1111 | |||||
1112 | =item * C<< $text = $object->html( [root], [root node name] ) >> | ||||
1113 | |||||
1114 | Take the hash tree in [root] and turn it into nicely colorized and styled | ||||
1115 | html. [root node name] is optional. | ||||
1116 | |||||
1117 | =item * C<< $object->save() >> | ||||
1118 | |||||
1119 | The the current tree in the object, cleanly indent it, and save it | ||||
1120 | to the file paramter specified when creating the object. | ||||
1121 | |||||
1122 | =item * C<< $value = xval $node, $default >> | ||||
1123 | |||||
1124 | Returns the value of $node or $default if the node does not exist. | ||||
1125 | If default is not passed to the function, then '' is returned as | ||||
1126 | a default value when the node does not exist. | ||||
1127 | |||||
1128 | =item * C<< ( $name, $age ) = xget( $personnode, qw/name age/ ) >> | ||||
1129 | |||||
1130 | Shortcut function to grab a number of values from a node all at the | ||||
1131 | same time. Note that this function assumes that all of the subnodes | ||||
1132 | exist; it will fail if they do not. | ||||
1133 | |||||
1134 | =item * C<< $text = XML::Bare::clean( text => "[some xml]" ) >> | ||||
1135 | |||||
1136 | Shortcut to creating an xml object and immediately turning it into clean xml text. | ||||
1137 | |||||
1138 | =item * C<< $text = XML::Bare::clean( file => "[filename]" ) >> | ||||
1139 | |||||
1140 | Similar to previous. | ||||
1141 | |||||
1142 | =item * C<< XML::Bare::clean( file => "[filename]", save => 1 ) >> | ||||
1143 | |||||
1144 | Clean up the xml in the file, saving the results back to the file | ||||
1145 | |||||
1146 | =item * C<< XML::Bare::clean( text => "[some xml]", save => "[filename]" ) >> | ||||
1147 | |||||
1148 | Clean up the xml provided, and save it into the specified file. | ||||
1149 | |||||
1150 | =item * C<< XML::Bare::clean( file => "[filename1]", save => "[filename2]" ) >> | ||||
1151 | |||||
1152 | Clean up the xml in filename1 and save the results to filename2. | ||||
1153 | |||||
1154 | =item * C<< $html = XML::Bare::tohtml( text => "[some xml]", root => 'xml' ) >> | ||||
1155 | |||||
1156 | Shortcut to creating an xml object and immediately turning it into html. | ||||
1157 | Root is optional, and specifies the name of the root node for the xml | ||||
1158 | ( which defaults to 'xml' ) | ||||
1159 | |||||
1160 | =item * C<< $object->add_node( [node], [nodeset name], name => value, name2 => value2, ... ) >> | ||||
1161 | |||||
1162 | Example: | ||||
1163 | $object->add_node( $root->{xml}, 'item', name => 'Bob' ); | ||||
1164 | |||||
1165 | Result: | ||||
1166 | <xml> | ||||
1167 | <item> | ||||
1168 | <name>Bob</name> | ||||
1169 | </item> | ||||
1170 | </xml> | ||||
1171 | |||||
1172 | =item * C<< $object->add_node_after( [node], [subnode within node to add after], [nodeset name], ... ) >> | ||||
1173 | |||||
1174 | =item * C<< $object->del_node( [node], [nodeset name], name => value ) >> | ||||
1175 | |||||
1176 | Example: | ||||
1177 | Starting XML: | ||||
1178 | <xml> | ||||
1179 | <a> | ||||
1180 | <b>1</b> | ||||
1181 | </a> | ||||
1182 | <a> | ||||
1183 | <b>2</b> | ||||
1184 | </a> | ||||
1185 | </xml> | ||||
1186 | |||||
1187 | Code: | ||||
1188 | $xml->del_node( $root->{xml}, 'a', b=>'1' ); | ||||
1189 | |||||
1190 | Ending XML: | ||||
1191 | <xml> | ||||
1192 | <a> | ||||
1193 | <b>2</b> | ||||
1194 | </a> | ||||
1195 | </xml> | ||||
1196 | |||||
1197 | =item * C<< $object->find_node( [node], [nodeset name], name => value ) >> | ||||
1198 | |||||
1199 | Example: | ||||
1200 | Starting XML: | ||||
1201 | <xml> | ||||
1202 | <ob> | ||||
1203 | <key>1</key> | ||||
1204 | <val>a</val> | ||||
1205 | </ob> | ||||
1206 | <ob> | ||||
1207 | <key>2</key> | ||||
1208 | <val>b</val> | ||||
1209 | </ob> | ||||
1210 | </xml> | ||||
1211 | |||||
1212 | Code: | ||||
1213 | $object->find_node( $root->{xml}, 'ob', key => '1' )->{val}->{value} = 'test'; | ||||
1214 | |||||
1215 | Ending XML: | ||||
1216 | <xml> | ||||
1217 | <ob> | ||||
1218 | <key>1</key> | ||||
1219 | <val>test</val> | ||||
1220 | </ob> | ||||
1221 | <ob> | ||||
1222 | <key>2</key> | ||||
1223 | <val>b</val> | ||||
1224 | </ob> | ||||
1225 | </xml> | ||||
1226 | |||||
1227 | =item * C<< $object->find_by_perl( [nodeset], "[perl code]" ) >> | ||||
1228 | |||||
1229 | find_by_perl evaluates some perl code for each node in a set of nodes, and | ||||
1230 | returns the nodes where the perl code evaluates as true. In order to | ||||
1231 | easily reference node values, node values can be directly referred | ||||
1232 | to from within the perl code by the name of the node with a dash(-) in | ||||
1233 | front of the name. See the example below. | ||||
1234 | |||||
1235 | Note that this function returns an array reference as opposed to a single | ||||
1236 | node unlike the find_node function. | ||||
1237 | |||||
1238 | Example: | ||||
1239 | Starting XML: | ||||
1240 | <xml> | ||||
1241 | <ob> | ||||
1242 | <key>1</key> | ||||
1243 | <val>a</val> | ||||
1244 | </ob> | ||||
1245 | <ob> | ||||
1246 | <key>2</key> | ||||
1247 | <val>b</val> | ||||
1248 | </ob> | ||||
1249 | </xml> | ||||
1250 | |||||
1251 | Code: | ||||
1252 | $object->find_by_perl( $root->{xml}->{ob}, "-key eq '1'" )->[0]->{val}->{value} = 'test'; | ||||
1253 | |||||
1254 | Ending XML: | ||||
1255 | <xml> | ||||
1256 | <ob> | ||||
1257 | <key>1</key> | ||||
1258 | <val>test</val> | ||||
1259 | </ob> | ||||
1260 | <ob> | ||||
1261 | <key>2</key> | ||||
1262 | <val>b</val> | ||||
1263 | </ob> | ||||
1264 | </xml> | ||||
1265 | |||||
1266 | =item * C<< XML::Bare::merge( [nodeset1], [nodeset2], [id node name] ) >> | ||||
1267 | |||||
1268 | Merges the nodes from nodeset2 into nodeset1, matching the contents of | ||||
1269 | each node based up the content in the id node. | ||||
1270 | |||||
1271 | Example: | ||||
1272 | |||||
1273 | Code: | ||||
1274 | my $ob1 = new XML::Bare( text => " | ||||
1275 | <xml> | ||||
1276 | <multi_a/> | ||||
1277 | <a>bob</a> | ||||
1278 | <a> | ||||
1279 | <id>1</id> | ||||
1280 | <color>blue</color> | ||||
1281 | </a> | ||||
1282 | </xml>" ); | ||||
1283 | my $ob2 = new XML::Bare( text => " | ||||
1284 | <xml> | ||||
1285 | <multi_a/> | ||||
1286 | <a>john</a> | ||||
1287 | <a> | ||||
1288 | <id>1</id> | ||||
1289 | <name>bob</name> | ||||
1290 | <bob>1</bob> | ||||
1291 | </a> | ||||
1292 | </xml>" ); | ||||
1293 | my $root1 = $ob1->parse(); | ||||
1294 | my $root2 = $ob2->parse(); | ||||
1295 | merge( $root1->{'xml'}->{'a'}, $root2->{'xml'}->{'a'}, 'id' ); | ||||
1296 | print $ob1->xml( $root1 ); | ||||
1297 | |||||
1298 | Output: | ||||
1299 | <xml> | ||||
1300 | <multi_a></multi_a> | ||||
1301 | <a>bob</a> | ||||
1302 | <a> | ||||
1303 | <id>1</id> | ||||
1304 | <color>blue</color> | ||||
1305 | <name>bob</name> | ||||
1306 | <bob>1</bob> | ||||
1307 | </a> | ||||
1308 | </xml> | ||||
1309 | |||||
1310 | =item * C<< XML::Bare::del_by_perl( ... ) >> | ||||
1311 | |||||
1312 | Works exactly like find_by_perl, but deletes whatever matches. | ||||
1313 | |||||
1314 | =item * C<< XML::Bare::forcearray( [noderef] ) >> | ||||
1315 | |||||
1316 | Turns the node reference into an array reference, whether that | ||||
1317 | node is just a single node, or is already an array reference. | ||||
1318 | |||||
1319 | =item * C<< XML::Bare::new_node( ... ) >> | ||||
1320 | |||||
1321 | Creates a new node... | ||||
1322 | |||||
1323 | =item * C<< XML::Bare::newhash( ... ) >> | ||||
1324 | |||||
1325 | Creates a new hash with the specified value. | ||||
1326 | |||||
1327 | =item * C<< XML::Bare::simplify( [noderef] ) >> | ||||
1328 | |||||
1329 | Take a node with children that have immediate values and | ||||
1330 | creates a hashref to reference those values by the name of | ||||
1331 | each child. | ||||
1332 | |||||
1333 | =back | ||||
1334 | |||||
1335 | =head2 Functions Used Internally | ||||
1336 | |||||
1337 | =over 2 | ||||
1338 | |||||
1339 | =item * C<< check() checkone() readxbs() free_tree_c() >> | ||||
1340 | |||||
1341 | =item * C<< lineinfo() c_parse() c_parsefile() free_tree() xml2obj() >> | ||||
1342 | |||||
1343 | =item * C<< obj2xml() get_root() obj2html() xml2obj_simple() >> | ||||
1344 | |||||
1345 | =back | ||||
1346 | |||||
1347 | =head2 Performance | ||||
1348 | |||||
1349 | In comparison to other available perl xml parsers that create trees, XML::Bare | ||||
1350 | is extremely fast. In order to measure the performance of loading and parsing | ||||
1351 | compared to the alternatives, a templated speed comparison mechanism has been | ||||
1352 | created and included with XML::Bare. | ||||
1353 | |||||
1354 | The include makebench.pl file runs when you make the module and creates perl | ||||
1355 | files within the bench directory corresponding to the .tmpl contained there. | ||||
1356 | |||||
1357 | Currently there are three types of modules that can be tested against, | ||||
1358 | executable parsers ( exe.tmpl ), tree parsers ( tree.tmpl ), and parsers | ||||
1359 | that do not generated trees ( notree.tmpl ). | ||||
1360 | |||||
1361 | A full list of modules currently tested against is as follows: | ||||
1362 | |||||
1363 | Tiny XML (exe) | ||||
1364 | EzXML (exe) | ||||
1365 | XMLIO (exe) | ||||
1366 | XML::LibXML (notree) | ||||
1367 | XML::Parser (notree) | ||||
1368 | XML::Parser::Expat (notree) | ||||
1369 | XML::Descent (notree) | ||||
1370 | XML::Parser::EasyTree | ||||
1371 | XML::Handler::Trees | ||||
1372 | XML::Twig | ||||
1373 | XML::Smart | ||||
1374 | XML::Simple using XML::Parser | ||||
1375 | XML::Simple using XML::SAX::PurePerl | ||||
1376 | XML::Simple using XML::LibXML::SAX::Parser | ||||
1377 | XML::Simple using XML::Bare::SAX::Parser | ||||
1378 | XML::TreePP | ||||
1379 | XML::Trivial | ||||
1380 | XML::SAX::Simple | ||||
1381 | XML::Grove::Builder | ||||
1382 | XML::XPath::XMLParser | ||||
1383 | XML::DOM | ||||
1384 | |||||
1385 | To run the comparisons, run the appropriate perl file within the | ||||
1386 | bench directory. ( exe.pl, tree.pl, or notree.pl ) | ||||
1387 | |||||
1388 | The script measures the milliseconds of loading and parsing, and | ||||
1389 | compares the time against the time of XML::Bare. So a 7 means | ||||
1390 | it takes 7 times as long as XML::Bare. | ||||
1391 | |||||
1392 | Here is a combined table of the script run against each alternative | ||||
1393 | using the included test.xml: | ||||
1394 | |||||
1395 | -Module- load parse total | ||||
1396 | XML::Bare 1 1 1 | ||||
1397 | XML::TreePP 2.3063 33.1776 6.1598 | ||||
1398 | XML::Parser::EasyTree 4.9405 25.7278 7.4571 | ||||
1399 | XML::Handler::Trees 7.2303 26.5688 9.6447 | ||||
1400 | XML::Trivial 5.0636 12.4715 7.3046 | ||||
1401 | XML::Smart 6.8138 78.7939 15.8296 | ||||
1402 | XML::Simple (XML::Parser) 2.3346 50.4772 10.7455 | ||||
1403 | XML::Simple (PurePerl) 2.361 261.4571 33.6524 | ||||
1404 | XML::Simple (LibXML) 2.3187 163.7501 23.1816 | ||||
1405 | XML::Simple (XML::Bare) 2.3252 59.1254 10.9163 | ||||
1406 | XML::SAX::Simple 8.7792 170.7313 28.3634 | ||||
1407 | XML::Twig 27.8266 56.4476 31.3594 | ||||
1408 | XML::Grove::Builder 7.1267 26.1672 9.4064 | ||||
1409 | XML::XPath::XMLParser 9.7783 35.5486 13.0002 | ||||
1410 | XML::LibXML (notree) 11.0038 4.5758 10.6881 | ||||
1411 | XML::Parser (notree) 4.4698 17.6448 5.8609 | ||||
1412 | XML::Parser::Expat(notree) 3.7681 50.0382 6.0069 | ||||
1413 | XML::Descent (notree) 6.0525 37.0265 11.0322 | ||||
1414 | Tiny XML (exe) 1.0095 | ||||
1415 | EzXML (exe) 1.1284 | ||||
1416 | XMLIO (exe) 1.0165 | ||||
1417 | |||||
1418 | Here is a combined table of the script run against each alternative | ||||
1419 | using the included feed2.xml: | ||||
1420 | |||||
1421 | -Module- load parse total | ||||
1422 | XML::Bare 1 1 1 | ||||
1423 | XML::TreePP 2.3068 23.7554 7.6921 | ||||
1424 | XML::Parser::EasyTree 4.8799 25.3691 9.6257 | ||||
1425 | XML::Handler::Trees 6.8545 33.1007 13.0575 | ||||
1426 | XML::Trivial 5.0105 32.0043 11.4113 | ||||
1427 | XML::Simple (XML::Parser) 2.3498 41.9007 12.3062 | ||||
1428 | XML::Simple (PurePerl) 2.3551 224.3027 51.7832 | ||||
1429 | XML::Simple (LibXML) 2.3617 88.8741 23.215 | ||||
1430 | XML::Simple (XML::Bare) 2.4319 37.7355 10.2343 | ||||
1431 | XML::Simple 2.7168 90.7203 26.7525 | ||||
1432 | XML::SAX::Simple 8.7386 94.8276 29.2166 | ||||
1433 | XML::Twig 28.3206 48.1014 33.1222 | ||||
1434 | XML::Grove::Builder 7.2021 30.7926 12.9334 | ||||
1435 | XML::XPath::XMLParser 9.6869 43.5032 17.4941 | ||||
1436 | XML::LibXML (notree) 11.0023 5.022 10.5214 | ||||
1437 | XML::Parser (notree) 4.3748 25.0213 5.9803 | ||||
1438 | XML::Parser::Expat(notree) 3.6555 51.6426 7.4316 | ||||
1439 | XML::Descent (notree) 5.9206 155.0289 18.7767 | ||||
1440 | Tiny XML (exe) 1.2212 | ||||
1441 | EzXML (exe) 1.3618 | ||||
1442 | XMLIO (exe) 1.0145 | ||||
1443 | |||||
1444 | These results show that XML::Bare is, at least on the | ||||
1445 | test machine, running all tests within cygwin, faster | ||||
1446 | at loading and parsing than everything being tested | ||||
1447 | against. | ||||
1448 | |||||
1449 | The following things are shown as well: | ||||
1450 | - XML::Bare can parse XML and create a hash tree | ||||
1451 | in less time than it takes LibXML just to parse. | ||||
1452 | - XML::Bare can parse XML and create a tree | ||||
1453 | in less time than all three binary parsers take | ||||
1454 | just to parse. | ||||
1455 | |||||
1456 | Note that the executable parsers are not perl modules | ||||
1457 | and are timed using dummy programs that just uses the | ||||
1458 | library to load and parse the example files. The | ||||
1459 | executables are not included with this program. Any | ||||
1460 | source modifications used to generate the shown test | ||||
1461 | results can be found in the bench/src directory of | ||||
1462 | the distribution | ||||
1463 | |||||
1464 | =head1 LICENSE | ||||
1465 | |||||
1466 | Copyright (C) 2008 David Helkowski | ||||
1467 | |||||
1468 | This program is free software; you can redistribute it and/or | ||||
1469 | modify it under the terms of the GNU General Public License as | ||||
1470 | published by the Free Software Foundation; either version 2 of the | ||||
1471 | License, or (at your option) any later version. You may also can | ||||
1472 | redistribute it and/or modify it under the terms of the Perl | ||||
1473 | Artistic License. | ||||
1474 | |||||
1475 | This program is distributed in the hope that it will be useful, | ||||
1476 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
1477 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||
1478 | GNU General Public License for more details. | ||||
1479 | |||||
1480 | =cut | ||||
# spent 557µs within XML::Bare::bootstrap which was called
# once (557µs+0s) by DynaLoader::bootstrap at line 227 of DynaLoader.pm | |||||
# spent 53µs within XML::Bare::c_parse which was called 3 times, avg 18µs/call:
# 3 times (53µs+0s) by XML::Bare::new at line 39 of XML/Bare.pm, avg 18µs/call | |||||
# spent 14µs within XML::Bare::free_tree_c which was called 3 times, avg 5µs/call:
# 3 times (14µs+0s) by XML::Bare::free_tree at line 782 of XML/Bare.pm, avg 5µs/call | |||||
# spent 7µs within XML::Bare::get_root which was called 3 times, avg 2µs/call:
# 3 times (7µs+0s) by XML::Bare::simple at line 361 of XML/Bare.pm, avg 2µs/call | |||||
# spent 66µs within XML::Bare::xml2obj_simple which was called 3 times, avg 22µs/call:
# 3 times (66µs+0s) by XML::Bare::simple at line 360 of XML/Bare.pm, avg 22µs/call |