1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
#!/bin/env perl
use strict;
use diagnostics;
use Test;
BEGIN {
unless(grep /blib/, @INC) {
chdir 't' if -d 't';
unshift @INC, '../lib' if -d '../lib';
}
}
unless (eval { require XML::Parser::Lite }) {
print "1..0 # Skip: ", $@, "\n";
exit;
}
plan tests => 17;
my($s, $c, $e, $a);
($s, $c, $e) = (0) x 3;
my $p1 = XML::Parser::Lite->new();
ok(1 => 1);
$p1->setHandlers(
Start => sub { shift; $s++; print "start: @_\n" },
Char => sub { shift; $c++; print "char: @_\n" },
End => sub { shift; $e++; print "end: @_\n" },
);
$p1->parse('<foo>Hello World!</foo>');
ok($s == 1);
ok($c == 1);
ok($e == 1);
($s, $c, $e) = (0) x 3;
my %foo;
my $p2 = new XML::Parser::Lite
Handlers => {
Start => sub { shift; $s++; %foo = @_[1..$#_] if $_[0] eq 'foo'; print "start: @_\n" },
Char => sub { shift; $c++; print "char: @_\n" },
End => sub { shift; $e++; print "end: @_\n" },
}
;
$p2->parse('<foo id="me" root="0" empty="">Hello <bar>cruel</bar> <foobar/> World!</foo>');
ok(1 => 1);
ok($s == 3);
ok($c == 4);
ok($e == 3);
ok($foo{id} eq 'me');
ok(defined $foo{root} && $foo{root} eq '0');
ok(defined $foo{empty} && $foo{empty} eq '');
$p2->setHandlers;
# check for junk before
eval { $p2->parse('foo<foo id="me">Hello World!</foo>') };
ok($@ =~ /^junk .+ before/);
# check for junk after
eval { $p2->parse('<foo id="me">Hello World!</foo>bar') };
ok($@ =~ /^junk .+ after/);
# check for non-closed tag
eval { $p2->parse('<foo id="me">Hello World!') };
ok($@ =~ /^not properly closed tag 'foo'/);
# check for non properly closed tag
eval { $p2->parse('<foo id="me">Hello World!<bar></foo></bar>') };
ok($@ =~ /^mismatched tag 'foo'/);
# check for unwanted tag
eval { $p2->parse('<foo id="me">Hello World!</foo><bar></bar>') };
ok($@ =~ /^multiple roots, wrong element 'bar'/);
# check for string without elements
eval { $p2->parse(' ') };
ok($@ =~ /^no element found/);
|
