package HTTP::Proxy::FilterStack;
use strict;
use Carp;
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;
}
sub insert {
my ( $self, $idx ) = ( shift, shift );
$_->[1]->isa( $self->{type} ) or croak("$_ is not a $self->{type}") for @_;
splice @{ $self->{filters} }, $idx, 0, @_;
}
sub remove {
my ( $self, $idx ) = @_;
splice @{ $self->{filters} }, $idx, 1;
}
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}; }
sub select_filters {
my ($self, $message ) = @_;
if ( not defined $self->{current} ) {
$self->{current} =
[ map { $_->[1] } grep { $_->[0]->() } @{ $self->{filters} } ];
if ( $self->{body} ) {
$self->{buffers} = [ ( "" ) x @{ $self->{current} } ];
$self->{buffers} = [ \( @{ $self->{buffers} } ) ];
}
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!" );
}
}
$self->{will_modify} = $self->{body}
? grep { $_->will_modify() } @{ $self->{current} }
: 0;
}
}
sub filter {
my $self = shift;
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;
}
}
sub filter_last {
my $self = shift;
return unless $self->{body};
my $i = 0;
my ( $data, $message, $protocol ) = @_;
for ( @{ $self->{current} } ) {
$$data = ${ $self->{buffers}[ $i ] } . $$data;
${ $self->{buffers}[ $i++ ] } = "";
$_->filter( $data, $message, $protocol, undef );
}
for ( @{ $self->{current} } ) { $_->end if $_->can('end'); }
$self->eod;
}
sub eod {
$_[0]->{buffers} = [];
$_[0]->{current} = undef;
}
1;
__END__
=head1 NAME
HTTP::Proxy::FilterStack - A class to manage filter stacks
=head1 DESCRIPTION
This class is used internally by C<HTTP::Proxy> to manage its
four filter stacks.
From the point of view of C<HTTP::Proxy::FilterStack>, a filter is
actually a (C<matchsub>, C<filterobj>) pair. The match subroutine
(generated by C<HTTP::Proxy>'s C<push_filter()> method) is run
against the current C<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 C<HTTP::Proxy::FilterStack>. If C<$isbody>
is true, then the stack will manage body filters (subclasses of
C<HTTP::Proxy::BodyFilter>).
=item select_filters( $message )
C<$message> is the current C<HTTP::Message> handled by the proxy.
It is used (with the help of each filter's match subroutine)
=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-2006, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut