# Before `make install' is performed this script should be runnable # with `make test'. After `make install' it should work as `perl # Attributes.t' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) END {ok(0) unless $loaded;} use Carp; use blib; use XML::Xerces; use Test::More tests => 19; use Config; use lib 't'; use TestUtils qw($PERSONAL_FILE_NAME); use vars qw($i $loaded); use strict; $loaded = 1; $i = 1; ok($loaded, "module loaded"); ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): package MyContentHandler; use strict; use vars qw(@ISA); @ISA = qw(XML::Xerces::PerlContentHandler); sub start_element { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getLength(); } } sub end_element { } sub characters { } sub ignorable_whitespace { } package main; my $url = 'http://www.boyscouts.org/'; my $local = 'Rank'; my $ns = 'Scout'; my $value = 'eagle scout'; my $document = qq[ ]; my $SAX2 = XML::Xerces::XMLReaderFactory::createXMLReader(); my $CONTENT_HANDLER = MyContentHandler->new(); my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new(); $SAX2->setContentHandler($CONTENT_HANDLER); $SAX2->setErrorHandler($ERROR_HANDLER); # test getLength my $is = XML::Xerces::MemBufInputSource->new($document); $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is); is($CONTENT_HANDLER->{test}, 2, "getLength"); $CONTENT_HANDLER->{test} = ''; # we want to avoid a bunch of warnings about redefining # the start_element method, so we turn off warnings $^W = 0; # test getURI *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getURI(1); } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is); is($CONTENT_HANDLER->{test}, $url, "getURI"); # test getLocalName *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getLocalName(1); } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is); is($CONTENT_HANDLER->{test}, $local, "getLocalName"); # test getQName *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getQName(1); } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is); is($CONTENT_HANDLER->{test}, "$ns:$local", "getQName"); # test getIndex *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getIndex("$ns:$local"); } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is); is($CONTENT_HANDLER->{test}, 1, "getIndex"); # test getValue *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getValue($url,$local); } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is); is($CONTENT_HANDLER->{test}, $value, "getValue(url,localname)"); # test overloaded getValue *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getValue(1); } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is); is($CONTENT_HANDLER->{test}, $value, "getValue(int)"); # test overloaded getValue *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getValue($url, $local); } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is); is($CONTENT_HANDLER->{test}, $value, "getValue"); # test to_hash() *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = {$attrs->to_hash()}; } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is); my $hash_ref = $CONTENT_HANDLER->{test}; isa_ok($hash_ref, 'HASH'); is(keys %{$hash_ref}, 2, "found all attrs"); is($hash_ref->{"$ns:$local"}{value}, $value, "found attr value"); is($hash_ref->{"$ns:$local"}{URI}, $url, "found attr url"); $document = qq[ ]> ]; package MyEntityResolver; use strict; use vars qw(@ISA); @ISA = qw(XML::Xerces::PerlEntityResolver); sub new { return bless {}, shift; } sub resolve_entity { my ($self,$pub,$sys) = @_; print STDERR "resolving entity, pub: $pub, sys: $sys\n"; return XML::Xerces::MemBufInputSource->new(''); } package main; my $is2 = XML::Xerces::MemBufInputSource->new($document); $SAX2->setEntityResolver(MyEntityResolver->new()); # test overloaded getType *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getType(0); } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is2); is($CONTENT_HANDLER->{test}, 'ID', "getType(int)"); # test overloaded getType *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getType('', 'id'); } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is2); is($CONTENT_HANDLER->{test}, 'ID', "getType(uri,local)"); # test getType *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = $attrs->getType('','id'); } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is2); is($CONTENT_HANDLER->{test}, 'ID', "getType"); # test type field of to_hash() *MyContentHandler::start_element = sub { my ($self,$uri,$localname,$qname,$attrs) = @_; if ($localname eq 'foo') { $self->{test} = {$attrs->to_hash()}; } }; $CONTENT_HANDLER->{test} = ''; $SAX2->parse($is2); $hash_ref = $CONTENT_HANDLER->{test}; isa_ok($hash_ref, 'HASH'); is(keys %{$hash_ref}, 2, "to_hash() found all attrs"); is($hash_ref->{id}{type}, 'ID', "to_hash() found correct type");