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