1use Test;
2BEGIN { plan tests => 31 }
3use XML::SAX::PurePerl;
4use XML::SAX::PurePerl::DebugHandler;
5
6my $handler = TestElementHandler->new();
7ok($handler);
8
9my $parser = XML::SAX::PurePerl->new(Handler => $handler);
10ok($parser);
11
12$handler->{test_el}{Name} = "foo";
13$handler->{test_el}{LocalName} = "foo";
14$handler->{test_el}{Prefix} = "";
15$handler->{test_el}{NamespaceURI} = "";
16$parser->parse_uri("testfiles/06a.xml");
17
18$handler->reset;
19
20$handler->{attr_name} = "{}a";
21$handler->{test_attr}{Name} = "a";
22$handler->{test_attr}{Value} = "1";
23$handler->{test_attr}{Prefix} = "";
24$handler->{test_attr}{LocalName} = "a";
25$handler->{test_attr}{NamespaceURI} = "";
26$parser->parse_uri("testfiles/06b.xml");
27
28$handler->reset;
29
30$handler->{test_el}{Name} = "foo";
31$handler->{test_el}{LocalName} = "foo";
32$handler->{test_el}{Prefix} = "";
33$handler->{test_el}{NamespaceURI} = "http://foo.com";
34$parser->parse_uri("testfiles/06c.xml");
35
36$handler->reset;
37$handler->{test_el}{Name} = "x:foo";
38$handler->{test_el}{LocalName} = "foo";
39$handler->{test_el}{Prefix} = "x";
40$handler->{test_el}{NamespaceURI} = "http://foo.com";
41$handler->{attr_name} = "{http://foo.com}a";
42$handler->{test_attr}{Name} = "x:a";
43$handler->{test_attr}{Value} = "2";
44$handler->{test_attr}{Prefix} = "x";
45$handler->{test_attr}{LocalName} = "a";
46$handler->{test_attr}{NamespaceURI} = "http://foo.com";
47$parser->parse_uri("testfiles/06d.xml");
48
49$handler->reset;
50$handler->{test_el}{Name} = "foo";
51$handler->{test_el}{LocalName} = "foo";
52$handler->{test_el}{Prefix} = "";
53$handler->{test_el}{NamespaceURI} = "http://foo.com";
54$handler->{attr_name} = "{}a";
55$handler->{test_attr}{Name} = "a";
56$handler->{test_attr}{NamespaceURI} = "";
57$parser->parse_uri("testfiles/06e.xml");
58
59$handler->reset;
60# prefix with no ns binding. Error.
61eval {
62$parser->parse_uri("testfiles/06f.xml");
63};
64ok($@);
65
66## HELPER PACKAGE ##
67
68package TestElementHandler;
69
70use Test;
71
72sub new {
73    my $class = shift;
74    my %opts = @_;
75    bless \%opts, $class;
76}
77
78sub reset {
79    my $self = shift;
80    %$self = ();
81}
82
83sub start_element {
84    my ($self, $el) = @_;
85    if ($self->{test_el}) {
86        foreach my $key (keys %{ $self->{test_el} }) {
87            #warn $key, "\n";
88            ok("$key: $el->{$key}", "$key: $self->{test_el}{$key}");
89        }
90    }
91    if ($self->{test_attr}) {
92        foreach my $key (keys %{ $self->{test_attr} }) {
93            #warn $key, "\n";
94            ok("$key: $el->{Attributes}{ $self->{attr_name} }{$key}", "$key: $self->{test_attr}{$key}");
95        }
96    }
97}
98
99