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.304';
3 7     7   21349 use strict;
  7         15  
  7         231  
4 7     7   28 use Carp;
  7         8  
  7         395  
5 7     7   1403 use HTTP::Proxy::BodyFilter;
  7         12  
  7         155  
6 7     7   28 use vars qw( @ISA );
  7         8  
  7         2493  
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 22 my $self = shift;
14              
15 17 100       266 croak "Constructor called without argument" unless @_;
16              
17 16         56 $self->{_will_modify} = 1;
18              
19 16 100       36 if ( @_ == 1 ) {
20 7 100       123 croak "Single parameter must be a CODE reference"
21             unless ref $_[0] eq 'CODE';
22 6         19 $self->{_filter} = $_[0];
23             }
24             else {
25 9     1   36 $self->{_filter} = sub { }; # default
  1         1  
26 9         23 while (@_) {
27 14         24 my ( $name, $code ) = splice @_, 0, 2;
28              
29             # basic error checking
30 14 100 100     198 croak "Parameter to $name must be a CODE reference"
31             if $name ne 'will_modify' && ref $code ne 'CODE';
32 13 100       196 croak "Unkown method $name"
33             unless $name =~ $methods;
34              
35 12         54 $self->{"_$name"} = $code;
36             }
37             }
38             }
39              
40             # transparently call the actual methods
41 1     1 1 1 sub begin { goto &{ $_[0]{_begin} }; }
  1         13  
42 14     14 1 570 sub filter { goto &{ $_[0]{_filter} }; }
  14         71  
43 1     1 1 1 sub end { goto &{ $_[0]{_end} }; }
  1         3  
44              
45 7     7 1 35 sub will_modify { return $_[0]{_will_modify} }
46              
47             sub can {
48 31     31 1 56 my ( $self, $method ) = @_;
49 31 100       399 return $method =~ $methods
50             ? $self->{"_$method"}
51             : UNIVERSAL::can( $self, $method );
52             }
53              
54             1;
55              
56             __END__