File Coverage

blib/lib/HTTP/Proxy/BodyFilter/simple.pm
Criterion Covered Total %
statement 34 34 100.0
branch 12 12 100.0
condition 3 3 100.0
subroutine 11 11 100.0
pod 6 6 100.0
total 66 66 100.0


line stmt bran cond sub pod time code
1             package HTTP::Proxy::BodyFilter::simple;
2             $HTTP::Proxy::BodyFilter::simple::VERSION = '0.303';
3 7     7   14521 use strict;
  7         12  
  7         161  
4 7     7   21 use Carp;
  7         6  
  7         264  
5 7     7   1115 use HTTP::Proxy::BodyFilter;
  7         10  
  7         119  
6 7     7   24 use vars qw( @ISA );
  7         7  
  7         1875  
7             @ISA = qw( HTTP::Proxy::BodyFilter );
8              
9             my $methods = join '|', qw( begin filter end will_modify );
10             $methods = qr/^(?:$methods)$/;
11              
12             sub init {
13 17     17 1 19 my $self = shift;
14              
15 17 100       190 croak "Constructor called without argument" unless @_;
16              
17 16         55 $self->{_will_modify} = 1;
18              
19 16 100       40 if ( @_ == 1 ) {
20 7 100       133 croak "Single parameter must be a CODE reference"
21             unless ref $_[0] eq 'CODE';
22 6         15 $self->{_filter} = $_[0];
23             }
24             else {
25 9     1   34 $self->{_filter} = sub { }; # default
  1         1  
26 9         20 while (@_) {
27 14         30 my ( $name, $code ) = splice @_, 0, 2;
28              
29             # basic error checking
30 14 100 100     164 croak "Parameter to $name must be a CODE reference"
31             if $name ne 'will_modify' && ref $code ne 'CODE';
32 13 100       153 croak "Unkown method $name"
33             unless $name =~ $methods;
34              
35 12         46 $self->{"_$name"} = $code;
36             }
37             }
38             }
39              
40             # transparently call the actual methods
41 1     1 1 1 sub begin { goto &{ $_[0]{_begin} }; }
  1         8  
42 14     14 1 687 sub filter { goto &{ $_[0]{_filter} }; }
  14         57  
43 1     1 1 2 sub end { goto &{ $_[0]{_end} }; }
  1         5  
44              
45 7     7 1 28 sub will_modify { return $_[0]{_will_modify} }
46              
47             sub can {
48 31     31 1 56 my ( $self, $method ) = @_;
49 31 100       348 return $method =~ $methods
50             ? $self->{"_$method"}
51             : UNIVERSAL::can( $self, $method );
52             }
53              
54             1;
55              
56             __END__