File Coverage

blib/lib/HTTP/Proxy/FilterStack.pm
Criterion Covered Total %
statement 73 74 98.6
branch 16 18 88.8
condition 6 8 75.0
subroutine 12 12 100.0
pod 10 10 100.0
total 117 122 95.9


line stmt bran cond sub pod time code
1             package HTTP::Proxy::FilterStack;
2             $HTTP::Proxy::FilterStack::VERSION = '0.304';
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              
11 69     69   276 use strict;
  69         98  
  69         2251  
12 69     69   283 use Carp;
  69         80  
  69         53411  
13              
14             # new( $isbody )
15             # $isbody is true only for response-body filters stack
16             sub new {
17 250     250 1 630 my $class = shift;
18 250   100     1466 my $self = {
19             body => shift || 0,
20             filters => [],
21             buffers => [],
22             current => undef,
23             };
24 250 100       660 $self->{type} = $self->{body} ? "HTTP::Proxy::BodyFilter"
25             : "HTTP::Proxy::HeaderFilter";
26 250         976 return bless $self, $class;
27             }
28              
29             #
30             # insert( $index, [ $matchsub, $filter ], ...)
31             #
32             sub insert {
33 3     3 1 757 my ( $self, $idx ) = ( shift, shift );
34 3   66     195 $_->[1]->isa( $self->{type} ) or croak("$_ is not a $self->{type}") for @_;
35 1         2 splice @{ $self->{filters} }, $idx, 0, @_;
  1         6  
36             }
37              
38             #
39             # remove( $index )
40             #
41             sub remove {
42 1     1 1 2 my ( $self, $idx ) = @_;
43 1         2 splice @{ $self->{filters} }, $idx, 1;
  1         5  
44             }
45              
46             #
47             # push( [ $matchsub, $filter ], ... )
48             #
49             sub push {
50 158     158 1 513 my $self = shift;
51 158   66     1875 $_->[1]->isa( $self->{type} ) or croak("$_ is not a $self->{type}") for @_;
52 156         224 push @{ $self->{filters} }, @_;
  156         432  
53             }
54              
55 5     5 1 9 sub all { return @{ $_[0]->{filters} }; }
  5         32  
56 83     83 1 435 sub will_modify { return $_[0]->{will_modify}; }
57              
58             #
59             # select the filters that will be used on the message
60             #
61             sub select_filters {
62 311     311 1 9285 my ($self, $message ) = @_;
63              
64             # first time we're called this round
65 311 100       1212 if ( not defined $self->{current} ) {
66              
67             # select the filters that match
68 168         849 $self->{current} =
69 304         543 [ map { $_->[1] } grep { $_->[0]->() } @{ $self->{filters} } ];
  168         1044  
  304         1024  
70              
71             # create the buffers
72 304 100       1157 if ( $self->{body} ) {
73 154         290 $self->{buffers} = [ ( "" ) x @{ $self->{current} } ];
  154         781  
74 154         373 $self->{buffers} = [ \( @{ $self->{buffers} } ) ];
  154         479  
75             }
76              
77             # start the filter if needed (and pass the message)
78 304         476 for ( @{ $self->{current} } ) {
  304         801  
79 168 100       3453 if ( $_->can('begin') ) { $_->begin( $message ); }
  3 50       15  
80             elsif ( $_->can('start') ) {
81 0         0 $_->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 15         53 $self->{will_modify} = $self->{body}
87 304 100       2281 ? grep { $_->will_modify() } @{ $self->{current} }
  154         822  
88             : 0;
89             }
90             }
91              
92             #
93             # the actual filtering is done here
94             #
95             sub filter {
96 294     294 1 3546 my $self = shift;
97              
98             # pass the body data through the filter
99 294 100       960 if ( $self->{body} ) {
100 145         431 my $i = 0;
101 145         283 my ( $data, $message, $protocol ) = @_;
102 145         255 for ( @{ $self->{current} } ) {
  145         629  
103 21         29 $$data = ${ $self->{buffers}[$i] } . $$data;
  21         46  
104 21         23 ${ $self->{buffers}[ $i ] } = "";
  21         35  
105 21         75 $_->filter( $data, $message, $protocol, $self->{buffers}[ $i++ ] );
106             }
107             }
108             else {
109 149         256 $_->filter(@_) for @{ $self->{current} };
  149         1728  
110 149         1980 $self->eod;
111             }
112             }
113              
114             #
115             # filter what remains in the buffers
116             #
117             sub filter_last {
118 75     75 1 464 my $self = shift;
119 75 50       364 return unless $self->{body}; # sanity check
120              
121 75         212 my $i = 0;
122 75         159 my ( $data, $message, $protocol ) = @_;
123 75         140 for ( @{ $self->{current} } ) {
  75         525  
124 5         9 $$data = ${ $self->{buffers}[ $i ] } . $$data;
  5         13  
125 5         5 ${ $self->{buffers}[ $i++ ] } = "";
  5         29  
126 5         16 $_->filter( $data, $message, $protocol, undef );
127             }
128              
129             # call the cleanup routine if needed
130 75 100       584 for ( @{ $self->{current} } ) { $_->end if $_->can('end'); }
  75         272  
  5         22  
131            
132             # clean up the mess for next time
133 75         743 $self->eod;
134             }
135              
136             #
137             # END OF DATA cleanup method
138             #
139             sub eod {
140 300     300 1 875 $_[0]->{buffers} = [];
141 300         1442 $_[0]->{current} = undef;
142             }
143              
144             1;
145              
146             __END__