File Coverage

blib/lib/HTTP/Proxy/HeaderFilter/simple.pm
Criterion Covered Total %
statement 21 32 65.6
branch 7 12 58.3
condition n/a
subroutine 7 10 70.0
pod 5 5 100.0
total 40 59 67.8


line stmt bran cond sub pod time code
1             package HTTP::Proxy::HeaderFilter::simple;
2             $HTTP::Proxy::HeaderFilter::simple::VERSION = '0.304';
3 15     15   28426 use strict;
  15         27  
  15         553  
4 15     15   67 use Carp;
  15         15  
  15         858  
5 15     15   424 use HTTP::Proxy::HeaderFilter;
  15         15  
  15         280  
6 15     15   47 use vars qw( @ISA );
  15         14  
  15         4668  
7             @ISA = qw( HTTP::Proxy::HeaderFilter );
8              
9             my $methods = join '|', qw( begin filter end );
10             $methods = qr/^(?:$methods)$/;
11              
12             sub init {
13 9     9 1 27 my $self = shift;
14              
15 9 100       292 croak "Constructor called without argument" unless @_;
16 8 50       38 if ( @_ == 1 ) {
17 8 100       136 croak "Single parameter must be a CODE reference"
18             unless ref $_[0] eq 'CODE';
19 7         78 $self->{_filter} = $_[0];
20             }
21             else {
22 0     0   0 $self->{_filter} = sub { }; # default
  0         0  
23 0         0 while (@_) {
24 0         0 my ( $name, $code ) = splice @_, 0, 2;
25              
26             # basic error checking
27 0 0       0 croak "Parameter to $name must be a CODE reference"
28             unless ref $code eq 'CODE';
29 0 0       0 croak "Unkown method $name" unless $name =~ $methods;
30              
31 0         0 $self->{"_$name"} = $code;
32             }
33             }
34             }
35              
36             # transparently call the actual methods
37 0     0 1 0 sub begin { goto &{ $_[0]{_begin} }; }
  0         0  
38 4     4 1 134 sub filter { goto &{ $_[0]{_filter} }; }
  4         53  
39 0     0 1 0 sub end { goto &{ $_[0]{_end} }; }
  0         0  
40              
41             sub can {
42 15     15 1 50 my ( $self, $method ) = @_;
43 15 100       353 return $method =~ $methods
44             ? $self->{"_$method"}
45             : UNIVERSAL::can( $self, $method );
46             }
47              
48             1;
49              
50             __END__