line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
############################################################################## |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Package to model a remote client |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Mock::Apache::RemoteClient; |
6
|
|
|
|
|
|
|
|
7
|
5
|
|
|
5
|
|
32
|
use Readonly; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
347
|
|
8
|
5
|
|
|
5
|
|
30
|
use Scalar::Util qw(weaken); |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
272
|
|
9
|
|
|
|
|
|
|
|
10
|
5
|
|
|
5
|
|
36
|
use parent qw(Class::Accessor); |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
30
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Readonly my @PARAMS => qw(mock_apache REMOTE_ADDR REMOTE_HOST REMOTE_USER); |
13
|
|
|
|
|
|
|
Readonly my @ACCESSORS => ( map { lc $_ } @PARAMS ); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
__PACKAGE__->mk_ro_accessors(@ACCESSORS, 'connection'); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub new { |
18
|
4
|
|
|
4
|
1
|
19
|
my ($class, %params) = @_; |
19
|
|
|
|
|
|
|
|
20
|
4
|
|
50
|
|
|
32
|
$params{REMOTE_ADDR} ||= '10.0.0.10'; |
21
|
4
|
|
50
|
|
|
28
|
$params{REMOTE_HOST} ||= 'remote.example.com'; |
22
|
|
|
|
|
|
|
|
23
|
4
|
|
|
|
|
80
|
my $attrs = { map { ( lc $_ => $params{$_} ) } @PARAMS }; |
|
16
|
|
|
|
|
162
|
|
24
|
4
|
|
|
|
|
172
|
my $self = $class->SUPER::new($attrs); |
25
|
|
|
|
|
|
|
|
26
|
4
|
|
|
|
|
78
|
weaken($self->{mock_apache}); |
27
|
|
|
|
|
|
|
|
28
|
4
|
|
33
|
|
|
62
|
$self->{connection} ||= Apache::Connection->new($self); |
29
|
|
|
|
|
|
|
|
30
|
4
|
|
|
|
|
21
|
return $self; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub new_request { |
34
|
4
|
|
|
4
|
0
|
20
|
my $self = shift; |
35
|
|
|
|
|
|
|
|
36
|
4
|
|
|
|
|
34
|
return Apache->_new_request($self, @_); |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
1; |