openkylin
/
libxml-libxml-perl
mirror of https://gitee.com/openkylin/libxml-libxml-perl.git
9
0
Fork 0
Code Issues Projects Releases Wiki Activity
libxml-libxml-perl/t/14sax.t

540 lines
11 KiB
Perl
Raw Permalink Blame History

use strict;
use warnings;
use lib './t/lib';
use Counter;
use Stacker;
# should be 33.
use Test::More tests => 33;
# BEGIN { plan tests => 55 }
use XML::LibXML;
use XML::LibXML::SAX;
use XML::LibXML::SAX::Parser;
use XML::LibXML::SAX::Builder;
use XML::SAX;
use IO::File;
# TEST
ok(1, 'Loaded');
sub _create_simple_counter {
return Counter->new(
{
gen_cb => sub {
my $inc_cb = shift;
sub {
$inc_cb->();
return;
}
}
}
);
}
my $SAXTester_start_document_counter = _create_simple_counter();
my $SAXTester_end_document_counter = _create_simple_counter();
my $SAXTester_start_element_stacker = Stacker->new(
{
gen_cb => sub {
my $push_cb = shift;
return sub {
my $el = shift;
$push_cb->(
($el->{LocalName} =~ m{\A(?:dromedaries|species|humps|disposition|legs)\z})
? 'true'
: 'false'
);
return;
};
},
}
);
my $SAXNSTester_start_element_stacker = Stacker->new(
{
gen_cb => sub {
my $push_cb = shift;
return sub {
my $node = shift;
$push_cb->(
scalar($node->{NamespaceURI} =~ /^urn:/)
? 'true'
: 'false'
);
return;
};
},
}
);
my $SAXNS2Tester_start_element_stacker = Stacker->new(
{
gen_cb => sub {
my $push_cb = shift;
return sub {
my $elt = shift;
if ($elt->{Name} eq "b")
{
$push_cb->(
($elt->{NamespaceURI} eq "xml://A") ? 'true' : 'false'
);
}
return;
};
},
}
);
sub _create_urn_stacker
{
return
Stacker->new(
{
gen_cb => sub {
my $push_cb = shift;
return sub {
my $node = shift;
$push_cb->(
($node->{NamespaceURI} =~ /\A(?:urn:camels|urn:mammals|urn:a)\z/)
? 'true'
: 'false'
);
return;
};
},
}
);
}
my $SAXNSTester_start_prefix_mapping_stacker = _create_urn_stacker();
my $SAXNSTester_end_prefix_mapping_stacker = _create_urn_stacker();
# TEST
ok(XML::SAX->add_parser(q(XML::LibXML::SAX::Parser)), 'add_parser is successful.');
local $XML::SAX::ParserPackage = 'XML::LibXML::SAX::Parser';
my $parser;
{
my $sax = SAXTester->new;
# TEST
ok($sax, ' TODO : Add test name');
my $str = join('', IO::File->new("example/dromeds.xml")->getlines);
my $doc = XML::LibXML->new->parse_string($str);
# TEST
ok($doc, ' TODO : Add test name');
my $generator = XML::LibXML::SAX::Parser->new(Handler => $sax);
# TEST
ok($generator, ' TODO : Add test name');
$generator->generate($doc); # start_element*10
# TEST
$SAXTester_start_element_stacker->test(
[(qw(true)) x 10],
'start_element was successful 10 times.',
);
# TEST
$SAXTester_start_document_counter->test(1, 'start_document called once.');
# TEST
$SAXTester_end_document_counter->test(1, 'end_document called once.');
my $builder = XML::LibXML::SAX::Builder->new();
# TEST
ok($builder, ' TODO : Add test name');
my $gen2 = XML::LibXML::SAX::Parser->new(Handler => $builder);
my $dom2 = $gen2->generate($doc);
# TEST
ok($dom2, ' TODO : Add test name');
# TEST
is($dom2->toString, $str, ' TODO : Add test name');
# warn($dom2->toString);
########### XML::SAX Tests ###########
$parser = XML::SAX::ParserFactory->parser(Handler => $sax);
# TEST
ok($parser, ' TODO : Add test name');
$parser->parse_uri("example/dromeds.xml"); # start_element*10
# TEST
$SAXTester_start_element_stacker->test(
[(qw(true)) x 10],
'parse_uri(): start_element was successful 10 times.',
);
# TEST
$SAXTester_start_document_counter->test(1, 'start_document called once.');
# TEST
$SAXTester_end_document_counter->test(1, 'end_document called once.');
$parser->parse_string(<<EOT); # start_element*1
<?xml version='1.0' encoding="US-ASCII"?>
<dromedaries one="1" />
EOT
# TEST
$SAXTester_start_element_stacker->test(
[qw(true)],
'parse_string() : start_element was successful 1 times.',
);
# TEST
$SAXTester_start_document_counter->test(1, 'start_document called once.');
# TEST
$SAXTester_end_document_counter->test(1, 'end_document called once.');
}
{
my $sax = SAXNSTester->new;
# TEST
ok($sax, ' TODO : Add test name');
$parser->set_handler($sax);
$parser->parse_uri("example/ns.xml");
# TEST
$SAXNSTester_start_element_stacker->test(
[
qw(true true true)
],
'Three successful SAXNSTester elements.',
);
# TEST
$SAXNSTester_start_prefix_mapping_stacker->test(
[
qw(true true true)
],
'Three successful SAXNSTester start_prefix_mapping.',
);
# TEST
$SAXNSTester_end_prefix_mapping_stacker->test(
[
qw(true true true)
],
'Three successful SAXNSTester end_prefix_mapping.',
);
}
{
local $XML::SAX::ParserPackage = 'XML::LibXML::SAX';
my @stack;
my $sax = SAXLocatorTester->new( sub {
my ($self, $method, @args) = @_;
push( @stack, $method => [
$self->{locator}->{LineNumber},
$self->{locator}->{ColumnNumber}
] );
} );
# TEST
ok($sax, 'Created SAX handler with document locator');
my $parser = XML::SAX::ParserFactory->parser(Handler => $sax);
$parser->parse_string(<<EOT);
<?xml version="1.0" encoding="UTF-8"?>
<root>
1
<!-- comment -->
<![CDATA[ a < b ]]>
</root>
EOT
my $expecting = [
start_document => [ 2, 1 ],
start_element => [ 2, 6 ],
characters => [ 4, 1 ],
comment => [ 4, 17 ],
characters => [ 5, 1 ],
start_cdata => [ 5, 20 ],
characters => [ 5, 20 ],
end_cdata => [ 5, 20 ],
characters => [ 6, 1 ],
end_element => [ 6, 8 ],
end_document => [ 6, 8 ],
];
# TEST
is_deeply( \@stack, $expecting, "Check locator positions" );
}
########### Namespace test ( empty namespaces ) ########
{
my $h = "SAXNS2Tester";
my $xml = "<a xmlns='xml://A'><b/></a>";
my @tests = (
sub {
XML::LibXML::SAX ->new( Handler => $h )->parse_string( $xml );
# TEST
$SAXNS2Tester_start_element_stacker->test([qw(true)], 'XML::LibXML::SAX');
},
sub {
XML::LibXML::SAX::Parser->new( Handler => $h )->parse_string( $xml );
# TEST
$SAXNS2Tester_start_element_stacker->test([qw(true)], 'XML::LibXML::SAX::Parser');
},
);
$_->() for @tests;
}
########### Error Handling ###########
{
my $xml = '<foo><bar/><a>Text</b></foo>';
my $handler = SAXErrorTester->new;
foreach my $pkg (qw(XML::LibXML::SAX::Parser XML::LibXML::SAX)) {
undef $@;
eval {
$pkg->new(Handler => $handler)->parse_string($xml);
};
# TEST*2
ok($@, ' TODO : Add test name'); # We got an error
}
$handler = SAXErrorCallbackTester->new;
eval { XML::LibXML::SAX->new(Handler => $handler )->parse_string($xml) };
# TEST
ok($@, ' TODO : Add test name'); # We got an error
# TEST
ok( $handler->{fatal_called}, ' TODO : Add test name' );
}
########### XML::LibXML::SAX::parse_chunk test ###########
{
my $chunk = '<app>LOGOUT</app><bar/>';
my $builder = XML::LibXML::SAX::Builder->new( Encoding => 'UTF-8' );
my $parser = XML::LibXML::SAX->new( Handler => $builder );
$parser->start_document();
$builder->start_element({Name=>'foo'});
$parser->parse_chunk($chunk);
$parser->parse_chunk($chunk);
$builder->end_element({Name=>'foo'});
$parser->end_document();
# TEST
is($builder->result()->documentElement->toString(), '<foo>'.$chunk.$chunk.'</foo>', ' TODO : Add test name');
}
######## TEST error exceptions ##############
{
package MySAXHandler;
use strict;
use warnings;
use parent 'XML::SAX::Base';
use Carp;
sub start_element {
my( $self, $elm) = @_;
if ( $elm->{LocalName} eq 'TVChannel' ) {
die bless({ Message => "My exception"},"MySAXException");
}
}
}
{
use strict;
use warnings;
my $parser = XML::LibXML::SAX->new( Handler => MySAXHandler->new( )) ;
eval { $parser->parse_string( <<'EOF' ) };
<TVChannel TVChannelID="71" TVChannelName="ARD">
<Moin>Moin</Moin>
</TVChannel>
EOF
# TEST
is(ref($@), 'MySAXException', ' TODO : Add test name');
# TEST
is(ref($@) && $@->{Message}, "My exception", ' TODO : Add test name');
}
########### Helper class #############
package SAXTester;
use Test::More;
sub new {
my $class = shift;
return bless {}, $class;
}
sub start_document {
$SAXTester_start_document_counter->cb()->();
return;
}
sub end_document {
$SAXTester_end_document_counter->cb()->();
return;
}
sub start_element {
my ($self, $el) = @_;
$SAXTester_start_element_stacker->cb()->($el);
# foreach my $attr (keys %{$el->{Attributes}}) {
# warn("Attr: $attr = $el->{Attributes}->{$attr}\n");
# }
# warn("start_element: $el->{Name}\n");
return;
}
sub end_element {
my ($self, $el) = @_;
# warn("end_element: $el->{Name}\n");
}
sub characters {
my ($self, $chars) = @_;
# warn("characters: $chars->{Data}\n");
}
1;
package SAXNSTester;
use Test::More;
sub new {
bless {}, shift;
}
sub start_element {
my ($self, $node) = @_;
$SAXNSTester_start_element_stacker->cb()->($node);
return;
}
sub end_element {
my ($self, $node) = @_;
# warn("end_element: $node->{Name}\n");
}
sub start_prefix_mapping {
my ($self, $node) = @_;
$SAXNSTester_start_prefix_mapping_stacker->cb()->($node);
return;
}
sub end_prefix_mapping {
my ($self, $node) = @_;
$SAXNSTester_end_prefix_mapping_stacker->cb()->($node);
return;
}
1;
package SAXNS2Tester;
use Test::More;
#sub new {
# my $class = shift;
# return bless {}, $class;
#}
sub start_element {
my $self = shift;
my ( $elt ) = @_;
$SAXNS2Tester_start_element_stacker->cb()->($elt);
return;
}
package SAXLocatorTester;
use Test::More;
sub new {
my ($class, $cb) = @_;
my $self = bless {}, $class;
for my $method ( qw(
start_document end_document
start_element end_element
start_cdata end_cdata
start_dtd end_dtd
characters
comment
) ) {
no strict 'refs';
*$method = sub { $cb->( $_[0], $method, @_[1..$#_]) };
}
return $self;
}
sub set_document_locator {
my ($self, $locator) = @_;
$self->{locator} = $locator;
}
1;
package SAXErrorTester;
use Test::More;
sub new {
bless {}, shift;
}
sub end_document {
print "End doc: @_\n";
return 1; # Shouldn't be reached
}
package SAXErrorCallbackTester;
use Test::More;
sub fatal_error {
$_[0]->{fatal_called} = 1;
}
sub start_element {
# test if we can do other stuff
XML::LibXML->new->parse_string("<foo/>");
return;
}
sub new {
bless {}, shift;
}
sub end_document {
print "End doc: @_\n";
return 1; # Shouldn't be reached
}
1;
Reference in New Issue View Git Blame Copy Permalink