1package HTTP::Proxy::FilterStack; 2 3# Here's a description of the class internals 4# - filters: the list of (sub, filter) pairs that match the message, 5# and through which it must go 6# - current: the actual list of filters, which is computed during 7# the first call to filter() 8# - buffers: the buffers associated with each (selected) filter 9# - body : true if it's a HTTP::Proxy::BodyFilter stack 10 11use strict; 12use Carp; 13 14# new( $isbody ) 15# $isbody is true only for response-body filters stack 16sub new { 17 my $class = shift; 18 my $self = { 19 body => shift || 0, 20 filters => [], 21 buffers => [], 22 current => undef, 23 }; 24 $self->{type} = $self->{body} ? "HTTP::Proxy::BodyFilter" 25 : "HTTP::Proxy::HeaderFilter"; 26 return bless $self, $class; 27} 28 29# 30# insert( $index, [ $matchsub, $filter ], ...) 31# 32sub insert { 33 my ( $self, $idx ) = ( shift, shift ); 34 $_->[1]->isa( $self->{type} ) or croak("$_ is not a $self->{type}") for @_; 35 splice @{ $self->{filters} }, $idx, 0, @_; 36} 37 38# 39# remove( $index ) 40# 41sub remove { 42 my ( $self, $idx ) = @_; 43 splice @{ $self->{filters} }, $idx, 1; 44} 45 46# 47# push( [ $matchsub, $filter ], ... ) 48# 49sub push { 50 my $self = shift; 51 $_->[1]->isa( $self->{type} ) or croak("$_ is not a $self->{type}") for @_; 52 push @{ $self->{filters} }, @_; 53} 54 55sub all { return @{ $_[0]->{filters} }; } 56sub will_modify { return $_[0]->{will_modify}; } 57 58# 59# select the filters that will be used on the message 60# 61sub select_filters { 62 my ($self, $message ) = @_; 63 64 # first time we're called this round 65 if ( not defined $self->{current} ) { 66 67 # select the filters that match 68 $self->{current} = 69 [ map { $_->[1] } grep { $_->[0]->() } @{ $self->{filters} } ]; 70 71 # create the buffers 72 if ( $self->{body} ) { 73 $self->{buffers} = [ ( "" ) x @{ $self->{current} } ]; 74 $self->{buffers} = [ \( @{ $self->{buffers} } ) ]; 75 } 76 77 # start the filter if needed (and pass the message) 78 for ( @{ $self->{current} } ) { 79 if ( $_->can('begin') ) { $_->begin( $message ); } 80 elsif ( $_->can('start') ) { 81 $_->proxy->log( HTTP::Proxy::ERROR(), "DEPRECATION", "The start() filter method is *deprecated* and disappeared in 0.15!\nUse begin() in your filters instead!" ); 82 } 83 } 84 85 # compute the "will_modify" value 86 $self->{will_modify} = $self->{body} 87 ? grep { $_->will_modify() } @{ $self->{current} } 88 : 0; 89 } 90} 91 92# 93# the actual filtering is done here 94# 95sub filter { 96 my $self = shift; 97 98 # pass the body data through the filter 99 if ( $self->{body} ) { 100 my $i = 0; 101 my ( $data, $message, $protocol ) = @_; 102 for ( @{ $self->{current} } ) { 103 $$data = ${ $self->{buffers}[$i] } . $$data; 104 ${ $self->{buffers}[ $i ] } = ""; 105 $_->filter( $data, $message, $protocol, $self->{buffers}[ $i++ ] ); 106 } 107 } 108 else { 109 $_->filter(@_) for @{ $self->{current} }; 110 $self->eod; 111 } 112} 113 114# 115# filter what remains in the buffers 116# 117sub filter_last { 118 my $self = shift; 119 return unless $self->{body}; # sanity check 120 121 my $i = 0; 122 my ( $data, $message, $protocol ) = @_; 123 for ( @{ $self->{current} } ) { 124 $$data = ${ $self->{buffers}[ $i ] } . $$data; 125 ${ $self->{buffers}[ $i++ ] } = ""; 126 $_->filter( $data, $message, $protocol, undef ); 127 } 128 129 # call the cleanup routine if needed 130 for ( @{ $self->{current} } ) { $_->end if $_->can('end'); } 131 132 # clean up the mess for next time 133 $self->eod; 134} 135 136# 137# END OF DATA cleanup method 138# 139sub eod { 140 $_[0]->{buffers} = []; 141 $_[0]->{current} = undef; 142} 143 1441; 145 146__END__ 147 148=head1 NAME 149 150HTTP::Proxy::FilterStack - A class to manage filter stacks 151 152=head1 DESCRIPTION 153 154This class is used internally by C<HTTP::Proxy> to manage its 155four filter stacks. 156 157From the point of view of C<HTTP::Proxy::FilterStack>, a filter is 158actually a (C<matchsub>, C<filterobj>) pair. The match subroutine 159(generated by C<HTTP::Proxy>'s C<push_filter()> method) is run 160against the current C<HTTP::Message> object to find out which filters 161must be kept in the stack when handling this message. 162 163The filter stack maintains a set of buffers where the filters can 164store data. This data is appended at the beginning of the next 165chunk of data, until all the data has been sent. 166 167=head1 METHODS 168 169The class provides the following methods: 170 171=over 4 172 173=item new( $isbody ) 174 175Create a new instance of C<HTTP::Proxy::FilterStack>. If C<$isbody> 176is true, then the stack will manage body filters (subclasses of 177C<HTTP::Proxy::BodyFilter>). 178 179=item select_filters( $message ) 180 181C<$message> is the current C<HTTP::Message> handled by the proxy. 182It is used (with the help of each filter's match subroutine) 183 184=item filter( @args ) 185 186This method calls all the currently selected filters in turn, 187with the appropriate arguments. 188 189=item filter_last() 190 191This method calls all the currently selected filters in turn, 192to filter the data remaining in the buffers in a single pass. 193 194=item will_modify() 195 196Return a boolean value indicating if the list of selected filters in 197the stack will modify the body content. The value is computed from the 198result of calling C<will_modify()> on all selected filters. 199 200=item all() 201 202Return a list of all filters in the stack. 203 204=item eod() 205 206Used for END OF DATA bookkeeping. 207 208=item push() 209 210Push the given C<[ match, filterobj ]> pairs at the top of the stack. 211 212=item insert( $idx, @pairs ) 213 214Insert the given C<[ match, filterobj ]> pairs at position C<$idx> 215in the stack. 216 217=item remove( $idx ) 218 219Remove the C<[ match, filterobj ]> pair at position C<$idx> in the stack. 220 221=back 222 223=head1 AUTHOR 224 225Philippe "BooK" Bruhat, E<lt>book@cpan.orgE<gt>. 226 227=head1 COPYRIGHT 228 229Copyright 2002-2006, Philippe Bruhat. 230 231=head1 LICENSE 232 233This module is free software; you can redistribute it or modify it under 234the same terms as Perl itself. 235 236=cut 237 238