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