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