line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WWW::CheckGzip; |
2
|
1
|
|
|
1
|
|
493
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
30
|
|
3
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
4
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
5
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
48
|
|
6
|
1
|
|
|
1
|
|
230
|
use Gzip::Faster; |
|
1
|
|
|
|
|
983
|
|
|
1
|
|
|
|
|
58
|
|
7
|
1
|
|
|
1
|
|
399
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
39034
|
|
|
1
|
|
|
|
|
587
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub builtin_test |
10
|
|
|
|
|
|
|
{ |
11
|
0
|
|
|
0
|
0
|
|
my ($ok, $message) = @_; |
12
|
0
|
0
|
|
|
|
|
if ($ok) { |
13
|
0
|
|
|
|
|
|
print "OK - $message.\n"; |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
else { |
16
|
0
|
|
|
|
|
|
print "Not OK - $message.\n"; |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub new |
21
|
|
|
|
|
|
|
{ |
22
|
0
|
|
|
0
|
1
|
|
my ($class, $test) = @_; |
23
|
0
|
|
|
|
|
|
my $o = bless {}; |
24
|
0
|
|
|
|
|
|
$o->{ua} = LWP::UserAgent->new (agent => __PACKAGE__); |
25
|
0
|
0
|
|
|
|
|
if (! $test) { |
26
|
0
|
|
|
|
|
|
$test = \& builtin_test; |
27
|
|
|
|
|
|
|
} |
28
|
0
|
|
|
|
|
|
$o->{test} = $test; |
29
|
0
|
|
|
|
|
|
return $o; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub get_compressed |
33
|
|
|
|
|
|
|
{ |
34
|
0
|
|
|
0
|
0
|
|
my ($o, $url) = @_; |
35
|
0
|
|
|
|
|
|
my $ua = $o->{ua}; |
36
|
0
|
|
|
|
|
|
$ua->default_header ('Accept-Encoding' => 'gzip'); |
37
|
0
|
|
|
|
|
|
my $r = $ua->get ($url); |
38
|
0
|
|
|
|
|
|
return $r; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub get_uncompressed |
42
|
|
|
|
|
|
|
{ |
43
|
0
|
|
|
0
|
0
|
|
my ($o, $url) = @_; |
44
|
0
|
|
|
|
|
|
my $ua = $o->{ua}; |
45
|
0
|
|
|
|
|
|
$ua->default_header ('Accept-Encoding' => ''); |
46
|
0
|
|
|
|
|
|
my $r = $ua->get ($url); |
47
|
0
|
|
|
|
|
|
return $r; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub check |
51
|
|
|
|
|
|
|
{ |
52
|
0
|
|
|
0
|
1
|
|
my ($o, $url) = @_; |
53
|
|
|
|
|
|
|
|
54
|
0
|
0
|
|
|
|
|
if (! $url) { |
55
|
0
|
|
|
|
|
|
carp "No URL supplied"; |
56
|
0
|
|
|
|
|
|
return; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# Test with compressed. |
60
|
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
|
my $r = $o->get_compressed ($url); |
62
|
0
|
|
|
|
|
|
my $get_ok = $r->is_success (); |
63
|
0
|
|
|
|
|
|
& {$o->{test}} (!! $get_ok, "successfully got compressed $url"); |
|
0
|
|
|
|
|
|
|
64
|
0
|
0
|
|
|
|
|
if (! $get_ok) { |
65
|
0
|
|
|
|
|
|
return; |
66
|
|
|
|
|
|
|
} |
67
|
0
|
|
|
|
|
|
my $content_encoding = $r->header ('Content-Encoding'); |
68
|
0
|
|
|
|
|
|
& {$o->{test}} (!! $content_encoding, "got content encoding"); |
|
0
|
|
|
|
|
|
|
69
|
0
|
|
|
|
|
|
& {$o->{test}} ($content_encoding eq 'gzip', "content encoding is gzip"); |
|
0
|
|
|
|
|
|
|
70
|
0
|
|
|
|
|
|
my $text = $r->content (); |
71
|
0
|
|
|
|
|
|
my $unc; |
72
|
0
|
|
|
|
|
|
eval { |
73
|
0
|
|
|
|
|
|
$unc = gunzip ($text); |
74
|
|
|
|
|
|
|
}; |
75
|
0
|
|
|
|
|
|
& {$o->{test}} (! $@, "$url correctly gzipped"); |
|
0
|
|
|
|
|
|
|
76
|
0
|
|
|
|
|
|
& {$o->{test}} (length ($unc) > length ($text), |
|
0
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
"compression made it smaller"); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Test with uncompressed. |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
my $runc = $o->get_uncompressed ($url); |
82
|
0
|
|
|
|
|
|
my $get_ok_unc = $runc->is_success (); |
83
|
0
|
|
|
|
|
|
& {$o->{test}} (!! $get_ok, "successfully got uncompressed $url"); |
|
0
|
|
|
|
|
|
|
84
|
0
|
|
|
|
|
|
my $content_encoding_unc = $runc->header ('Content-Encoding'); |
85
|
0
|
|
|
|
|
|
& {$o->{test}} (! $content_encoding_unc, "Did not get content encoding"); |
|
0
|
|
|
|
|
|
|
86
|
0
|
|
|
|
|
|
my $unctext = $runc->content (); |
87
|
0
|
|
|
|
|
|
eval { |
88
|
0
|
|
|
|
|
|
gunzip ($unctext); |
89
|
|
|
|
|
|
|
}; |
90
|
0
|
|
|
|
|
|
& {$o->{test}} ($@, "$url not gzipped when requesting ungzipped"); |
|
0
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
1; |