line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::MobileAgent::Base; |
2
|
|
|
|
|
|
|
|
3
|
8
|
|
|
8
|
|
54
|
use strict; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
257
|
|
4
|
8
|
|
|
8
|
|
40
|
use warnings; |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
210
|
|
5
|
8
|
|
|
8
|
|
79
|
use List::Util 'first'; |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
1665
|
|
6
|
|
|
|
|
|
|
|
7
|
352
|
|
|
352
|
|
594
|
sub _modify_headers { shift; return @_ } |
|
352
|
|
|
|
|
1342
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub env { |
10
|
2106
|
|
|
2106
|
1
|
4279
|
my ($class, $type, %extra_headers) = @_; |
11
|
|
|
|
|
|
|
|
12
|
2106
|
|
|
|
|
2612
|
my $ua; |
13
|
8
|
100
|
100
|
8
|
|
10190
|
if ($type and index($type, '/') >= $[) { |
|
8
|
|
|
|
|
11019
|
|
|
8
|
|
|
|
|
4700
|
|
|
2106
|
|
|
|
|
28374
|
|
14
|
|
|
|
|
|
|
# it looks like a full user agent. |
15
|
2094
|
|
|
|
|
3814
|
$ua = $type; |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
else { |
18
|
|
|
|
|
|
|
# looking for a candidate from the list |
19
|
12
|
|
|
|
|
55
|
my @list = $class->list; |
20
|
12
|
50
|
|
|
|
372
|
$type = qr/\Q$type/ unless ref $type eq 'Regexp'; |
21
|
|
|
|
|
|
|
|
22
|
12
|
|
|
434
|
|
162
|
$ua = first { /$type/i } @list; |
|
434
|
|
|
|
|
771
|
|
23
|
|
|
|
|
|
|
|
24
|
12
|
|
33
|
|
|
228
|
$ua ||= $list[-1]; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
2106
|
|
|
|
|
5250
|
my %headers = $class->_modify_headers( |
28
|
|
|
|
|
|
|
HTTP_USER_AGENT => $ua, |
29
|
|
|
|
|
|
|
_normalize_headers(%extra_headers), |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# remove private headers |
33
|
2106
|
|
|
|
|
5332
|
foreach my $header (keys %headers) { |
34
|
3040
|
100
|
|
|
|
10938
|
delete $headers{$header} if substr($header, 0, 1) eq '_'; |
35
|
|
|
|
|
|
|
} |
36
|
2106
|
|
|
|
|
14070
|
return %headers; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub _normalize_headers { |
40
|
2106
|
|
|
2106
|
|
3824
|
my %headers = @_; |
41
|
|
|
|
|
|
|
|
42
|
2106
|
|
|
|
|
3298
|
my %new_headers; |
43
|
2106
|
|
|
|
|
6844
|
foreach my $header (keys %headers) { |
44
|
32
|
|
|
|
|
60
|
my $new_header = uc $header; |
45
|
32
|
|
|
|
|
53
|
$new_header =~ tr/-/_/; |
46
|
32
|
50
|
|
|
|
91
|
$new_header = "HTTP_$new_header" if $new_header =~ /^X_/; |
47
|
32
|
|
|
|
|
99
|
$new_headers{$new_header} = $headers{$header}; |
48
|
|
|
|
|
|
|
} |
49
|
2106
|
|
|
|
|
11406
|
return %new_headers; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
26
|
100
|
|
26
|
1
|
174
|
sub list { grep { $_ and !/^#/ } split /\n/, (shift->_list) } |
|
4524
|
|
|
|
|
17965
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
1; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
__END__ |