File Coverage

blib/lib/HTTP/Proxy/Engine.pm
Criterion Covered Total %
statement 31 34 91.1
branch 12 12 100.0
condition 1 3 33.3
subroutine 8 9 88.8
pod 4 4 100.0
total 56 62 90.3


line stmt bran cond sub pod time code
1             package HTTP::Proxy::Engine;
2             $HTTP::Proxy::Engine::VERSION = '0.304';
3 69     69   16802 use strict;
  69         85  
  69         2480  
4 69     69   312 use Carp;
  69         114  
  69         14730  
5              
6             my %engines = (
7             MSWin32 => 'NoFork',
8             default => 'Legacy',
9             );
10              
11             # required accessors
12             __PACKAGE__->make_accessors( qw( max_clients ));
13              
14             sub new {
15 85     85 1 5600 my $class = shift;
16 85         263 my %params = @_;
17              
18             # the front-end
19 85 100       381 if ( $class eq 'HTTP::Proxy::Engine' ) {
20 81         178 my $engine = delete $params{engine};
21 81 100 33     1280 $engine = $engines{$^O} || $engines{default}
22             unless defined $engine;
23              
24 81         179 $class = "HTTP::Proxy::Engine::$engine";
25 81         8019 eval "require $class";
26 81 100       1484 croak $@ if $@;
27             }
28              
29             # some error checking
30 84 100       1134 croak "No proxy defined"
31             unless exists $params{proxy};
32 81 100       1245 croak "$params{proxy} is not a HTTP::Proxy object"
33             unless UNIVERSAL::isa( $params{proxy}, 'HTTP::Proxy' );
34              
35             # so we are an actual engine
36 69     69   400 no strict 'refs';
  69         88  
  69         10927  
37 79         1338 return bless {
38 79         158 %{"$class\::defaults"},
39             %params
40             }, $class;
41             }
42              
43             # run() should be defined in subclasses
44             sub run {
45 0     0 1 0 my $self = shift;
46 0         0 my $class = ref $self;
47 0         0 croak "$class doesn't define a run() method";
48             }
49              
50 216     216 1 1339 sub proxy { $_[0]{proxy} }
51              
52             # class method
53             sub make_accessors {
54 137     137 1 277 my $class = shift;
55              
56 137         406 for my $attr (@_) {
57 69     69   387 no strict 'refs';
  69         124  
  69         7070  
58 283         1526 *{"$class\::$attr"} = sub {
59 541 100   541   9982 $_[0]{$attr} = $_[1] if defined $_[1];
60 541         3661 $_[0]{$attr};
61 283         835 };
62             }
63             }
64              
65             1;
66              
67             __END__