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 L<HTTP::Proxy> to manage its 155four filter stacks. 156 157From the point of view of L<HTTP::Proxy::FilterStack>, a filter is 158actually a (C<matchsub>, C<filterobj>) pair. The match subroutine 159(generated by L<HTTP::Proxy>'s C<push_filter()> method) is run 160against the current L<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 L<HTTP::Proxy::FilterStack>. If C<$isbody> 176is true, then the stack will manage body filters (subclasses of 177L<HTTP::Proxy::BodyFilter>). 178 179=item select_filters( $message ) 180 181C<$message> is the current L<HTTP::Message> handled by the proxy. 182It is used (with the help of each filter's match subroutine) 183to select the subset of filters that will be applied on the 184given message. 185 186=item filter( @args ) 187 188This method calls all the currently selected filters in turn, 189with the appropriate arguments. 190 191=item filter_last() 192 193This method calls all the currently selected filters in turn, 194to filter the data remaining in the buffers in a single pass. 195 196=item will_modify() 197 198Return a boolean value indicating if the list of selected filters in 199the stack will modify the body content. The value is computed from the 200result of calling C<will_modify()> on all selected filters. 201 202=item all() 203 204Return a list of all filters in the stack. 205 206=item eod() 207 208Used for END OF DATA bookkeeping. 209 210=item push() 211 212Push the given C<[ match, filterobj ]> pairs at the top of the stack. 213 214=item insert( $idx, @pairs ) 215 216Insert the given C<[ match, filterobj ]> pairs at position C<$idx> 217in the stack. 218 219=item remove( $idx ) 220 221Remove the C<[ match, filterobj ]> pair at position C<$idx> in the stack. 222 223=back 224 225=head1 AUTHOR 226 227Philippe "BooK" Bruhat, E<lt>book@cpan.orgE<gt>. 228 229=head1 COPYRIGHT 230 231Copyright 2002-2013, Philippe Bruhat. 232 233=head1 LICENSE 234 235This module is free software; you can redistribute it or modify it under 236the same terms as Perl itself. 237 238=cut 239 240