File Coverage

blib/lib/XML/Filter/SAXT.pm

Criterion	Covered	Total	%
statement	6	44	13.6
branch	0	6	0.0
condition	0	3	0.0
subroutine	2	23	8.7
pod	0	21	0.0
total	8	97	8.2

#
# To do:
# - later: ErrorHandler, Locale?

package XML::Filter::SAXT;
use strict;

use vars qw( $VERSION %SAX_HANDLERS );
$VERSION = 0.01;

%SAX_HANDLERS = ( DocumentHandler =>
		  [ "start_document",
		    "end_document",
		    "start_element",
		    "end_element",
		    "characters",
		    "processing_instruction",
		    "comment",
		    "start_cdata",
		    "end_cdata",
		    "entity_reference",
		    "set_document_locator"	# !! passes {Locator=>$perlsax}
		    ],

		  DTDHandler =>
		  [ "notation_decl",
		    "unparsed_entity_decl",
		    "entity_decl",
		    "element_decl",
		    "attlist_decl",
		    "doctype_decl",
		    "xml_decl"
		    ],

		  EntityResolver =>
		  [ "resolve_entity" ]);

#
# Usage:
#
#	$saxt = new XML::Filter::SAXT ( { Handler => $out0 },
#					{ DocumentHandler => $out1 },
#					{ DTDHandler => $out3,
#					  Handler => $out4
#					}
#				      );
#
#	$perlsax = new XML::Parser::PerlSAX ( Handler => $saxt );
#	$perlsax->parse ( [OPTIONS] );
#
sub new
{
    my ($class, @out) = @_;

    my $self = bless { Out => \@out }, $class;

    for (my $i = 0; $i < @out; $i++)
    {
	for my $handler (keys %SAX_HANDLERS)
	{
	    my $callbacks = $SAX_HANDLERS{$handler};
	    my $h = ($self->{Out}->[$i]->{$handler} ||= $self->{Out}->[$i]->{Handler});
	    next unless defined $h;

	    for my $cb (@$callbacks)
	    {
		if (UNIVERSAL::can ($h, $cb))
		{
		    $self->{$cb} .= "\$out->[$i]->{$handler}->$cb (\@_);\n";
		}
	    }
	}
    }

    for my $handler (keys %SAX_HANDLERS)
    {
	my $callbacks = $SAX_HANDLERS{$handler};
	for my $cb (@$callbacks)
	{
	    my $code = $self->{$cb};
	    if (defined $code)
	    {
		$self->{$cb} =
		    eval "sub { my \$out = shift->{Out}; $code }";
	    }
	    else
	    {
		$self->{$cb} = \&noop;
	    }
	}
    }
    return $self;
}

sub noop
{
    # does nothing
}

for my $cb (map { @{ $_ } } values %SAX_HANDLERS)
{
    eval "sub $cb { shift->{$cb}->(\@_); }";
}

1; # package return code

__END__