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