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.302';
3 66     66   15329 use strict;
  66         85  
  66         1947  
4 66     66   256 use Carp;
  66         74  
  66         10772  
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 81     81 1 4304 my $class = shift;
16 81         243 my %params = @_;
17              
18             # the front-end
19 81 100       437 if ( $class eq 'HTTP::Proxy::Engine' ) {
20 77         160 my $engine = delete $params{engine};
21 77 100 33     783 $engine = $engines{$^O} || $engines{default}
22             unless defined $engine;
23              
24 77         168 $class = "HTTP::Proxy::Engine::$engine";
25 77         5836 eval "require $class";
26 77 100       513 croak $@ if $@;
27             }
28              
29             # some error checking
30 80 100       633 croak "No proxy defined"
31             unless exists $params{proxy};
32 77 100       1416 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 66     66   306 no strict 'refs';
  66         99  
  66         9037  
37 75         903 return bless {
38 75         122 %{"$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 213     213 1 1262 sub proxy { $_[0]{proxy} }
51              
52             # class method
53             sub make_accessors {
54 131     131 1 263 my $class = shift;
55              
56 131         327 for my $attr (@_) {
57 66     66   293 no strict 'refs';
  66         100  
  66         5666  
58 271         1350 *{"$class\::$attr"} = sub {
59 530 100   530   8721 $_[0]{$attr} = $_[1] if defined $_[1];
60 530         15835 $_[0]{$attr};
61 271         713 };
62             }
63             }
64              
65             1;
66              
67             __END__