File Coverage

blib/lib/XML/Filter/Namespace.pm

Criterion	Covered	Total	%
statement	9	61	14.7
branch	0	26	0.0
condition	0	16	0.0
subroutine	3	14	21.4
pod	8	11	72.7
total	20	128	15.6

package XML::Filter::Namespace;

use strict;

use base qw( XML::SAX::Base Class::Accessor );

use vars qw( $VERSION );

# Manually maintained, this is the package's version number.
$VERSION = '1.03';

sub start_document {
    my $self = shift;
    my ( $data ) = @_;

    die __PACKAGE__.": no namespace specified\n"
	unless $self->ns;

    $self->seen_root( 0 );

    if ($self->nl_after_tag) {
        die __PACKAGE__.": nl_after_tag: not a hash ref\n"
            unless ref($self->nl_after_tag) eq 'HASH';
    } else {
        $self->nl_after_tag( {} );
    }

    $self->SUPER::start_document( $data );
}

# Stub out these as we provide our own.
sub start_dtd { }
sub end_dtd   { }

# Destroy comments.
sub comment { }

sub wanted_ns {
    my $self = shift;
    my ( $data ) = @_;
    return $data->{ NamespaceURI } && $data->{ NamespaceURI } eq $self->ns;
}

{
    my $in_ns = 0;

    sub start_prefix_mapping {
        my $self = shift;
        my ( $data ) = @_;

        return unless $self->wanted_ns( $data );
        return if $in_ns++;

        # Make it the default namespace.
        $data->{ Prefix } = '';

        $self->SUPER::start_prefix_mapping( $data );
    }

    sub end_prefix_mapping {
        my $self = shift;
        my ( $data ) = @_;

        return unless $self->wanted_ns( $data );
        return unless $in_ns--;

        $self->SUPER::end_prefix_mapping( $data );
    }
}

sub start_element {
    my $self = shift;
    my ( $data ) = @_;

    return unless $self->wanted_ns( $data );

    # Delete each attribute that isn't in our namespace.
    foreach my $att_name ( keys %{ $data->{ Attributes } } ) {
        my $attr = $data->{ Attributes }->{ $att_name };
        next if $self->wanted_ns( $attr );
        delete $data->{ Attributes }->{ $att_name };
    }

    $self->fix_attr_prefix( $data->{ Attributes } );

    $self->emit_doctype( $data )
        if !$self->seen_root && ($self->systemid || $self->publicid);

    $self->SUPER::start_element( $data );
    $self->seen_root( 1 );
}

sub emit_doctype {
    my $self = shift;
    my ( $data ) = @_;

    warn __PACKAGE__.": public id specified with no system id\n"
        if $self->publicid && ! $self->systemid;

    $self->SUPER::start_dtd( {
        Name     => $data->{ LocalName },
        SystemId => $self->systemid || '',
        PublicId => $self->publicid || '',
    } );
    $self->SUPER::end_dtd( {} );
}

sub end_element {
    my $self = shift;
    my ( $data ) = @_;

    return unless $self->wanted_ns( $data );

    $self->SUPER::end_element( $data );

    $self->characters( { Data => "\n" } )
        if $self->nl_after_tag->{ $data->{LocalName} };
}

sub fix_attr_prefix {
    my $self = shift;
    my ( $attrs ) = @_;
    foreach my $a ( values %$attrs ) {
        $a->{ Name } =~ s/.*://;
        $a->{ Prefix } = '';
    }
}

__PACKAGE__->mk_accessors( qw( ns systemid publicid seen_root nl_after_tag ) );

1;
__END__