File Coverage

blib/lib/XML/Filter/DocSplitter.pm

Criterion	Covered	Total	%
statement	71	72	98.6
branch	18	28	64.2
condition	6	12	50.0
subroutine	13	13	100.0
pod	8	8	100.0
total	116	133	87.2

package XML::Filter::DocSplitter;
{
  $XML::Filter::DocSplitter::VERSION = '0.46';
}
# ABSTRACT: Multipass processing of documents


use XML::SAX::Base;

@ISA = qw( XML::SAX::Base );

@EXPORT_OK = qw( DocSplitter );

use strict;
use Carp;
use XML::SAX::EventMethodMaker qw( sax_event_names compile_missing_methods );


## Inherited.


sub set_aggregator {
    my $self = shift;
    $self->{Aggregator} = shift;

    $self->{AggregatorPassThrough} = XML::SAX::Base->new()
        unless $self->{AggregatorPassThrough};

    $self->{AggregatorPassThrough}->set_handler( $self->{Aggregator} );
}



sub get_aggregator {
    my $self = shift;

    return $self->{Aggregator};
}



sub set_split_path {
    my $self = shift;
    my $pat = $self->{SplitPoint} = shift;
    $pat = "/$pat"
        unless substr( $pat, 0, 1 ) eq "/";
    $pat = quotemeta $pat;

    $pat =~ s{\\\*}{[^/]*}g;  ## Hmmm, * will match nodes with 0 length names ""
    $pat =~ s{\\/\\/}{/.*/}g;
    $pat =~ s{^\\/}{^}g;

    $self->{SplitPathRe} = qr/$pat(?!\n)\Z/;

    return undef;
}



sub get_split_path {
    my $self = shift;

    return $self->{SplitPoint};
}


sub _check_stack {
    my $self = shift;

    my $stack = join "/", @{$self->{Stack}};

    $stack =~ $self->{SplitPathRe};
}


sub start_document {
    my $self = shift;

    my $aggie = $self->get_aggregator;
    $aggie->start_manifold_document( @_ )
        if $aggie && $aggie->can( "start_manifold_document" );
    $aggie->set_include_all_roots( 1 )
        if $aggie && $aggie->can( "set_include_all_roots" );

    $aggie->start_document( @_ );

    $self->{Stack}       = [];
    $self->{Splitting}   = 0;
    $self->set_split_path( "/*/*" )
        unless defined $self->get_split_path;

    ## don't pass on the start_document, we'll do that once for each
    ## record.
    return undef;
}


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

    push @{$self->{Stack}}, $elt->{Name};

    if ( ! $self->{Splitting} && $self->_check_stack ) {
        ++$self->{Splitting};
        $self->SUPER::start_document( {} );
    }
    elsif ( $self->{Splitting} ) {
        ++$self->{Splitting};
    }

    if ( $self->{Splitting} ) {
        return $self->SUPER::start_element( @_ );
    }

    $self->{AggregatorPassThrough}->start_element( @_ )
        if $self->{AggregatorPassThrough};

    return undef;
}


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

    pop @{$self->{Stack}};

    my $r ;
    if ( $self->{Splitting} ) {
        $r = $self->SUPER::end_element( @_ )
    }
    else {
        $r = $self->{AggregatorPassThrough}->end_element( @_ )
            if $self->{AggregatorPassThrough};
    }

    if ( $self->{Splitting} && ! --$self->{Splitting} ) {
        ## ignore the result code, we'll get it in end_document.
        $self->SUPER::end_document( {} );
    }

    return $r;
}


sub end_document {
    my $self = shift;

    my $aggie = $self->get_aggregator;

    my $r;

    if ( $aggie ) {
        $r = $aggie->end_document( @_ );
        $r = $aggie->end_manifold_document( @_ )
            if $aggie->can( "end_manifold_document" );
    }

    return $r;
}


compile_missing_methods __PACKAGE__, <<'TPL_END', sax_event_names ;
sub  {
    my $self = shift;
    return $self->SUPER::( @_ )
        if $self->{Splitting};

    $self->{AggregatorPassThrough}->( @_ )
        if $self->{AggregatorPassThrough};
}
TPL_END





1;

__END__