—

              
package HTTP::Proxy::FilterStack;
$HTTP::Proxy::FilterStack::VERSION = '0.304';
# Here's a description of the class internals
# - filters: the list of (sub, filter) pairs that match the message,
#            and through which it must go
# - current: the actual list of filters, which is computed during
#            the first call to filter()
# - buffers: the buffers associated with each (selected) filter
# - body   : true if it's a HTTP::Proxy::BodyFilter stack
use strict;
use Carp;
# new( $isbody )
# $isbody is true only for response-body filters stack
sub new {
    my $class = shift;
    my $self  = {
        body => shift || 0,
        filters => [],
        buffers => [],
        current => undef,
    };
    $self->{type} = $self->{body} ? "HTTP::Proxy::BodyFilter"
                                  : "HTTP::Proxy::HeaderFilter";
    return bless $self, $class;
}
#
# insert( $index, [ $matchsub, $filter ], ...)
#
sub insert {
    my ( $self, $idx ) = ( shift, shift );
    $_->[1]->isa( $self->{type} ) or croak("$_ is not a $self->{type}") for @_;
    splice @{ $self->{filters} }, $idx, 0, @_;
}
#
# remove( $index )
#
sub remove {
    my ( $self, $idx ) = @_;
    splice @{ $self->{filters} }, $idx, 1;
}
# 
# push( [ $matchsub, $filter ], ... )
# 
sub push {
    my $self = shift;
    $_->[1]->isa( $self->{type} ) or croak("$_ is not a $self->{type}") for @_;
    push @{ $self->{filters} }, @_;
}
sub all    { return @{ $_[0]->{filters} }; }
sub will_modify { return $_[0]->{will_modify}; }
#
# select the filters that will be used on the message
#
sub select_filters {
    my ($self, $message ) = @_;
    # first time we're called this round
    if ( not defined $self->{current} ) {
        # select the filters that match
        $self->{current} =
          [ map { $_->[1] } grep { $_->[0]->() } @{ $self->{filters} } ];
        # create the buffers
        if ( $self->{body} ) {
            $self->{buffers} = [ ( "" ) x @{ $self->{current} } ];
            $self->{buffers} = [ \( @{ $self->{buffers} } ) ];
        }
        # start the filter if needed (and pass the message)
        for ( @{ $self->{current} } ) {
            if    ( $_->can('begin') ) { $_->begin( $message ); }
            elsif ( $_->can('start') ) {
                $_->proxy->log( HTTP::Proxy::ERROR(), "DEPRECATION", "The start() filter method is *deprecated* and disappeared in 0.15!\nUse begin() in your filters instead!" );
            }
        }
        # compute the "will_modify" value
        $self->{will_modify} = $self->{body}
            ? grep { $_->will_modify() } @{ $self->{current} }
            : 0;
    }
}
#
# the actual filtering is done here
#
sub filter {
    my $self = shift;
    # pass the body data through the filter
    if ( $self->{body} ) {
        my $i = 0;
        my ( $data, $message, $protocol ) = @_;
        for ( @{ $self->{current} } ) {
            $$data = ${ $self->{buffers}[$i] } . $$data;
            ${ $self->{buffers}[ $i ] } = "";
            $_->filter( $data, $message, $protocol, $self->{buffers}[ $i++ ] );
        }
    }
    else {
        $_->filter(@_) for @{ $self->{current} };
        $self->eod;
    }
}
#
# filter what remains in the buffers
#
sub filter_last {
    my $self = shift;
    return unless $self->{body};    # sanity check
    my $i = 0;
    my ( $data, $message, $protocol ) = @_;
    for ( @{ $self->{current} } ) {
        $$data = ${ $self->{buffers}[ $i ] } . $$data;
        ${ $self->{buffers}[ $i++ ] } = "";
        $_->filter( $data, $message, $protocol, undef );
    }
    # call the cleanup routine if needed
    for ( @{ $self->{current} } ) { $_->end if $_->can('end'); }
     
    # clean up the mess for next time
    $self->eod;
}
#
# END OF DATA cleanup method
#
sub eod {
    $_[0]->{buffers} = [];
    $_[0]->{current} = undef;
}
1;
__END__
HideShow 92 lines of Pod
=head1 NAME
HTTP::Proxy::FilterStack - A class to manage filter stacks
=head1 DESCRIPTION
This class is used internally by L<HTTP::Proxy> to manage its
four filter stacks.
From the point of view of L<HTTP::Proxy::FilterStack>, a filter is
actually a (C<matchsub>, C<filterobj>) pair. The match subroutine
(generated by L<HTTP::Proxy>'s C<push_filter()> method) is run
against the current L<HTTP::Message> object to find out which filters
must be kept in the stack when handling this message.
The filter stack maintains a set of buffers where the filters can
store data. This data is appended at the beginning of the next
chunk of data, until all the data has been sent.
=head1 METHODS
The class provides the following methods:
=over 4
=item new( $isbody )
Create a new instance of L<HTTP::Proxy::FilterStack>. If C<$isbody>
is true, then the stack will manage body filters (subclasses of
L<HTTP::Proxy::BodyFilter>).
=item select_filters( $message )
C<$message> is the current L<HTTP::Message> handled by the proxy.
It is used (with the help of each filter's match subroutine)
to select the subset of filters that will be applied on the
given message.
=item filter( @args )
This method calls all the currently selected filters in turn,
with the appropriate arguments.
=item filter_last()
This method calls all the currently selected filters in turn,
to filter the data remaining in the buffers in a single pass.
=item will_modify()
Return a boolean value indicating if the list of selected filters in
the stack will modify the body content. The value is computed from the
result of calling C<will_modify()> on all selected filters.
=item all()
Return a list of all filters in the stack.
=item eod()
Used for END OF DATA bookkeeping.
=item push()
Push the given C<[ match, filterobj ]> pairs at the top of the stack.
=item insert( $idx, @pairs )
Insert the given C<[ match, filterobj ]> pairs at position C<$idx>
in the stack.
=item remove( $idx )
Remove the C<[ match, filterobj ]> pair at position C<$idx> in the stack.
=back
=head1 AUTHOR
Philippe "BooK" Bruhat, E<lt>book@cpan.orgE<gt>.
=head1 COPYRIGHT
Copyright 2002-2015, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut