# Before `make install' is performed this script should be runnable # with `make test'. After `make install' it should work as `perl # AttributeList.t' ######################### We start with some black magic to print on failure. END {ok(0) unless $loaded;} use Carp; use blib; use XML::Xerces; use Test::More tests => 11; use Config; use lib 't'; use TestUtils qw($PERSONAL_FILE_NAME); use vars qw($loaded); use strict; $loaded = 1; ok($loaded, "module loaded"); ######################### End of black magic. # NOTICE: We must now explicitly call XMLPlatformUtils::Initialize() # when the module is loaded. Xerces.pm no longer does this. # # XML::Xerces::XMLPlatformUtils::Initialize(); package MyDocumentHandler; use strict; use vars qw(@ISA); @ISA = qw(XML::Xerces::PerlDocumentHandler); sub start_element { my ($self,$name,$attrs) = @_; if ($name 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 $SAX = XML::Xerces::SAXParser->new(); my $DOCUMENT_HANDLER = MyDocumentHandler->new(); my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new(); $SAX->setDocumentHandler($DOCUMENT_HANDLER); $SAX->setErrorHandler($ERROR_HANDLER); # test getLength my $is = XML::Xerces::MemBufInputSource->new($document); $DOCUMENT_HANDLER->{test} = ''; eval {$SAX->parse($is)}; XML::Xerces::error($@) if $@; ok($DOCUMENT_HANDLER->{test} == 3, "getLength"); $DOCUMENT_HANDLER->{test} = ''; # we want to avoid a bunch of warnings about redefining # the start_element method, so we turn off warnings $^W = 0; # test getName *MyDocumentHandler::start_element = sub { my ($self,$name,$attrs) = @_; if ($name eq 'foo') { $self->{test} = $attrs->getName(2); } }; $DOCUMENT_HANDLER->{test} = ''; $SAX->parse($is); ok($DOCUMENT_HANDLER->{test} eq "$ns:$local", "getName"); # test getValue *MyDocumentHandler::start_element = sub { my ($self,$name,$attrs) = @_; if ($name eq 'foo') { $self->{test} = $attrs->getValue("$ns:$local"); } }; $DOCUMENT_HANDLER->{test} = ''; $SAX->parse($is); ok($DOCUMENT_HANDLER->{test} eq $value, "getValue - string"); # test overloaded getValue *MyDocumentHandler::start_element = sub { my ($self,$name,$attrs) = @_; if ($name eq 'foo') { $self->{test} = $attrs->getValue(2); } }; $DOCUMENT_HANDLER->{test} = ''; $SAX->parse($is); # print STDERR "<$DOCUMENT_HANDLER->{test}>" , "\n"; # print STDERR "<$value>" , "\n"; ok($DOCUMENT_HANDLER->{test} eq $value, "getValue - int"); # test to_hash() *MyDocumentHandler::start_element = sub { my ($self,$name,$attrs) = @_; if ($name eq 'foo') { $self->{test} = {$attrs->to_hash()}; } }; $DOCUMENT_HANDLER->{test} = ''; $SAX->parse($is); my $hash_ref = $DOCUMENT_HANDLER->{test}; isa_ok($hash_ref, 'HASH', "to_hash()"); is(keys %{$hash_ref}, 3, "to_hash()"); is($hash_ref->{"$ns:$local"}, $value, "to_hash()"); my $document2 = 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) = @_; return XML::Xerces::MemBufInputSource->new(''); } package main; my $is2 = eval{XML::Xerces::MemBufInputSource->new($document2)}; XML::Xerces::error($@) if $@; $SAX->setEntityResolver(MyEntityResolver->new()); # test overloaded getType *MyDocumentHandler::start_element = sub { my ($self,$name,$attrs) = @_; if ($name eq 'foo') { $self->{test} = $attrs->getType(0); } }; $DOCUMENT_HANDLER->{test} = ''; $SAX->parse($is2); is($DOCUMENT_HANDLER->{test}, 'ID', "getType - int"); # test getType *MyDocumentHandler::start_element = sub { my ($self,$name,$attrs) = @_; if ($name eq 'foo') { $self->{test} = $attrs->getType('id'); } }; $DOCUMENT_HANDLER->{test} = ''; $SAX->parse($is2); is($DOCUMENT_HANDLER->{test}, 'ID', "getType"); my $document3 = qq[ ]> ]; $is2 = eval{XML::Xerces::MemBufInputSource->new($document3)}; TODO : { todo_skip "blank documents segfault the entity resolver", 1; $SAX->parse($is2); pass("blank document does not segfault the entity resolver"); } END { # NOTICE: We must now explicitly call XMLPlatformUtils::Terminate() # when the module is unloaded. Xerces.pm no longer does this for us # # XML::Xerces::XMLPlatformUtils::Terminate(); }