forked from openkylin/libxml-sax-base-perl
Import Upstream version 1.09
This commit is contained in:
su-fang
commit
20732bde5c
|
|
@ -0,0 +1,847 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# This file is used to generate lib/XML/SAX/Base.pm. There is a pre-generated
|
||||
# Base.pm file included in the distribution so you don't need to run this
|
||||
# script unless you are attempting to modify the code.
|
||||
#
|
||||
# The code in this file was adapted from the Makefile.PL when XML::SAX::Base
|
||||
# was split back out into its own distribution.
|
||||
#
|
||||
# You can manually run this file:
|
||||
#
|
||||
# perl ./BuildSAXBase.pl
|
||||
#
|
||||
# or better yet it will be invoked by automatically Dist::Zilla when building
|
||||
# a release from the git repository.
|
||||
#
|
||||
# dzil build
|
||||
#
|
||||
|
||||
package SAX::Base::Builder;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use File::Spec;
|
||||
|
||||
write_xml_sax_base() unless caller();
|
||||
|
||||
sub build_xml_sax_base {
|
||||
my $code = <<'EOHEADER';
|
||||
package XML::SAX::Base;
|
||||
|
||||
# version 0.10 - Kip Hampton <khampton@totalcinema.com>
|
||||
# version 0.13 - Robin Berjon <robin@knowscape.com>
|
||||
# version 0.15 - Kip Hampton <khampton@totalcinema.com>
|
||||
# version 0.17 - Kip Hampton <khampton@totalcinema.com>
|
||||
# version 0.19 - Kip Hampton <khampton@totalcinema.com>
|
||||
# version 0.21 - Kip Hampton <khampton@totalcinema.com>
|
||||
# version 0.22 - Robin Berjon <robin@knowscape.com>
|
||||
# version 0.23 - Matt Sergeant <matt@sergeant.org>
|
||||
# version 0.24 - Robin Berjon <robin@knowscape.com>
|
||||
# version 0.25 - Kip Hampton <khampton@totalcinema.com>
|
||||
# version 1.00 - Kip Hampton <khampton@totalcinema.com>
|
||||
# version 1.01 - Kip Hampton <khampton@totalcinema.com>
|
||||
# version 1.02 - Robin Berjon <robin@knowscape.com>
|
||||
# version 1.03 - Matt Sergeant <matt@sergeant.org>
|
||||
# version 1.04 - Kip Hampton <khampton@totalcinema.com>
|
||||
# version 1.05 - Grant McLean <grantm@cpan.org>
|
||||
# version 1.06 - Grant McLean <grantm@cpan.org>
|
||||
# version 1.07 - Grant McLean <grantm@cpan.org>
|
||||
# version 1.08 - Grant McLean <grantm@cpan.org>
|
||||
|
||||
#-----------------------------------------------------#
|
||||
# STOP!!!!!
|
||||
#
|
||||
# This file is generated by the 'BuildSAXBase.pl' file
|
||||
# that ships with the XML::SAX::Base distribution.
|
||||
# If you need to make changes, patch that file NOT
|
||||
# XML/SAX/Base.pm Better yet, fork the git repository
|
||||
# commit your changes and send a pull request:
|
||||
# https://github.com/grantm/XML-SAX-Base
|
||||
#-----------------------------------------------------#
|
||||
|
||||
use strict;
|
||||
|
||||
use XML::SAX::Exception qw();
|
||||
|
||||
EOHEADER
|
||||
|
||||
my %EVENT_SPEC = (
|
||||
start_document => [qw(ContentHandler DocumentHandler Handler)],
|
||||
end_document => [qw(ContentHandler DocumentHandler Handler)],
|
||||
start_element => [qw(ContentHandler DocumentHandler Handler)],
|
||||
end_element => [qw(ContentHandler DocumentHandler Handler)],
|
||||
characters => [qw(ContentHandler DocumentHandler Handler)],
|
||||
processing_instruction => [qw(ContentHandler DocumentHandler Handler)],
|
||||
ignorable_whitespace => [qw(ContentHandler DocumentHandler Handler)],
|
||||
set_document_locator => [qw(ContentHandler DocumentHandler Handler)],
|
||||
start_prefix_mapping => [qw(ContentHandler Handler)],
|
||||
end_prefix_mapping => [qw(ContentHandler Handler)],
|
||||
skipped_entity => [qw(ContentHandler Handler)],
|
||||
start_cdata => [qw(DocumentHandler LexicalHandler Handler)],
|
||||
end_cdata => [qw(DocumentHandler LexicalHandler Handler)],
|
||||
comment => [qw(DocumentHandler LexicalHandler Handler)],
|
||||
entity_reference => [qw(DocumentHandler Handler)],
|
||||
notation_decl => [qw(DTDHandler Handler)],
|
||||
unparsed_entity_decl => [qw(DTDHandler Handler)],
|
||||
element_decl => [qw(DeclHandler Handler)],
|
||||
attlist_decl => [qw(DTDHandler Handler)],
|
||||
doctype_decl => [qw(DTDHandler Handler)],
|
||||
xml_decl => [qw(DTDHandler Handler)],
|
||||
entity_decl => [qw(DTDHandler Handler)],
|
||||
attribute_decl => [qw(DeclHandler Handler)],
|
||||
internal_entity_decl => [qw(DeclHandler Handler)],
|
||||
external_entity_decl => [qw(DeclHandler Handler)],
|
||||
resolve_entity => [qw(EntityResolver Handler)],
|
||||
start_dtd => [qw(LexicalHandler Handler)],
|
||||
end_dtd => [qw(LexicalHandler Handler)],
|
||||
start_entity => [qw(LexicalHandler Handler)],
|
||||
end_entity => [qw(LexicalHandler Handler)],
|
||||
warning => [qw(ErrorHandler Handler)],
|
||||
error => [qw(ErrorHandler Handler)],
|
||||
fatal_error => [qw(ErrorHandler Handler)],
|
||||
);
|
||||
|
||||
for my $ev (keys %EVENT_SPEC) {
|
||||
$code .= <<" EOTOPCODE";
|
||||
sub $ev {
|
||||
my \$self = shift;
|
||||
if (defined \$self->{Methods}->{'$ev'}) {
|
||||
\$self->{Methods}->{'$ev'}->(\@_);
|
||||
}
|
||||
else {
|
||||
my \$method;
|
||||
my \$callbacks;
|
||||
if (exists \$self->{ParseOptions}) {
|
||||
\$callbacks = \$self->{ParseOptions};
|
||||
}
|
||||
else {
|
||||
\$callbacks = \$self;
|
||||
}
|
||||
if (0) { # dummy to make elsif's below compile
|
||||
}
|
||||
EOTOPCODE
|
||||
|
||||
my ($can_string, $aload_string);
|
||||
for my $h (@{$EVENT_SPEC{$ev}}) {
|
||||
$can_string .= <<" EOCANBLOCK";
|
||||
elsif (defined \$callbacks->{'$h'} and \$method = \$callbacks->{'$h'}->can('$ev') ) {
|
||||
my \$handler = \$callbacks->{'$h'};
|
||||
\$self->{Methods}->{'$ev'} = sub { \$method->(\$handler, \@_) };
|
||||
return \$method->(\$handler, \@_);
|
||||
}
|
||||
EOCANBLOCK
|
||||
$aload_string .= <<" EOALOADBLOCK";
|
||||
elsif (defined \$callbacks->{'$h'}
|
||||
and \$callbacks->{'$h'}->can('AUTOLOAD')
|
||||
and \$callbacks->{'$h'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
|
||||
)
|
||||
{
|
||||
my \$res = eval { \$callbacks->{'$h'}->$ev(\@_) };
|
||||
if (\$@) {
|
||||
die \$@;
|
||||
}
|
||||
else {
|
||||
# I think there's a buggette here...
|
||||
# if the first call throws an exception, we don't set it up right.
|
||||
# Not fatal, but we might want to address it.
|
||||
my \$handler = \$callbacks->{'$h'};
|
||||
\$self->{Methods}->{'$ev'} = sub { \$handler->$ev(\@_) };
|
||||
}
|
||||
return \$res;
|
||||
}
|
||||
EOALOADBLOCK
|
||||
}
|
||||
|
||||
$code .= $can_string . $aload_string;
|
||||
|
||||
$code .= <<" EOFALLTHROUGH";
|
||||
else {
|
||||
\$self->{Methods}->{'$ev'} = sub { };
|
||||
}
|
||||
}
|
||||
EOFALLTHROUGH
|
||||
|
||||
$code .= "\n}\n\n";
|
||||
}
|
||||
|
||||
$code .= <<'BODY';
|
||||
#-------------------------------------------------------------------#
|
||||
# Class->new(%options)
|
||||
#-------------------------------------------------------------------#
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my $options = ($#_ == 0) ? shift : { @_ };
|
||||
|
||||
unless ( defined( $options->{Handler} ) or
|
||||
defined( $options->{ContentHandler} ) or
|
||||
defined( $options->{DTDHandler} ) or
|
||||
defined( $options->{DocumentHandler} ) or
|
||||
defined( $options->{LexicalHandler} ) or
|
||||
defined( $options->{ErrorHandler} ) or
|
||||
defined( $options->{DeclHandler} ) ) {
|
||||
|
||||
$options->{Handler} = XML::SAX::Base::NoHandler->new;
|
||||
}
|
||||
|
||||
my $self = bless $options, $class;
|
||||
# turn NS processing on by default
|
||||
$self->set_feature('http://xml.org/sax/features/namespaces', 1);
|
||||
return $self;
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# $p->parse(%options)
|
||||
#-------------------------------------------------------------------#
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my $parse_options = $self->get_options(@_);
|
||||
local $self->{ParseOptions} = $parse_options;
|
||||
if ($self->{Parent}) { # calling parse on a filter for some reason
|
||||
return $self->{Parent}->parse($parse_options);
|
||||
}
|
||||
else {
|
||||
my $method;
|
||||
if (defined $parse_options->{Source}{CharacterStream} and $method = $self->can('_parse_characterstream')) {
|
||||
warn("parse charstream???\n");
|
||||
return $method->($self, $parse_options->{Source}{CharacterStream});
|
||||
}
|
||||
elsif (defined $parse_options->{Source}{ByteStream} and $method = $self->can('_parse_bytestream')) {
|
||||
return $method->($self, $parse_options->{Source}{ByteStream});
|
||||
}
|
||||
elsif (defined $parse_options->{Source}{String} and $method = $self->can('_parse_string')) {
|
||||
return $method->($self, $parse_options->{Source}{String});
|
||||
}
|
||||
elsif (defined $parse_options->{Source}{SystemId} and $method = $self->can('_parse_systemid')) {
|
||||
return $method->($self, $parse_options->{Source}{SystemId});
|
||||
}
|
||||
else {
|
||||
die "No _parse_* routine defined on this driver (If it is a filter, remember to set the Parent property. If you call the parse() method, make sure to set a Source. You may want to call parse_uri, parse_string or parse_file instead.) [$self]";
|
||||
}
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# $p->parse_file(%options)
|
||||
#-------------------------------------------------------------------#
|
||||
sub parse_file {
|
||||
my $self = shift;
|
||||
my $file = shift;
|
||||
return $self->parse_uri($file, @_) if ref(\$file) eq 'SCALAR';
|
||||
my $parse_options = $self->get_options(@_);
|
||||
$parse_options->{Source}{ByteStream} = $file;
|
||||
return $self->parse($parse_options);
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# $p->parse_uri(%options)
|
||||
#-------------------------------------------------------------------#
|
||||
sub parse_uri {
|
||||
my $self = shift;
|
||||
my $file = shift;
|
||||
my $parse_options = $self->get_options(@_);
|
||||
$parse_options->{Source}{SystemId} = $file;
|
||||
return $self->parse($parse_options);
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# $p->parse_string(%options)
|
||||
#-------------------------------------------------------------------#
|
||||
sub parse_string {
|
||||
my $self = shift;
|
||||
my $string = shift;
|
||||
my $parse_options = $self->get_options(@_);
|
||||
$parse_options->{Source}{String} = $string;
|
||||
return $self->parse($parse_options);
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# get_options
|
||||
#-------------------------------------------------------------------#
|
||||
sub get_options {
|
||||
my $self = shift;
|
||||
|
||||
if (@_ == 1) {
|
||||
return { %$self, %{$_[0]} };
|
||||
} else {
|
||||
return { %$self, @_ };
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# get_features
|
||||
#-------------------------------------------------------------------#
|
||||
sub get_features {
|
||||
return (
|
||||
'http://xml.org/sax/features/external-general-entities' => undef,
|
||||
'http://xml.org/sax/features/external-parameter-entities' => undef,
|
||||
'http://xml.org/sax/features/is-standalone' => undef,
|
||||
'http://xml.org/sax/features/lexical-handler' => undef,
|
||||
'http://xml.org/sax/features/parameter-entities' => undef,
|
||||
'http://xml.org/sax/features/namespaces' => 1,
|
||||
'http://xml.org/sax/features/namespace-prefixes' => 0,
|
||||
'http://xml.org/sax/features/string-interning' => undef,
|
||||
'http://xml.org/sax/features/use-attributes2' => undef,
|
||||
'http://xml.org/sax/features/use-locator2' => undef,
|
||||
'http://xml.org/sax/features/validation' => undef,
|
||||
|
||||
'http://xml.org/sax/properties/dom-node' => undef,
|
||||
'http://xml.org/sax/properties/xml-string' => undef,
|
||||
);
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# get_feature
|
||||
#-------------------------------------------------------------------#
|
||||
sub get_feature {
|
||||
my $self = shift;
|
||||
my $feat = shift;
|
||||
|
||||
# check %FEATURES to see if it's there, and return it if so
|
||||
# throw XML::SAX::Exception::NotRecognized if it's not there
|
||||
# throw XML::SAX::Exception::NotSupported if it's there but we
|
||||
# don't support it
|
||||
|
||||
my %features = $self->get_features();
|
||||
if (exists $features{$feat}) {
|
||||
my %supported = map { $_ => 1 } $self->supported_features();
|
||||
if ($supported{$feat}) {
|
||||
return $self->{__PACKAGE__ . "::Features"}{$feat};
|
||||
}
|
||||
throw XML::SAX::Exception::NotSupported(
|
||||
Message => "The feature '$feat' is not supported by " . ref($self),
|
||||
Exception => undef,
|
||||
);
|
||||
}
|
||||
throw XML::SAX::Exception::NotRecognized(
|
||||
Message => "The feature '$feat' is not recognized by " . ref($self),
|
||||
Exception => undef,
|
||||
);
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# set_feature
|
||||
#-------------------------------------------------------------------#
|
||||
sub set_feature {
|
||||
my $self = shift;
|
||||
my $feat = shift;
|
||||
my $value = shift;
|
||||
# check %FEATURES to see if it's there, and set it if so
|
||||
# throw XML::SAX::Exception::NotRecognized if it's not there
|
||||
# throw XML::SAX::Exception::NotSupported if it's there but we
|
||||
# don't support it
|
||||
|
||||
my %features = $self->get_features();
|
||||
if (exists $features{$feat}) {
|
||||
my %supported = map { $_ => 1 } $self->supported_features();
|
||||
if ($supported{$feat}) {
|
||||
return $self->{__PACKAGE__ . "::Features"}{$feat} = $value;
|
||||
}
|
||||
throw XML::SAX::Exception::NotSupported(
|
||||
Message => "The feature '$feat' is not supported by " . ref($self),
|
||||
Exception => undef,
|
||||
);
|
||||
}
|
||||
throw XML::SAX::Exception::NotRecognized(
|
||||
Message => "The feature '$feat' is not recognized by " . ref($self),
|
||||
Exception => undef,
|
||||
);
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# get_handler and friends
|
||||
#-------------------------------------------------------------------#
|
||||
sub get_handler {
|
||||
my $self = shift;
|
||||
my $handler_type = shift;
|
||||
$handler_type ||= 'Handler';
|
||||
return defined( $self->{$handler_type} ) ? $self->{$handler_type} : undef;
|
||||
}
|
||||
|
||||
sub get_document_handler {
|
||||
my $self = shift;
|
||||
return $self->get_handler('DocumentHandler', @_);
|
||||
}
|
||||
|
||||
sub get_content_handler {
|
||||
my $self = shift;
|
||||
return $self->get_handler('ContentHandler', @_);
|
||||
}
|
||||
|
||||
sub get_dtd_handler {
|
||||
my $self = shift;
|
||||
return $self->get_handler('DTDHandler', @_);
|
||||
}
|
||||
|
||||
sub get_lexical_handler {
|
||||
my $self = shift;
|
||||
return $self->get_handler('LexicalHandler', @_);
|
||||
}
|
||||
|
||||
sub get_decl_handler {
|
||||
my $self = shift;
|
||||
return $self->get_handler('DeclHandler', @_);
|
||||
}
|
||||
|
||||
sub get_error_handler {
|
||||
my $self = shift;
|
||||
return $self->get_handler('ErrorHandler', @_);
|
||||
}
|
||||
|
||||
sub get_entity_resolver {
|
||||
my $self = shift;
|
||||
return $self->get_handler('EntityResolver', @_);
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# set_handler and friends
|
||||
#-------------------------------------------------------------------#
|
||||
sub set_handler {
|
||||
my $self = shift;
|
||||
my ($new_handler, $handler_type) = reverse @_;
|
||||
$handler_type ||= 'Handler';
|
||||
$self->{Methods} = {} if $self->{Methods};
|
||||
$self->{$handler_type} = $new_handler;
|
||||
$self->{ParseOptions}->{$handler_type} = $new_handler;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub set_document_handler {
|
||||
my $self = shift;
|
||||
return $self->set_handler('DocumentHandler', @_);
|
||||
}
|
||||
|
||||
sub set_content_handler {
|
||||
my $self = shift;
|
||||
return $self->set_handler('ContentHandler', @_);
|
||||
}
|
||||
sub set_dtd_handler {
|
||||
my $self = shift;
|
||||
return $self->set_handler('DTDHandler', @_);
|
||||
}
|
||||
sub set_lexical_handler {
|
||||
my $self = shift;
|
||||
return $self->set_handler('LexicalHandler', @_);
|
||||
}
|
||||
sub set_decl_handler {
|
||||
my $self = shift;
|
||||
return $self->set_handler('DeclHandler', @_);
|
||||
}
|
||||
sub set_error_handler {
|
||||
my $self = shift;
|
||||
return $self->set_handler('ErrorHandler', @_);
|
||||
}
|
||||
sub set_entity_resolver {
|
||||
my $self = shift;
|
||||
return $self->set_handler('EntityResolver', @_);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
#-------------------------------------------------------------------#
|
||||
# supported_features
|
||||
#-------------------------------------------------------------------#
|
||||
sub supported_features {
|
||||
my $self = shift;
|
||||
# Only namespaces are required by all parsers
|
||||
return (
|
||||
'http://xml.org/sax/features/namespaces',
|
||||
);
|
||||
}
|
||||
#-------------------------------------------------------------------#
|
||||
|
||||
sub no_op {
|
||||
# this space intentionally blank
|
||||
}
|
||||
|
||||
|
||||
package XML::SAX::Base::NoHandler;
|
||||
|
||||
# we need a fake handler that doesn't implement anything, this
|
||||
# simplifies the code a lot (though given the recent changes,
|
||||
# it may be better to do without)
|
||||
sub new {
|
||||
#warn "no handler called\n";
|
||||
return bless {};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
BODY
|
||||
|
||||
$code .= "__END__\n";
|
||||
|
||||
$code .= <<'FOOTER';
|
||||
|
||||
=head1 NAME
|
||||
|
||||
XML::SAX::Base - Base class SAX Drivers and Filters
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package MyFilter;
|
||||
use XML::SAX::Base;
|
||||
@ISA = ('XML::SAX::Base');
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module has a very simple task - to be a base class for PerlSAX
|
||||
drivers and filters. It's default behaviour is to pass the input directly
|
||||
to the output unchanged. It can be useful to use this module as a base class
|
||||
so you don't have to, for example, implement the characters() callback.
|
||||
|
||||
The main advantages that it provides are easy dispatching of events the right
|
||||
way (ie it takes care for you of checking that the handler has implemented
|
||||
that method, or has defined an AUTOLOAD), and the guarantee that filters
|
||||
will pass along events that they aren't implementing to handlers downstream
|
||||
that might nevertheless be interested in them.
|
||||
|
||||
=head1 WRITING SAX DRIVERS AND FILTERS
|
||||
|
||||
The Perl Sax API Reference is at L<http://perl-xml.sourceforge.net/perl-sax/>.
|
||||
|
||||
Writing SAX Filters is tremendously easy: all you need to do is
|
||||
inherit from this module, and define the events you want to handle. A
|
||||
more detailed explanation can be found at
|
||||
http://www.xml.com/pub/a/2001/10/10/sax-filters.html.
|
||||
|
||||
Writing Drivers is equally simple. The one thing you need to pay
|
||||
attention to is B<NOT> to call events yourself (this applies to Filters
|
||||
as well). For instance:
|
||||
|
||||
package MyFilter;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
# do something
|
||||
$self->{Handler}->start_element($data); # BAD
|
||||
}
|
||||
|
||||
The above example works well as precisely that: an example. But it has
|
||||
several faults: 1) it doesn't test to see whether the handler defines
|
||||
start_element. Perhaps it doesn't want to see that event, in which
|
||||
case you shouldn't throw it (otherwise it'll die). 2) it doesn't check
|
||||
ContentHandler and then Handler (ie it doesn't look to see that the
|
||||
user hasn't requested events on a specific handler, and if not on the
|
||||
default one), 3) if it did check all that, not only would the code be
|
||||
cumbersome (see this module's source to get an idea) but it would also
|
||||
probably have to check for a DocumentHandler (in case this were SAX1)
|
||||
and for AUTOLOADs potentially defined in all these packages. As you can
|
||||
tell, that would be fairly painful. Instead of going through that,
|
||||
simply remember to use code similar to the following instead:
|
||||
|
||||
package MyFilter;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
# do something to filter
|
||||
$self->SUPER::start_element($data); # GOOD (and easy) !
|
||||
}
|
||||
|
||||
This way, once you've done your job you hand the ball back to
|
||||
XML::SAX::Base and it takes care of all those problems for you!
|
||||
|
||||
Note that the above example doesn't apply to filters only, drivers
|
||||
will benefit from the exact same feature.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
A number of methods are defined within this class for the purpose of
|
||||
inheritance. Some probably don't need to be overridden (eg parse_file)
|
||||
but some clearly should be (eg parse). Options for these methods are
|
||||
described in the PerlSAX2 specification available from
|
||||
http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/perl-xml/libxml-perl/doc/sax-2.0.html?rev=HEAD&content-type=text/html.
|
||||
|
||||
=over 4
|
||||
|
||||
=item * parse
|
||||
|
||||
The parse method is the main entry point to parsing documents. Internally
|
||||
the parse method will detect what type of "thing" you are parsing, and
|
||||
call the appropriate method in your implementation class. Here is the
|
||||
mapping table of what is in the Source options (see the Perl SAX 2.0
|
||||
specification for the meaning of these values):
|
||||
|
||||
Source Contains parse() calls
|
||||
=============== =============
|
||||
CharacterStream (*) _parse_characterstream($stream, $options)
|
||||
ByteStream _parse_bytestream($stream, $options)
|
||||
String _parse_string($string, $options)
|
||||
SystemId _parse_systemid($string, $options)
|
||||
|
||||
However note that these methods may not be sensible if your driver class
|
||||
is not for parsing XML. An example might be a DBI driver that generates
|
||||
XML/SAX from a database table. If that is the case, you likely want to
|
||||
write your own parse() method.
|
||||
|
||||
Also note that the Source may contain both a PublicId entry, and an
|
||||
Encoding entry. To get at these, examine $options->{Source} as passed
|
||||
to your method.
|
||||
|
||||
(*) A CharacterStream is a filehandle that does not need any encoding
|
||||
translation done on it. This is implemented as a regular filehandle
|
||||
and only works under Perl 5.7.2 or higher using PerlIO. To get a single
|
||||
character, or number of characters from it, use the perl core read()
|
||||
function. To get a single byte from it (or number of bytes), you can
|
||||
use sysread(). The encoding of the stream should be in the Encoding
|
||||
entry for the Source.
|
||||
|
||||
=item * parse_file, parse_uri, parse_string
|
||||
|
||||
These are all convenience variations on parse(), and in fact simply
|
||||
set up the options before calling it. You probably don't need to
|
||||
override these.
|
||||
|
||||
=item * get_options
|
||||
|
||||
This is a convenience method to get options in SAX2 style, or more
|
||||
generically either as hashes or as hashrefs (it returns a hashref).
|
||||
You will probably want to use this method in your own implementations
|
||||
of parse() and of new().
|
||||
|
||||
=item * get_feature, set_feature
|
||||
|
||||
These simply get and set features, and throw the
|
||||
appropriate exceptions defined in the specification if need be.
|
||||
|
||||
If your subclass defines features not defined in this one,
|
||||
then you should override these methods in such a way that they check for
|
||||
your features first, and then call the base class's methods
|
||||
for features not defined by your class. An example would be:
|
||||
|
||||
sub get_feature {
|
||||
my $self = shift;
|
||||
my $feat = shift;
|
||||
if (exists $MY_FEATURES{$feat}) {
|
||||
# handle the feature in various ways
|
||||
}
|
||||
else {
|
||||
return $self->SUPER::get_feature($feat);
|
||||
}
|
||||
}
|
||||
|
||||
Currently this part is unimplemented.
|
||||
|
||||
|
||||
=item * set_handler
|
||||
|
||||
This method takes a handler type (Handler, ContentHandler, etc.) and a
|
||||
handler object as arguments, and changes the current handler for that
|
||||
handler type, while taking care of resetting the internal state that
|
||||
needs to be reset. This allows one to change a handler during parse
|
||||
without running into problems (changing it on the parser object
|
||||
directly will most likely cause trouble).
|
||||
|
||||
=item * set_document_handler, set_content_handler, set_dtd_handler, set_lexical_handler, set_decl_handler, set_error_handler, set_entity_resolver
|
||||
|
||||
These are just simple wrappers around the former method, and take a
|
||||
handler object as their argument. Internally they simply call
|
||||
set_handler with the correct arguments.
|
||||
|
||||
=item * get_handler
|
||||
|
||||
The inverse of set_handler, this method takes a an optional string containing a handler type (DTDHandler,
|
||||
ContentHandler, etc. 'Handler' is used if no type is passed). It returns a reference to the object that implements
|
||||
that class, or undef if that handler type is not set for the current driver/filter.
|
||||
|
||||
=item * get_document_handler, get_content_handler, get_dtd_handler, get_lexical_handler, get_decl_handler,
|
||||
get_error_handler, get_entity_resolver
|
||||
|
||||
These are just simple wrappers around the get_handler() method, and take no arguments. Internally
|
||||
they simply call get_handler with the correct handler type name.
|
||||
|
||||
=back
|
||||
|
||||
It would be rather useless to describe all the methods that this
|
||||
module implements here. They are all the methods supported in SAX1 and
|
||||
SAX2. In case your memory is a little short, here is a list. The
|
||||
apparent duplicates are there so that both versions of SAX can be
|
||||
supported.
|
||||
|
||||
=over 4
|
||||
|
||||
=item * start_document
|
||||
|
||||
=item * end_document
|
||||
|
||||
=item * start_element
|
||||
|
||||
=item * start_document
|
||||
|
||||
=item * end_document
|
||||
|
||||
=item * start_element
|
||||
|
||||
=item * end_element
|
||||
|
||||
=item * characters
|
||||
|
||||
=item * processing_instruction
|
||||
|
||||
=item * ignorable_whitespace
|
||||
|
||||
=item * set_document_locator
|
||||
|
||||
=item * start_prefix_mapping
|
||||
|
||||
=item * end_prefix_mapping
|
||||
|
||||
=item * skipped_entity
|
||||
|
||||
=item * start_cdata
|
||||
|
||||
=item * end_cdata
|
||||
|
||||
=item * comment
|
||||
|
||||
=item * entity_reference
|
||||
|
||||
=item * notation_decl
|
||||
|
||||
=item * unparsed_entity_decl
|
||||
|
||||
=item * element_decl
|
||||
|
||||
=item * attlist_decl
|
||||
|
||||
=item * doctype_decl
|
||||
|
||||
=item * xml_decl
|
||||
|
||||
=item * entity_decl
|
||||
|
||||
=item * attribute_decl
|
||||
|
||||
=item * internal_entity_decl
|
||||
|
||||
=item * external_entity_decl
|
||||
|
||||
=item * resolve_entity
|
||||
|
||||
=item * start_dtd
|
||||
|
||||
=item * end_dtd
|
||||
|
||||
=item * start_entity
|
||||
|
||||
=item * end_entity
|
||||
|
||||
=item * warning
|
||||
|
||||
=item * error
|
||||
|
||||
=item * fatal_error
|
||||
|
||||
=back
|
||||
|
||||
=head1 TODO
|
||||
|
||||
- more tests
|
||||
- conform to the "SAX Filters" and "Java and DOM compatibility"
|
||||
sections of the SAX2 document.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Kip Hampton (khampton@totalcinema.com) did most of the work, after porting
|
||||
it from XML::Filter::Base.
|
||||
|
||||
Robin Berjon (robin@knowscape.com) pitched in with patches to make it
|
||||
usable as a base for drivers as well as filters, along with other patches.
|
||||
|
||||
Matt Sergeant (matt@sergeant.org) wrote the original XML::Filter::Base,
|
||||
and patched a few things here and there, and imported it into
|
||||
the XML::SAX distribution.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<XML::SAX>
|
||||
|
||||
=cut
|
||||
|
||||
FOOTER
|
||||
|
||||
|
||||
return $code;
|
||||
}
|
||||
|
||||
|
||||
sub write_xml_sax_base {
|
||||
confirm_forced_update();
|
||||
|
||||
my $path = File::Spec->catfile("lib", "XML", "SAX", "Base.pm");
|
||||
save_original_xml_sax_base($path);
|
||||
|
||||
my $code = build_xml_sax_base();
|
||||
$code = add_version_stanzas($code);
|
||||
|
||||
open my $fh, ">", $path or die "Cannot write $path: $!";
|
||||
print $fh $code;
|
||||
close $fh or die "Error writing $path: $!";
|
||||
print "Wrote $path\n";
|
||||
}
|
||||
|
||||
|
||||
sub confirm_forced_update {
|
||||
return if grep { $_ eq '--force' } @ARGV;
|
||||
|
||||
print <<'EOF';
|
||||
*** WARNING ***
|
||||
|
||||
The BuildSAXBase.pl script is used to generate the lib/XML/SAX/Base.pm file.
|
||||
However a pre-generated version of Base.pm is included in the distribution
|
||||
so you do not need to run this script unless you intend to modify the code.
|
||||
|
||||
You must use the --force option to deliberately overwrite the distributed
|
||||
version of lib/XML/SAX/Base.pm
|
||||
|
||||
EOF
|
||||
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
sub save_original_xml_sax_base {
|
||||
my($path) = @_;
|
||||
|
||||
return unless -e $path;
|
||||
(my $save_path = $path) =~ s{Base}{Base-orig};
|
||||
return if -e $save_path;
|
||||
print "Saving $path to $save_path\n";
|
||||
rename($path, $save_path);
|
||||
}
|
||||
|
||||
|
||||
sub add_version_stanzas {
|
||||
my($code) = @_;
|
||||
|
||||
my $version = get_xml_sax_base_version();
|
||||
$code =~ s<^(package\s+(\w[:\w]+).*?\n)>
|
||||
<${1}BEGIN {\n \$${2}::VERSION = '$version';\n}\n>mg;
|
||||
return $code;
|
||||
}
|
||||
|
||||
|
||||
sub get_xml_sax_base_version {
|
||||
open my $fh, '<', 'dist.ini' or die "open(<dist.ini): $!";
|
||||
while(<$fh>) {
|
||||
m{^\s*version\s*=\s*(\S+)} && return $1;
|
||||
}
|
||||
die "Failed to find version in dist.ini";
|
||||
}
|
||||
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
Revision history for Perl extension XML::SAX::Base.
|
||||
|
||||
1.09 2017-04-03 21:00:06+12:00 Pacific/Auckland
|
||||
- fix test suite to work without '.' in @INC (RT#120435, pull request
|
||||
from James E Keenan)
|
||||
|
||||
1.08 2011-09-14 20:37:39 Pacific/Auckland
|
||||
- rename BuildSAXBase.PL => BuildSAXBase.pl
|
||||
- add link to Perl SAX API Reference
|
||||
|
||||
1.07 2011-09-10 11:35:27 Pacific/Auckland
|
||||
- modify BuildSAXBase.PL to include version stanzas when run manually
|
||||
- make BuildSAXBase.PL harmless unless run with --force option
|
||||
|
||||
1.06 2011-09-08 23:10:25 Pacific/Auckland
|
||||
- switch distribution to use Dist::Zilla for packaging
|
||||
- generate XML/SAX/Base.pm at release time rather than install
|
||||
- don't generate XML/SAX/Exception at all - it's static
|
||||
- add git repo to metadata
|
||||
|
||||
1.05 Mon Sep 05 2011
|
||||
- Re-released separately from XML-SAX distribution
|
||||
- tweak to suppress benign warning (released 2007-02-08 as part of XML-SAX 0.15)
|
||||
|
||||
1.04 Mon Apr 28 23:56:33 2001
|
||||
- plugged major memory leak (thanks to Richard Titmuss for the catch and Matt Sergeant for the patch).
|
||||
- added get_handler method (and friends).
|
||||
- added to test suite
|
||||
|
||||
1.03 Mon Jan 21 2002
|
||||
- set namespaces feature on by default as per SAX spec
|
||||
|
||||
1.02 Fri Nov 30 2001
|
||||
- implemented get/set_feature in terms of supported_features
|
||||
|
||||
1.01 Mon Nov 26 01:56:33 2001
|
||||
- added set_handler method (and friends).
|
||||
- added to test suite
|
||||
|
||||
1.00 Tue Nov 20 01:01:22 2001
|
||||
- created standalone 1.0 distribution.
|
||||
|
||||
0.22 Tue Oct 30 18:54:03 2001
|
||||
- changed the name to reflect the fact that this is really
|
||||
a base class for any kind of SAX Driver (Fitlers being only
|
||||
a specific case of Drivers).
|
||||
- added some more SAX2 compatibility options
|
||||
|
||||
|
||||
0.19 - 0.21 Sun Oct 14 11:06:23 2001
|
||||
- Major architectural changes.
|
||||
- Base now uses an agressive method caching strategy
|
||||
in which the various possible handler classes are
|
||||
explicity checked (via 'can') for a method implementation.
|
||||
Failing that, the classes are examined for an
|
||||
'AUTOLOAD' sub and the given method is called directly
|
||||
on that class-- if that call dies for a reason other
|
||||
"Can't find object method 'foo'" the error is propigated.
|
||||
If an appropriate method is found, the coderef cached
|
||||
in the instance's 'Methods' HASH
|
||||
($self->{Methods}->{$method_name}) which is used for
|
||||
subsequent calls to that method.
|
||||
|
||||
0.17 - Fri Oct 12 23:43 2001
|
||||
- More clean-up.
|
||||
|
||||
0.15 Mon Oct 08 18:12:33 2001
|
||||
- added 'autogen.pl' to generate Base.pm offline
|
||||
rather than building subs at compile time.
|
||||
- fixed 'dangling $@' that was causing parse to die
|
||||
in undesirable cases because, although the module was
|
||||
rightly skipping over cases where a handler method
|
||||
was not implemented, $@ was still set globally and
|
||||
causing problems further up the food-chain.
|
||||
*pizzas welcome* ;->
|
||||
|
||||
0.11 Sat Oct 06 21:08:42 2001
|
||||
- modifications by Robin Berjon to provide full SAX1 and
|
||||
SAX2 support, along with proper handler defaulting and
|
||||
dispatching.
|
||||
|
||||
0.10 Sat Sep 01 08:53:42 2001
|
||||
- patches by Kip Hampton to avoid throwing events that
|
||||
aren't defined
|
||||
|
||||
0.01 Fri May 18 16:26:33 2001
|
||||
- original version; created by h2xs 1.19
|
||||
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.022.
|
||||
BuildSAXBase.pl
|
||||
Changes
|
||||
MANIFEST
|
||||
META.json
|
||||
META.yml
|
||||
Makefile.PL
|
||||
README
|
||||
dist.ini
|
||||
lib/XML/SAX/Base.pm
|
||||
lib/XML/SAX/Exception.pm
|
||||
t/00basic.t
|
||||
t/01exception.t
|
||||
t/01simpledriver.t
|
||||
t/02simplefilter.t
|
||||
t/03chdriver.t
|
||||
t/04chfilter.t
|
||||
t/05dtdhdriver.t
|
||||
t/06lexhdriver.t
|
||||
t/07declhdriver.t
|
||||
t/08errorhdriver.t
|
||||
t/09resoldriver.t
|
||||
t/10dochdriver.t
|
||||
t/11sax1multiclass.t
|
||||
t/12sax2multiclass.t
|
||||
t/13handlerswitch.t
|
||||
t/14downstreamswitch.t
|
||||
t/15parentswitch.t
|
||||
t/16gethandlers.t
|
||||
t/events.pl
|
||||
t/release-pod-syntax.t
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
{
|
||||
"abstract" : "Base class for SAX Drivers and Filters",
|
||||
"author" : [
|
||||
"Grant McLean <grantm@cpan.org>"
|
||||
],
|
||||
"dynamic_config" : 0,
|
||||
"generated_by" : "Dist::Zilla version 5.022, CPAN::Meta::Converter version 2.142690",
|
||||
"license" : [
|
||||
"perl_5"
|
||||
],
|
||||
"meta-spec" : {
|
||||
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
|
||||
"version" : "2"
|
||||
},
|
||||
"name" : "XML-SAX-Base",
|
||||
"prereqs" : {
|
||||
"configure" : {
|
||||
"requires" : {
|
||||
"ExtUtils::MakeMaker" : "0"
|
||||
}
|
||||
},
|
||||
"develop" : {
|
||||
"requires" : {
|
||||
"Test::Pod" : "1.41"
|
||||
}
|
||||
},
|
||||
"runtime" : {
|
||||
"requires" : {
|
||||
"perl" : "5.008"
|
||||
}
|
||||
},
|
||||
"test" : {
|
||||
"requires" : {
|
||||
"Test::More" : "0.88"
|
||||
}
|
||||
}
|
||||
},
|
||||
"release_status" : "stable",
|
||||
"resources" : {
|
||||
"repository" : {
|
||||
"type" : "git",
|
||||
"url" : "git://github.com/grantm/XML-SAX-Base.git",
|
||||
"web" : "https://github.com/grantm/XML-SAX-Base"
|
||||
}
|
||||
},
|
||||
"version" : "1.09"
|
||||
}
|
||||
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
---
|
||||
abstract: 'Base class for SAX Drivers and Filters'
|
||||
author:
|
||||
- 'Grant McLean <grantm@cpan.org>'
|
||||
build_requires:
|
||||
Test::More: 0.88
|
||||
configure_requires:
|
||||
ExtUtils::MakeMaker: 0
|
||||
dynamic_config: 0
|
||||
generated_by: 'Dist::Zilla version 5.022, CPAN::Meta::Converter version 2.142690'
|
||||
license: perl
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.4.html
|
||||
version: 1.4
|
||||
name: XML-SAX-Base
|
||||
requires:
|
||||
perl: 5.008
|
||||
resources:
|
||||
repository: git://github.com/grantm/XML-SAX-Base.git
|
||||
version: 1.09
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
|
||||
# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.022.
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use 5.008;
|
||||
|
||||
use ExtUtils::MakeMaker;
|
||||
|
||||
|
||||
|
||||
my %WriteMakefileArgs = (
|
||||
"ABSTRACT" => "Base class for SAX Drivers and Filters",
|
||||
"AUTHOR" => "Grant McLean <grantm\@cpan.org>",
|
||||
"CONFIGURE_REQUIRES" => {
|
||||
"ExtUtils::MakeMaker" => 0
|
||||
},
|
||||
"DISTNAME" => "XML-SAX-Base",
|
||||
"EXE_FILES" => [],
|
||||
"LICENSE" => "perl",
|
||||
"MIN_PERL_VERSION" => "5.008",
|
||||
"NAME" => "XML::SAX::Base",
|
||||
"PREREQ_PM" => {},
|
||||
"TEST_REQUIRES" => {
|
||||
"Test::More" => "0.88"
|
||||
},
|
||||
"VERSION" => "1.09",
|
||||
"test" => {
|
||||
"TESTS" => "t/*.t"
|
||||
}
|
||||
);
|
||||
|
||||
|
||||
my %FallbackPrereqs = (
|
||||
"ExtUtils::MakeMaker" => 0,
|
||||
"Test::More" => "0.88"
|
||||
);
|
||||
|
||||
|
||||
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
|
||||
delete $WriteMakefileArgs{TEST_REQUIRES};
|
||||
delete $WriteMakefileArgs{BUILD_REQUIRES};
|
||||
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
|
||||
}
|
||||
|
||||
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
|
||||
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
|
||||
|
||||
WriteMakefile(%WriteMakefileArgs);
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,289 @@
|
|||
XML::SAX::Base is intended for use as a base class for SAX filter modules
|
||||
and XML parsers generating SAX events.
|
||||
|
||||
If you simply wish to build a SAX handler class to 'consume' SAX events you
|
||||
do not need to use XML::SAX::Base directly although you will need to install
|
||||
XML::SAX.
|
||||
|
||||
This module used to be distributed as part of the XML:SAX distribution but
|
||||
is now distributed separately and referenced as a dependency by XML::SAX.
|
||||
|
||||
INSTALLATION:
|
||||
|
||||
via tarball:
|
||||
|
||||
% tar -zxvf XML-SAX-Base-xxx.tar.gz
|
||||
% perl Makefile.PL
|
||||
% make && make test
|
||||
% make install
|
||||
|
||||
via CPAN shell:
|
||||
|
||||
% perl -MCPAN -e shell
|
||||
% install XML::SAX::Base
|
||||
|
||||
The rest of this file consists of the fine XML::SAX::Base documentation
|
||||
contributed by Robin Berjon.
|
||||
|
||||
Enjoy!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
XML::SAX::Base - Base class SAX Drivers and Filters
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package MyFilter;
|
||||
use XML::SAX::Base;
|
||||
@ISA = ('XML::SAX::Base');
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module has a very simple task - to be a base class for PerlSAX
|
||||
drivers and filters. It's default behaviour is to pass the input directly
|
||||
to the output unchanged. It can be useful to use this module as a base class
|
||||
so you don't have to, for example, implement the characters() callback.
|
||||
|
||||
The main advantages that it provides are easy dispatching of events the right
|
||||
way (ie it takes care for you of checking that the handler has implemented
|
||||
that method, or has defined an AUTOLOAD), and the guarantee that filters
|
||||
will pass along events that they aren't implementing to handlers downstream
|
||||
that might nevertheless be interested in them.
|
||||
|
||||
=head1 WRITING SAX DRIVERS AND FILTERS
|
||||
|
||||
The Perl Sax API Reference is at L<http://perl-xml.sourceforge.net/perl-sax/>.
|
||||
|
||||
Writing SAX Filters is tremendously easy: all you need to do is
|
||||
inherit from this module, and define the events you want to handle. A
|
||||
more detailed explanation can be found at
|
||||
http://www.xml.com/pub/a/2001/10/10/sax-filters.html.
|
||||
|
||||
Writing Drivers is equally simple. The one thing you need to pay
|
||||
attention to is B<NOT> to call events yourself (this applies to Filters
|
||||
as well). For instance:
|
||||
|
||||
package MyFilter;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
# do something
|
||||
$self->{Handler}->start_element($data); # BAD
|
||||
}
|
||||
|
||||
The above example works well as precisely that: an example. But it has
|
||||
several faults: 1) it doesn't test to see whether the handler defines
|
||||
start_element. Perhaps it doesn't want to see that event, in which
|
||||
case you shouldn't throw it (otherwise it'll die). 2) it doesn't check
|
||||
ContentHandler and then Handler (ie it doesn't look to see that the
|
||||
user hasn't requested events on a specific handler, and if not on the
|
||||
default one), 3) if it did check all that, not only would the code be
|
||||
cumbersome (see this module's source to get an idea) but it would also
|
||||
probably have to check for a DocumentHandler (in case this were SAX1)
|
||||
and for AUTOLOADs potentially defined in all these packages. As you can
|
||||
tell, that would be fairly painful. Instead of going through that,
|
||||
simply remember to use code similar to the following instead:
|
||||
|
||||
package MyFilter;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
# do something to filter
|
||||
$self->SUPER::start_element($data); # GOOD (and easy) !
|
||||
}
|
||||
|
||||
This way, once you've done your job you hand the ball back to
|
||||
XML::SAX::Base and it takes care of all those problems for you!
|
||||
|
||||
Note that the above example doesn't apply to filters only, drivers
|
||||
will benefit from the exact same feature.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
A number of methods are defined within this class for the purpose of
|
||||
inheritance. Some probably don't need to be overridden (eg parse_file)
|
||||
but some clearly should be (eg parse). Options for these methods are
|
||||
described in the PerlSAX2 specification available from
|
||||
http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/perl-xml/libxml-perl/doc/sax-2.0.html?rev=HEAD&content-type=text/html.
|
||||
|
||||
=over 4
|
||||
|
||||
=item * parse
|
||||
|
||||
The parse method is the main entry point to parsing documents. Internally
|
||||
the parse method will detect what type of "thing" you are parsing, and
|
||||
call the appropriate method in your implementation class. Here is the
|
||||
mapping table of what is in the Source options (see the Perl SAX 2.0
|
||||
specification for the meaning of these values):
|
||||
|
||||
Source Contains parse() calls
|
||||
=============== =============
|
||||
CharacterStream (*) _parse_characterstream($stream, $options)
|
||||
ByteStream _parse_bytestream($stream, $options)
|
||||
String _parse_string($string, $options)
|
||||
SystemId _parse_systemid($string, $options)
|
||||
|
||||
However note that these methods may not be sensible if your driver class
|
||||
is not for parsing XML. An example might be a DBI driver that generates
|
||||
XML/SAX from a database table. If that is the case, you likely want to
|
||||
write your own parse() method.
|
||||
|
||||
Also note that the Source may contain both a PublicId entry, and an
|
||||
Encoding entry. To get at these, examine $options->{Source} as passed
|
||||
to your method.
|
||||
|
||||
(*) A CharacterStream is a filehandle that does not need any encoding
|
||||
translation done on it. This is implemented as a regular filehandle
|
||||
and only works under Perl 5.7.2 or higher using PerlIO. To get a single
|
||||
character, or number of characters from it, use the perl core read()
|
||||
function. To get a single byte from it (or number of bytes), you can
|
||||
use sysread(). The encoding of the stream should be in the Encoding
|
||||
entry for the Source.
|
||||
|
||||
=item * parse_file, parse_uri, parse_string
|
||||
|
||||
These are all convenience variations on parse(), and in fact simply
|
||||
set up the options before calling it. You probably don't need to
|
||||
override these.
|
||||
|
||||
=item * get_options
|
||||
|
||||
This is a convenience method to get options in SAX2 style, or more
|
||||
generically either as hashes or as hashrefs (it returns a hashref).
|
||||
You will probably want to use this method in your own implementations
|
||||
of parse() and of new().
|
||||
|
||||
=item * get_feature, set_feature
|
||||
|
||||
These simply get and set features, and throw the
|
||||
appropriate exceptions defined in the specification if need be.
|
||||
|
||||
If your subclass defines features not defined in this one,
|
||||
then you should override these methods in such a way that they check for
|
||||
your features first, and then call the base class's methods
|
||||
for features not defined by your class. An example would be:
|
||||
|
||||
sub get_feature {
|
||||
my $self = shift;
|
||||
my $feat = shift;
|
||||
if (exists $MY_FEATURES{$feat}) {
|
||||
# handle the feature in various ways
|
||||
}
|
||||
else {
|
||||
return $self->SUPER::get_feature($feat);
|
||||
}
|
||||
}
|
||||
|
||||
Currently this part is unimplemented.
|
||||
|
||||
=back
|
||||
|
||||
It would be rather useless to describe all the methods that this
|
||||
module implements here. They are all the methods supported in SAX1 and
|
||||
SAX2. In case your memory is a little short, here is a list. The
|
||||
apparent duplicates are there so that both versions of SAX can be
|
||||
supported.
|
||||
|
||||
=over 4
|
||||
|
||||
=item * start_document
|
||||
|
||||
=item * end_document
|
||||
|
||||
=item * start_element
|
||||
|
||||
=item * start_document
|
||||
|
||||
=item * end_document
|
||||
|
||||
=item * start_element
|
||||
|
||||
=item * end_element
|
||||
|
||||
=item * characters
|
||||
|
||||
=item * processing_instruction
|
||||
|
||||
=item * ignorable_whitespace
|
||||
|
||||
=item * set_document_locator
|
||||
|
||||
=item * start_prefix_mapping
|
||||
|
||||
=item * end_prefix_mapping
|
||||
|
||||
=item * skipped_entity
|
||||
|
||||
=item * start_cdata
|
||||
|
||||
=item * end_cdata
|
||||
|
||||
=item * comment
|
||||
|
||||
=item * entity_reference
|
||||
|
||||
=item * notation_decl
|
||||
|
||||
=item * unparsed_entity_decl
|
||||
|
||||
=item * element_decl
|
||||
|
||||
=item * attlist_decl
|
||||
|
||||
=item * doctype_decl
|
||||
|
||||
=item * xml_decl
|
||||
|
||||
=item * entity_decl
|
||||
|
||||
=item * attribute_decl
|
||||
|
||||
=item * internal_entity_decl
|
||||
|
||||
=item * external_entity_decl
|
||||
|
||||
=item * resolve_entity
|
||||
|
||||
=item * start_dtd
|
||||
|
||||
=item * end_dtd
|
||||
|
||||
=item * start_entity
|
||||
|
||||
=item * end_entity
|
||||
|
||||
=item * warning
|
||||
|
||||
=item * error
|
||||
|
||||
=item * fatal_error
|
||||
|
||||
=back
|
||||
|
||||
=head1 TODO
|
||||
|
||||
- more tests
|
||||
- conform to the "SAX Filters" and "Java and DOM compatibility"
|
||||
sections of the SAX2 document.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Kip Hampton (khampton@totalcinema.com) did most of the work, after porting
|
||||
it from XML::Filter::Base.
|
||||
|
||||
Robin Berjon (robin@knowscape.com) pitched in with patches to make it
|
||||
usable as a base for drivers as well as filters, along with other patches.
|
||||
|
||||
Matt Sergeant (matt@sergeant.org) wrote the original XML::Filter::Base,
|
||||
and patched a few things here and there, and imported it into
|
||||
the XML::SAX distribution.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<XML::SAX>
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
name = XML-SAX-Base
|
||||
author = Grant McLean <grantm@cpan.org>
|
||||
license = Perl_5
|
||||
copyright_holder = Grant McLean
|
||||
copyright_year = 2011
|
||||
main_module = lib/XML/SAX/Base.pm
|
||||
abstract = Base class for SAX Drivers and Filters
|
||||
repository = git://github.com/grantm/XML-SAX-Base.git
|
||||
|
||||
version = 1.09
|
||||
|
||||
[Repository]
|
||||
[NextRelease]
|
||||
[PodSyntaxTests]
|
||||
[MetaJSON]
|
||||
[MetaYAML]
|
||||
[PkgVersion]
|
||||
[@Git]
|
||||
|
||||
[BuildSAXBase]
|
||||
|
||||
[@Filter]
|
||||
-bundle = @Basic
|
||||
-remove = Readme
|
||||
-remove = License
|
||||
-remove = MetaYAML
|
||||
|
||||
[Prereqs]
|
||||
perl = 5.008
|
||||
|
||||
[Prereqs / TestRequires]
|
||||
Test::More = 0.88
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,126 @@
|
|||
package XML::SAX::Exception;
|
||||
$XML::SAX::Exception::VERSION = '1.09';
|
||||
use strict;
|
||||
|
||||
use overload '""' => "stringify",
|
||||
'fallback' => 1;
|
||||
|
||||
use vars qw($StackTrace);
|
||||
|
||||
use Carp;
|
||||
|
||||
$StackTrace = $ENV{XML_DEBUG} || 0;
|
||||
|
||||
# Other exception classes:
|
||||
|
||||
@XML::SAX::Exception::NotRecognized::ISA = ('XML::SAX::Exception');
|
||||
@XML::SAX::Exception::NotSupported::ISA = ('XML::SAX::Exception');
|
||||
@XML::SAX::Exception::Parse::ISA = ('XML::SAX::Exception');
|
||||
|
||||
|
||||
sub throw {
|
||||
my $class = shift;
|
||||
if (ref($class)) {
|
||||
die $class;
|
||||
}
|
||||
die $class->new(@_);
|
||||
}
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my %opts = @_;
|
||||
confess "Invalid options: " . join(', ', keys %opts) unless exists $opts{Message};
|
||||
|
||||
bless { ($StackTrace ? (StackTrace => stacktrace()) : ()), %opts },
|
||||
$class;
|
||||
}
|
||||
|
||||
sub stringify {
|
||||
my $self = shift;
|
||||
local $^W;
|
||||
my $error;
|
||||
if (exists $self->{LineNumber}) {
|
||||
$error = $self->{Message} . " [Ln: " . $self->{LineNumber} .
|
||||
", Col: " . $self->{ColumnNumber} . "]";
|
||||
}
|
||||
else {
|
||||
$error = $self->{Message};
|
||||
}
|
||||
if ($StackTrace) {
|
||||
$error .= stackstring($self->{StackTrace});
|
||||
}
|
||||
$error .= "\n";
|
||||
return $error;
|
||||
}
|
||||
|
||||
sub stacktrace {
|
||||
my $i = 2;
|
||||
my @fulltrace;
|
||||
while (my @trace = caller($i++)) {
|
||||
my %hash;
|
||||
@hash{qw(Package Filename Line)} = @trace[0..2];
|
||||
push @fulltrace, \%hash;
|
||||
}
|
||||
return \@fulltrace;
|
||||
}
|
||||
|
||||
sub stackstring {
|
||||
my $stacktrace = shift;
|
||||
my $string = "\nFrom:\n";
|
||||
foreach my $current (@$stacktrace) {
|
||||
$string .= $current->{Filename} . " Line: " . $current->{Line} . "\n";
|
||||
}
|
||||
return $string;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
XML::SAX::Exception - Exception classes for XML::SAX
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
throw XML::SAX::Exception::NotSupported(
|
||||
Message => "The foo feature is not supported",
|
||||
);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module is the base class for all SAX Exceptions, those defined in
|
||||
the spec as well as those that one may create for one's own SAX errors.
|
||||
|
||||
There are three subclasses included, corresponding to those of the SAX
|
||||
spec:
|
||||
|
||||
XML::SAX::Exception::NotSupported
|
||||
XML::SAX::Exception::NotRecognized
|
||||
XML::SAX::Exception::Parse
|
||||
|
||||
Use them wherever you want, and as much as possible when you encounter
|
||||
such errors. SAX is meant to use exceptions as much as possible to
|
||||
flag problems.
|
||||
|
||||
=head1 CREATING NEW EXCEPTION CLASSES
|
||||
|
||||
All you need to do to create a new exception class is:
|
||||
|
||||
@XML::SAX::Exception::MyException::ISA = ('XML::SAX::Exception')
|
||||
|
||||
The given package doesn't need to exist, it'll behave correctly this
|
||||
way. If your exception refines an existing exception class, then you
|
||||
may also inherit from that instead of from the base class.
|
||||
|
||||
=head1 THROWING EXCEPTIONS
|
||||
|
||||
This is as simple as exemplified in the SYNOPSIS. In fact, there's
|
||||
nothing more to know. All you have to do is:
|
||||
|
||||
throw XML::SAX::Exception::MyException( Message => 'Something went wrong' );
|
||||
|
||||
and voila, you've thrown an exception which can be caught in an eval block.
|
||||
|
||||
=cut
|
||||
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 1 }
|
||||
END { ok($loaded) }
|
||||
use XML::SAX::Base;
|
||||
$loaded++;
|
||||
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 14 }
|
||||
use XML::SAX::Exception;
|
||||
eval {
|
||||
throw XML::SAX::Exception ( Message => "Test" );
|
||||
};
|
||||
ok($@); # test died
|
||||
ok($@, "Test\n"); # test stringification
|
||||
ok($@->isa('XML::SAX::Exception')); # test isa
|
||||
|
||||
eval {
|
||||
throw XML::SAX::Exception::Parse (
|
||||
Message => "Parse",
|
||||
LineNumber => 12,
|
||||
ColumnNumber => 2,
|
||||
SystemId => "throw.xml",
|
||||
PublicId => "Some // Public // Identifier",
|
||||
);
|
||||
};
|
||||
ok($@);
|
||||
ok($@->{Message}, "Parse");
|
||||
ok($@, qr/Parse/);
|
||||
ok($@->{LineNumber}, 12);
|
||||
ok($@->isa('XML::SAX::Exception::Parse'));
|
||||
|
||||
eval {
|
||||
throw XML::SAX::Exception::ThisOneDoesNotExist (
|
||||
Message => "Fubar",
|
||||
);
|
||||
};
|
||||
ok($@);
|
||||
ok(!UNIVERSAL::isa($@, 'XML::SAX::Exception'));
|
||||
|
||||
eval {
|
||||
throw XML::SAX::Exception::NotRecognized (
|
||||
Message => "Not Recognized",
|
||||
);
|
||||
};
|
||||
ok($@);
|
||||
ok($@->isa('XML::SAX::Exception'));
|
||||
|
||||
eval {
|
||||
throw XML::SAX::Exception::NotSupported (
|
||||
Message => "Not Supported",
|
||||
);
|
||||
};
|
||||
ok($@);
|
||||
ok($@->isa('XML::SAX::Exception'));
|
||||
|
||||
|
|
@ -0,0 +1,229 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 1 }
|
||||
use XML::SAX::Base;
|
||||
|
||||
my $sax_it = SAXIterator->new();
|
||||
my $driver = Driver->new(Handler => $sax_it);
|
||||
|
||||
my $retval = $driver->parse();
|
||||
|
||||
ok ($retval == 32);
|
||||
# end main
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
|
||||
$self->SUPER::start_document;
|
||||
$self->SUPER::start_element;
|
||||
$self->SUPER::characters;
|
||||
$self->SUPER::processing_instruction;
|
||||
$self->SUPER::end_prefix_mapping;
|
||||
$self->SUPER::start_prefix_mapping;
|
||||
$self->SUPER::set_document_locator;
|
||||
$self->SUPER::xml_decl;
|
||||
$self->SUPER::ignorable_whitespace;
|
||||
$self->SUPER::skipped_entity;
|
||||
$self->SUPER::start_cdata;
|
||||
$self->SUPER::end_cdata;
|
||||
$self->SUPER::comment;
|
||||
$self->SUPER::entity_reference;
|
||||
$self->SUPER::unparsed_entity_decl;
|
||||
$self->SUPER::element_decl;
|
||||
$self->SUPER::attlist_decl;
|
||||
$self->SUPER::doctype_decl;
|
||||
$self->SUPER::entity_decl;
|
||||
$self->SUPER::attribute_decl;
|
||||
$self->SUPER::internal_entity_decl;
|
||||
$self->SUPER::external_entity_decl;
|
||||
$self->SUPER::resolve_entity;
|
||||
$self->SUPER::start_dtd;
|
||||
$self->SUPER::end_dtd;
|
||||
$self->SUPER::start_entity;
|
||||
$self->SUPER::end_entity;
|
||||
$self->SUPER::warning;
|
||||
$self->SUPER::error;
|
||||
$self->SUPER::fatal_error;
|
||||
$self->SUPER::end_element;
|
||||
return $self->SUPER::end_document;
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXIterator;
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{_cnt} = 0;
|
||||
return bless \%options, $class;
|
||||
}
|
||||
|
||||
sub start_document {
|
||||
my ($self, $document) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub start_element {
|
||||
my ($self, $element) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub characters {
|
||||
my ($self, $chars) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_element {
|
||||
my ($self, $element) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_document {
|
||||
my ($self, $document) = @_;
|
||||
$self->{_cnt}++;
|
||||
return $self->{_cnt};
|
||||
}
|
||||
|
||||
sub processing_instruction {
|
||||
my ($self, $pi) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_prefix_mapping {
|
||||
my ($self, $mapping) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub start_prefix_mapping {
|
||||
my ($self, $mapping) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub set_document_locator {
|
||||
my ($self, $mapping) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
|
||||
sub xml_decl {
|
||||
my ($self, $mapping) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub ignorable_whitespace {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub skipped_entity {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub start_cdata {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_cdata {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub comment {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub entity_reference {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub unparsed_entity_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub element_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub attlist_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub doctype_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub entity_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub attribute_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub internal_entity_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub external_entity_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub resolve_entity {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub start_dtd {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_dtd {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub start_entity {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_entity {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub warning {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub error {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub fatal_error {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,235 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 1 }
|
||||
use XML::SAX::Base;
|
||||
|
||||
my $sax_it = SAXIterator->new();
|
||||
my $filter = EmptyFilter->new(Handler => $sax_it);
|
||||
my $driver = Driver->new(Handler => $filter);
|
||||
|
||||
my $retval = $driver->parse();
|
||||
|
||||
ok ($retval == 32);
|
||||
# end main
|
||||
|
||||
package EmptyFilter;
|
||||
use base qw(XML::SAX::Base);
|
||||
# DAAAAAHUUUT!!!!!!
|
||||
1;
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
|
||||
$self->SUPER::start_document;
|
||||
$self->SUPER::start_element;
|
||||
$self->SUPER::characters;
|
||||
$self->SUPER::processing_instruction;
|
||||
$self->SUPER::end_prefix_mapping;
|
||||
$self->SUPER::start_prefix_mapping;
|
||||
$self->SUPER::set_document_locator;
|
||||
$self->SUPER::xml_decl;
|
||||
$self->SUPER::ignorable_whitespace;
|
||||
$self->SUPER::skipped_entity;
|
||||
$self->SUPER::start_cdata;
|
||||
$self->SUPER::end_cdata;
|
||||
$self->SUPER::comment;
|
||||
$self->SUPER::entity_reference;
|
||||
$self->SUPER::unparsed_entity_decl;
|
||||
$self->SUPER::element_decl;
|
||||
$self->SUPER::attlist_decl;
|
||||
$self->SUPER::doctype_decl;
|
||||
$self->SUPER::entity_decl;
|
||||
$self->SUPER::attribute_decl;
|
||||
$self->SUPER::internal_entity_decl;
|
||||
$self->SUPER::external_entity_decl;
|
||||
$self->SUPER::resolve_entity;
|
||||
$self->SUPER::start_dtd;
|
||||
$self->SUPER::end_dtd;
|
||||
$self->SUPER::start_entity;
|
||||
$self->SUPER::end_entity;
|
||||
$self->SUPER::warning;
|
||||
$self->SUPER::error;
|
||||
$self->SUPER::fatal_error;
|
||||
$self->SUPER::end_element;
|
||||
return $self->SUPER::end_document;
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXIterator;
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{_cnt} = 0;
|
||||
return bless \%options, $class;
|
||||
}
|
||||
|
||||
sub start_document {
|
||||
my ($self, $document) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub start_element {
|
||||
my ($self, $element) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub characters {
|
||||
my ($self, $chars) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_element {
|
||||
my ($self, $element) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_document {
|
||||
my ($self, $document) = @_;
|
||||
$self->{_cnt}++;
|
||||
return $self->{_cnt};
|
||||
}
|
||||
|
||||
sub processing_instruction {
|
||||
my ($self, $pi) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_prefix_mapping {
|
||||
my ($self, $mapping) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub start_prefix_mapping {
|
||||
my ($self, $mapping) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub set_document_locator {
|
||||
my ($self, $mapping) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
|
||||
sub xml_decl {
|
||||
my ($self, $mapping) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub ignorable_whitespace {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub skipped_entity {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub start_cdata {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_cdata {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub comment {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub entity_reference {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub unparsed_entity_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub element_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub attlist_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub doctype_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub entity_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub attribute_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub internal_entity_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub external_entity_decl {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub resolve_entity {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub start_dtd {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_dtd {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub start_entity {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub end_entity {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub warning {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub error {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
sub fatal_error {
|
||||
my ($self, $wtf) = @_;
|
||||
$self->{_cnt}++;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,76 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 12 }
|
||||
use XML::SAX::Base;
|
||||
use vars qw/%events/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Tests for ContentHandler classes
|
||||
|
||||
my $sax_it = SAXAutoload->new();
|
||||
my $driver = Driver->new(ContentHandler => $sax_it);
|
||||
my %ret = $driver->parse();
|
||||
|
||||
ok (scalar(keys(%ret)) == 11);
|
||||
|
||||
foreach my $meth (keys(%ret)){
|
||||
my $ok_cnt = 0;
|
||||
foreach my $key (keys (%{ $ret{$meth} })){
|
||||
$ok_cnt++ if $ret{$meth}->{$key} eq $events{$meth}->{$key};
|
||||
}
|
||||
ok(
|
||||
$ok_cnt == scalar(keys(%{$ret{$meth}})) &&
|
||||
$ok_cnt == scalar(keys(%{$events{$meth}}))
|
||||
) || warn "failed for $meth\n";
|
||||
}
|
||||
# end main
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::start_document($events{start_document});
|
||||
$self->SUPER::processing_instruction($events{processing_instruction});
|
||||
$self->SUPER::set_document_locator($events{set_document_locator});
|
||||
$self->SUPER::start_prefix_mapping($events{start_prefix_mapping});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::characters($events{characters});
|
||||
$self->SUPER::ignorable_whitespace($events{ignorable_whitespace});
|
||||
$self->SUPER::skipped_entity($events{skipped_entity});
|
||||
$self->SUPER::end_element($events{end_element});
|
||||
$self->SUPER::end_prefix_mapping($events{end_prefix_mapping});
|
||||
return $self->SUPER::end_document($events{end_document});
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXAutoload;
|
||||
use vars qw($AUTOLOAD);
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{Methods} = {};
|
||||
return bless \%options, $class;
|
||||
}
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://; # strip fully-qualified portion
|
||||
return if $name eq 'DESTROY';
|
||||
$self->{Methods}->{$name} = $data ;
|
||||
}
|
||||
|
||||
sub end_document {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
$self->{Methods}->{end_document} = $data;
|
||||
return %{$self->{Methods}};
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,83 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 12 }
|
||||
use XML::SAX::Base;
|
||||
use vars qw/%events/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Tests for ContentHandler classes using a filter
|
||||
|
||||
my $sax_it = SAXAutoload->new();
|
||||
my $filter = Filter->new(ContentHandler => $sax_it);
|
||||
my $driver = Driver->new(ContentHandler => $filter);
|
||||
my %ret = $driver->parse();
|
||||
|
||||
ok (scalar(keys(%ret)) == 11);
|
||||
|
||||
foreach my $meth (keys(%ret)){
|
||||
my $ok_cnt = 0;
|
||||
foreach my $key (keys (%{ $ret{$meth} })){
|
||||
$ok_cnt++ if $ret{$meth}->{$key} eq $events{$meth}->{$key};
|
||||
}
|
||||
ok(
|
||||
$ok_cnt == scalar(keys(%{$ret{$meth}})) &&
|
||||
$ok_cnt == scalar(keys(%{$events{$meth}}))
|
||||
) || warn "failed for $meth\n";
|
||||
}
|
||||
# end main
|
||||
|
||||
package Filter;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::start_document($events{start_document});
|
||||
$self->SUPER::processing_instruction($events{processing_instruction});
|
||||
$self->SUPER::set_document_locator($events{set_document_locator});
|
||||
$self->SUPER::start_prefix_mapping($events{start_prefix_mapping});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::characters($events{characters});
|
||||
$self->SUPER::ignorable_whitespace($events{ignorable_whitespace});
|
||||
$self->SUPER::skipped_entity($events{skipped_entity});
|
||||
$self->SUPER::end_element($events{end_element});
|
||||
$self->SUPER::end_prefix_mapping($events{end_prefix_mapping});
|
||||
return $self->SUPER::end_document($events{end_document});
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXAutoload;
|
||||
use vars qw($AUTOLOAD);
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{Methods} = {};
|
||||
return bless \%options, $class;
|
||||
}
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://; # strip fully-qualified portion
|
||||
return if $name eq 'DESTROY';
|
||||
$self->{Methods}->{$name} = $data ;
|
||||
}
|
||||
|
||||
sub end_document {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
$self->{Methods}->{end_document} = $data;
|
||||
return %{$self->{Methods}};
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,72 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 7 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Tests for ContentHandler classes using a filter
|
||||
|
||||
my $sax_it = SAXAutoload->new();
|
||||
my $filter = Filter->new(DTDHandler => $sax_it);
|
||||
my $driver = Driver->new(DTDHandler => $filter);
|
||||
$driver->_parse();
|
||||
|
||||
ok($meth_count == 6);
|
||||
|
||||
# end main
|
||||
|
||||
package Filter;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub _parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::notation_decl($events{notation_decl});
|
||||
$self->SUPER::unparsed_entity_decl($events{unparsed_entity_decl});
|
||||
$self->SUPER::xml_decl($events{xml_decl});
|
||||
$self->SUPER::attlist_decl($events{attlist_decl});
|
||||
$self->SUPER::doctype_decl($events{doctype_decl});
|
||||
$self->SUPER::entity_decl($events{entity_decl});
|
||||
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXAutoload;
|
||||
use vars qw($AUTOLOAD);
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{methods} = {};
|
||||
return bless \%options, $class;
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://; # strip fully-qualified portion
|
||||
return if $name eq 'DESTROY';
|
||||
#warn "name is $name \ndata is $data\n";
|
||||
my $okay_count = 0;
|
||||
foreach my $key (keys (%{$data})) {
|
||||
$okay_count++ if defined $main::events{$name}->{$key};
|
||||
}
|
||||
#warn "count $okay_count \n";
|
||||
main::ok($okay_count == scalar (keys (%{$data})));
|
||||
$main::meth_count++;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,72 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 8 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Tests for ContentHandler classes using a filter
|
||||
|
||||
my $sax_it = SAXAutoload->new();
|
||||
my $filter = Filter->new(LexicalHandler => $sax_it);
|
||||
my $driver = Driver->new(LexicalHandler => $filter);
|
||||
$driver->parse();
|
||||
|
||||
ok($meth_count == 7);
|
||||
|
||||
# end main
|
||||
|
||||
package Filter;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::comment($events{comment});
|
||||
$self->SUPER::start_dtd($events{start_dtd});
|
||||
$self->SUPER::end_dtd($events{end_dtd});
|
||||
$self->SUPER::start_cdata($events{start_cdata});
|
||||
$self->SUPER::end_cdata($events{end_cdata});
|
||||
$self->SUPER::start_entity($events{start_entity});
|
||||
$self->SUPER::end_entity($events{end_entity});
|
||||
|
||||
# return $self->SUPER::result(1);
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXAutoload;
|
||||
use vars qw($AUTOLOAD);
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{methods} = {};
|
||||
return bless \%options, $class;
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://; # strip fully-qualified portion
|
||||
return if $name eq 'DESTROY';
|
||||
#warn "name is $name \ndata is $data\n";
|
||||
my $okay_count = 0;
|
||||
foreach my $key (keys (%{$data})) {
|
||||
$okay_count++ if defined $main::events{$name}->{$key};
|
||||
}
|
||||
#warn "count $okay_count \n";
|
||||
main::ok($okay_count == scalar (keys (%{$data})));
|
||||
$main::meth_count++;
|
||||
}
|
||||
1;
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 5 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Tests for ContentHandler classes using a filter
|
||||
|
||||
my $sax_it = SAXAutoload->new();
|
||||
my $filter = Filter->new(DeclHandler => $sax_it);
|
||||
my $driver = Driver->new(DeclHandler => $filter);
|
||||
$driver->parse();
|
||||
|
||||
ok($meth_count == 4);
|
||||
|
||||
# end main
|
||||
|
||||
package Filter;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::element_decl($events{element_decl});
|
||||
$self->SUPER::attribute_decl($events{attribute_decl});
|
||||
$self->SUPER::internal_entity_decl($events{internal_entity_decl});
|
||||
$self->SUPER::external_entity_decl($events{external_entity_decl});
|
||||
|
||||
# return $self->SUPER::result(1);
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXAutoload;
|
||||
use vars qw($AUTOLOAD);
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{methods} = {};
|
||||
return bless \%options, $class;
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://; # strip fully-qualified portion
|
||||
return if $name eq 'DESTROY';
|
||||
#warn "name is $name \ndata is $data\n";
|
||||
my $okay_count = 0;
|
||||
foreach my $key (keys (%{$data})) {
|
||||
$okay_count++ if defined $main::events{$name}->{$key};
|
||||
}
|
||||
#warn "count $okay_count \n";
|
||||
main::ok($okay_count == scalar (keys (%{$data})));
|
||||
$main::meth_count++;
|
||||
}
|
||||
1;
|
||||
|
|
@ -0,0 +1,67 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 4 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Tests for ErrorHandler classes using a filter
|
||||
|
||||
my $sax_it = SAXAutoload->new();
|
||||
my $filter = Filter->new(ErrorHandler => $sax_it);
|
||||
my $driver = Driver->new(ErrorHandler => $filter);
|
||||
$driver->parse();
|
||||
|
||||
ok($meth_count == 3);
|
||||
|
||||
# end main
|
||||
|
||||
package Filter;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::warning($events{warning});
|
||||
$self->SUPER::error($events{error});
|
||||
$self->SUPER::fatal_error($events{fatal_error});
|
||||
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXAutoload;
|
||||
use vars qw($AUTOLOAD);
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{methods} = {};
|
||||
return bless \%options, $class;
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://; # strip fully-qualified portion
|
||||
return if $name eq 'DESTROY';
|
||||
#warn "name is $name \ndata is $data\n";
|
||||
my $okay_count = 0;
|
||||
foreach my $key (keys (%{$data})) {
|
||||
$okay_count++ if defined $main::events{$name}->{$key};
|
||||
}
|
||||
#warn "count $okay_count \n";
|
||||
main::ok($okay_count == scalar (keys (%{$data})));
|
||||
$main::meth_count++;
|
||||
}
|
||||
1;
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 2 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Tests for EntityResolver classes using a filter
|
||||
|
||||
my $sax_it = SAXAutoload->new();
|
||||
my $filter = Filter->new(EntityResolver => $sax_it);
|
||||
my $driver = Driver->new(EntityResolver => $filter);
|
||||
$driver->parse();
|
||||
|
||||
ok($meth_count == 1);
|
||||
|
||||
# end main
|
||||
|
||||
package Filter;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::resolve_entity($events{resolve_entity});
|
||||
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXAutoload;
|
||||
use vars qw($AUTOLOAD);
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{methods} = {};
|
||||
return bless \%options, $class;
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://; # strip fully-qualified portion
|
||||
return if $name eq 'DESTROY';
|
||||
#warn "name is $name \ndata is $data\n";
|
||||
my $okay_count = 0;
|
||||
foreach my $key (keys (%{$data})) {
|
||||
$okay_count++ if defined $main::events{$name}->{$key};
|
||||
}
|
||||
#warn "count $okay_count \n";
|
||||
main::ok($okay_count == scalar (keys (%{$data})));
|
||||
$main::meth_count++;
|
||||
}
|
||||
1;
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 10 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Tests for DocumentHandler classes using a filter
|
||||
|
||||
my $sax_it = SAXAutoload->new();
|
||||
my $filter = Filter->new(DocumentHandler => $sax_it);
|
||||
my $driver = Driver->new(DocumentHandler => $filter);
|
||||
$driver->parse();
|
||||
|
||||
ok($meth_count == 9);
|
||||
|
||||
# end main
|
||||
|
||||
package Filter;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::start_document($events{start_document});
|
||||
$self->SUPER::processing_instruction($events{processing_instruction});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::characters($events{characters});
|
||||
$self->SUPER::ignorable_whitespace($events{ignorable_whitespace});
|
||||
$self->SUPER::set_document_locator($events{set_document_locator});
|
||||
$self->SUPER::end_element($events{end_element});
|
||||
$self->SUPER::entity_reference($events{entity_reference});
|
||||
$self->SUPER::end_document($events{end_document});
|
||||
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXAutoload;
|
||||
use vars qw($AUTOLOAD);
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{methods} = {};
|
||||
return bless \%options, $class;
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://; # strip fully-qualified portion
|
||||
return if $name eq 'DESTROY';
|
||||
#warn "name is $name \ndata is $data\n";
|
||||
my $okay_count = 0;
|
||||
foreach my $key (keys (%{$data})) {
|
||||
$okay_count++ if defined $main::events{$name}->{$key};
|
||||
}
|
||||
#warn "count $okay_count \n";
|
||||
main::ok($okay_count == scalar (keys (%{$data})));
|
||||
$main::meth_count++;
|
||||
}
|
||||
1;
|
||||
|
|
@ -0,0 +1,87 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 16 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Multiclass SAX1 filter
|
||||
|
||||
my $terminus = SAXAutoload->new();
|
||||
my $doc_handler = MyDocHandler->new(Handler => $terminus);
|
||||
my $dtd_handler = MyDTDHandler->new(Handler => $terminus);
|
||||
my $driver = Driver->new(DocumentHandler => $doc_handler,
|
||||
DTDHandler => $dtd_handler);
|
||||
|
||||
$driver->parse();
|
||||
|
||||
ok($meth_count == 15);
|
||||
|
||||
# end main
|
||||
|
||||
package MyDocHandler;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package MyDTDHandler;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::start_document($events{start_document});
|
||||
$self->SUPER::processing_instruction($events{processing_instruction});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::characters($events{characters});
|
||||
$self->SUPER::ignorable_whitespace($events{ignorable_whitespace});
|
||||
$self->SUPER::set_document_locator($events{set_document_locator});
|
||||
$self->SUPER::end_element($events{end_element});
|
||||
$self->SUPER::entity_reference($events{entity_reference});
|
||||
$self->SUPER::end_document($events{end_document});
|
||||
$self->SUPER::notation_decl($events{notation_decl});
|
||||
$self->SUPER::unparsed_entity_decl($events{unparsed_entity_decl});
|
||||
$self->SUPER::xml_decl($events{xml_decl});
|
||||
$self->SUPER::attlist_decl($events{attlist_decl});
|
||||
$self->SUPER::doctype_decl($events{doctype_decl});
|
||||
$self->SUPER::entity_decl($events{entity_decl});
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXAutoload;
|
||||
use vars qw($AUTOLOAD);
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{methods} = {};
|
||||
return bless \%options, $class;
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://; # strip fully-qualified portion
|
||||
return if $name eq 'DESTROY';
|
||||
#warn "name is $name \ndata is $data\n";
|
||||
my $okay_count = 0;
|
||||
foreach my $key (keys (%{$data})) {
|
||||
$okay_count++ if defined $main::events{$name}->{$key};
|
||||
}
|
||||
#warn "count $okay_count \n";
|
||||
main::ok($okay_count == scalar (keys (%{$data})));
|
||||
$main::meth_count++;
|
||||
}
|
||||
1;
|
||||
|
|
@ -0,0 +1,137 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 33 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Multiclass SAX1 filter
|
||||
|
||||
my $terminus = SAXAutoload->new();
|
||||
my $content_handler = MyContentHandler->new(Handler => $terminus);
|
||||
my $lexical_handler = MyLexicalHandler->new(Handler => $terminus);
|
||||
my $decl_handler = MyDeclHandler->new(Handler => $terminus);
|
||||
my $error_handler = MyErrorHandler->new(Handler => $terminus);
|
||||
my $entity_resolver = MyEntityResolver->new(Handler => $terminus);
|
||||
my $dtd_handler = MyDTDHandler->new(Handler => $terminus);
|
||||
|
||||
my $driver = Driver->new(ContentHandler => $content_handler,
|
||||
LexicalHandler => $lexical_handler,
|
||||
DeclHandler => $decl_handler,
|
||||
ErrorHandler => $error_handler,
|
||||
EntityResolver => $entity_resolver,
|
||||
DTDHandler => $dtd_handler);
|
||||
|
||||
$driver->parse();
|
||||
|
||||
ok($meth_count == 32);
|
||||
|
||||
# end main
|
||||
|
||||
package MyContentHandler;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package MyLexicalHandler;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package MyDeclHandler;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package MyErrorHandler;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package MyEntityResolver;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package MyDTDHandler;
|
||||
use base qw(XML::SAX::Base);
|
||||
# this space intentionally blank
|
||||
|
||||
1;
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::start_document($events{start_document});
|
||||
$self->SUPER::processing_instruction($events{processing_instruction});
|
||||
$self->SUPER::set_document_locator($events{set_document_locator});
|
||||
$self->SUPER::start_prefix_mapping($events{start_prefix_mapping});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::characters($events{characters});
|
||||
$self->SUPER::ignorable_whitespace($events{ignorable_whitespace});
|
||||
$self->SUPER::skipped_entity($events{skipped_entity});
|
||||
$self->SUPER::end_element($events{end_element});
|
||||
$self->SUPER::end_prefix_mapping($events{end_prefix_mapping});
|
||||
$self->SUPER::end_document($events{end_document});
|
||||
$self->SUPER::notation_decl($events{notation_decl});
|
||||
$self->SUPER::unparsed_entity_decl($events{unparsed_entity_decl});
|
||||
$self->SUPER::xml_decl($events{xml_decl});
|
||||
$self->SUPER::attlist_decl($events{attlist_decl});
|
||||
$self->SUPER::doctype_decl($events{doctype_decl});
|
||||
$self->SUPER::entity_decl($events{entity_decl});
|
||||
$self->SUPER::comment($events{comment});
|
||||
$self->SUPER::start_dtd($events{start_dtd});
|
||||
$self->SUPER::end_dtd($events{end_dtd});
|
||||
$self->SUPER::start_cdata($events{start_cdata});
|
||||
$self->SUPER::end_cdata($events{end_cdata});
|
||||
$self->SUPER::start_entity($events{start_entity});
|
||||
$self->SUPER::end_entity($events{end_entity});
|
||||
$self->SUPER::element_decl($events{element_decl});
|
||||
$self->SUPER::attribute_decl($events{attribute_decl});
|
||||
$self->SUPER::internal_entity_decl($events{internal_entity_decl});
|
||||
$self->SUPER::external_entity_decl($events{external_entity_decl});
|
||||
$self->SUPER::warning($events{warning});
|
||||
$self->SUPER::error($events{error});
|
||||
$self->SUPER::fatal_error($events{fatal_error});
|
||||
$self->SUPER::resolve_entity($events{resolve_entity});
|
||||
}
|
||||
1;
|
||||
|
||||
# basic single class SAX Handler
|
||||
package SAXAutoload;
|
||||
use vars qw($AUTOLOAD);
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my %options = @_;
|
||||
$options{methods} = {};
|
||||
return bless \%options, $class;
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://; # strip fully-qualified portion
|
||||
return if $name eq 'DESTROY';
|
||||
#warn "name is $name \ndata is $data\n";
|
||||
my $okay_count = 0;
|
||||
foreach my $key (keys (%{$data})) {
|
||||
$okay_count++ if defined $main::events{$name}->{$key};
|
||||
}
|
||||
#warn "count $okay_count \n";
|
||||
main::ok($okay_count == scalar (keys (%{$data})));
|
||||
$main::meth_count++;
|
||||
}
|
||||
1;
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 3 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count $one_count $two_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Tests for in-stream switch of Handler classes.
|
||||
|
||||
my $handler = HandlerOne->new();
|
||||
my $driver = Driver->new(DocumentHandler => $handler);
|
||||
$driver->parse();
|
||||
|
||||
|
||||
ok($one_count == 3);
|
||||
ok($two_count == 3);
|
||||
ok($meth_count == 6);
|
||||
|
||||
# end main
|
||||
|
||||
package HandlerOne;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my ($self, $element) = @_;
|
||||
$main::meth_count++;
|
||||
$main::one_count++;
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
package HandlerTwo;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my ($self, $element) = @_;
|
||||
$main::meth_count++;
|
||||
$main::two_count++;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->set_handler('ContentHandler', HandlerTwo->new());
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
|
||||
}
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,78 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 3 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count $one_count $two_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
$meth_count = 0;
|
||||
# Tests for in-stream switch of Handler classes.
|
||||
|
||||
my $handler = HandlerOne->new();
|
||||
my $filter = Filter->new(DocumentHandler => $handler);
|
||||
my $driver = Driver->new(DocumentHandler => $filter);
|
||||
$driver->parse();
|
||||
|
||||
|
||||
ok($one_count == 3);
|
||||
ok($two_count == 3);
|
||||
ok($meth_count == 6);
|
||||
|
||||
# end main
|
||||
|
||||
package Filter;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my ($self, $element) = @_;
|
||||
if ($main::meth_count == 3) {
|
||||
$self->set_content_handler(HandlerTwo->new());
|
||||
}
|
||||
$self->SUPER::start_element($element);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
package HandlerOne;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my ($self, $element) = @_;
|
||||
$main::meth_count++;
|
||||
$main::one_count++;
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
package HandlerTwo;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my ($self, $element) = @_;
|
||||
$main::meth_count++;
|
||||
$main::two_count++;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
|
||||
}
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 3 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
use vars qw/%events $meth_count $one_count $two_count/;
|
||||
require "./t/events.pl";
|
||||
|
||||
# Tests for in-stream switch of Handler classes.
|
||||
my $driver = Driver->new();
|
||||
my $handler = HandlerOne->new(Parent => $driver);
|
||||
$driver->set_document_handler($handler);
|
||||
|
||||
$driver->parse();
|
||||
|
||||
|
||||
ok($one_count == 3);
|
||||
ok($two_count == 3);
|
||||
ok($meth_count == 6);
|
||||
|
||||
# end main
|
||||
|
||||
package HandlerOne;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my ($self, $element) = @_;
|
||||
$main::meth_count++;
|
||||
$main::one_count++;
|
||||
if ($main::meth_count == 3) {
|
||||
$self->{Parent}->set_content_handler(HandlerTwo->new(Parent => $self->{Parent}));
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
package HandlerTwo;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub start_element {
|
||||
my ($self, $element) = @_;
|
||||
$main::meth_count++;
|
||||
$main::two_count++;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my %events = %main::events;
|
||||
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
$self->SUPER::start_element($events{start_element});
|
||||
|
||||
}
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
use Test;
|
||||
BEGIN { plan tests => 2 }
|
||||
use XML::SAX::Base;
|
||||
use strict;
|
||||
|
||||
# Tests for in-stream switch of Handler classes.
|
||||
my $handler = HandlerOne->new();
|
||||
my $filter = FilterOne->new( ContentHandler => $handler );
|
||||
my $driver = Driver->new( Handler => $filter);
|
||||
|
||||
ok( $filter->get_handler('ContentHandler') =~ /HandlerOne/ );
|
||||
ok( $filter->get_content_handler() =~ /HandlerOne/ );
|
||||
|
||||
# end main
|
||||
|
||||
package HandlerOne;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
1;
|
||||
|
||||
package FilterOne;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
1;
|
||||
|
||||
|
||||
package Driver;
|
||||
use base qw(XML::SAX::Base);
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
%events = (
|
||||
start_document => {},
|
||||
processing_instruction => {Target => 'xml-stylesheet',
|
||||
Data => 'href="style.xml" type="text/xsl"'
|
||||
},
|
||||
|
||||
start_prefix_mapping => {Prefix => 'foo',
|
||||
NamespaceURI => 'http://localhost/foo'
|
||||
},
|
||||
|
||||
start_element => {Name => 'foo:root',
|
||||
LocalName => 'root',
|
||||
Prefix => 'foo',
|
||||
Attributes => {}
|
||||
},
|
||||
|
||||
characters => {Data => 'i am some text'},
|
||||
ignorable_whitespace => {Data => ' '},
|
||||
skipped_entity => {Name => 'huh'},
|
||||
set_document_locator => {Name => 'huh'},
|
||||
end_element => {Name => 'foo:root',
|
||||
LocalName => 'root',
|
||||
Prefix => 'foo'
|
||||
},
|
||||
|
||||
end_prefix_mapping => {Prefix => 'foo',
|
||||
NamespaceURI => 'http://localhost/foo'
|
||||
},
|
||||
xml_decl => {Version => '1.0'},
|
||||
start_cdata => {},
|
||||
end_cdata => {},
|
||||
comment => {Data => 'i am a comment'},
|
||||
entity_reference => {Bogus => 1},
|
||||
notation_decl => {Name => 'entname',
|
||||
PublicID => 'huh?'
|
||||
},
|
||||
unparsed_entity_decl => {Name => 'entname',
|
||||
PublicID => 'huh?',
|
||||
NotationName => 'notname'
|
||||
},
|
||||
element_decl => {Name => 'elname',
|
||||
Model => 'huh?',
|
||||
},
|
||||
attlist_decl => {},
|
||||
doctype_decl => {},
|
||||
entity_decl => {},
|
||||
attribute_decl => {ElementName => 'elname',
|
||||
AttrName => 'attr',
|
||||
},
|
||||
internal_entity_decl => {Name => 'entname',
|
||||
Value => 'entavl'
|
||||
},
|
||||
external_entity_decl => {Name => 'entname',
|
||||
PublicID => 'huh?'
|
||||
},
|
||||
resolve_entity => {},
|
||||
start_dtd => {},
|
||||
end_dtd => {},
|
||||
start_entity => {Name => 'entname'},
|
||||
end_entity => {Name => 'entname'},
|
||||
warning => {Message => 'i warned ye!'},
|
||||
error => {Message => 'bad things'},
|
||||
fatal_error => {Message => 'et tu brute?'},
|
||||
end_document => {msg => 'parse complete'}
|
||||
);
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
#!perl
|
||||
|
||||
BEGIN {
|
||||
unless ($ENV{RELEASE_TESTING}) {
|
||||
require Test::More;
|
||||
Test::More::plan(skip_all => 'these tests are for release candidate testing');
|
||||
}
|
||||
}
|
||||
|
||||
# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests.
|
||||
use Test::More;
|
||||
use Test::Pod 1.41;
|
||||
|
||||
all_pod_files_ok();
|
||||
Loading…
Reference in New Issue