File Coverage

blib/lib/WWW/CheckGzip.pm

Criterion	Covered	Total	%
statement	15	71	21.1
branch	0	8	0.0
condition			n/a
subroutine	5	11	45.4
pod	2	6	33.3
total	22	96	22.9

package WWW::CheckGzip;
use warnings;
use strict;
our $VERSION = '0.05';
use Carp;
use Gzip::Faster;
use HTTP::Tiny;

sub builtin_test
{
    my ($ok, $message) = @_;
    if ($ok) {
	print "OK - $message.\n";
    }
    else {
	print "Not OK - $message.\n";
    }
}

sub new
{
    my ($class, $test) = @_;
    my $o = bless {};
    $o->{ua} = HTTP::Tiny->new (agent => __PACKAGE__);
    if (! $test) {
	$test = \& builtin_test;
    }
    $o->{test} = $test;
    return $o;
}

sub get_compressed
{
    my ($o, $url) = @_;
    my $ua = $o->{ua};
    my $r = $ua->get ($url, {headers => {'Accept-Encoding' => 'gzip'}});
    return $r;
}

sub get_uncompressed
{
    my ($o, $url) = @_;
    my $ua = $o->{ua};
    my $r = $ua->get ($url, {headers => {'Accept-Encoding' => ''}});
    return $r;
}

# Private

sub getce
{
    my ($r) = @_;
    return $r->{headers}{'content-encoding'};
}

sub check
{
    my ($o, $url) = @_;

    if (! $url) {
	carp "No URL supplied";
	return;
    }

    # Test with compressed.

    my $r = $o->get_compressed ($url);
    my $get_ok = $r->{success};
    & {$o->{test}} (!! $get_ok, "successfully got compressed $url");
    if (! $get_ok) {
	return;
    }

    my $content_encoding = getce ($r);
    & {$o->{test}} (!! $content_encoding, "got content encoding");
    & {$o->{test}} ($content_encoding eq 'gzip', "content encoding is gzip");
    my $text = $r->{content};
    my $unc;
    eval {
	$unc = gunzip ($text);
    };
    & {$o->{test}} (! $@, "$url correctly gzipped");
    & {$o->{test}} (length ($unc) > length ($text),
		     "compression made it smaller");

    # Test with uncompressed.

    my $runc = $o->get_uncompressed ($url);
    my $get_ok_unc = $runc->{success};
    & {$o->{test}} ($get_ok_unc, "successfully got uncompressed $url");
    my $content_encoding_unc = getce ($runc);
    & {$o->{test}} (! $content_encoding_unc, "Did not get content encoding");
    my $unctext = $runc->{content};
    eval {
	gunzip ($unctext);
    };
    & {$o->{test}} ($@, "$url not gzipped when requesting ungzipped");
}

1;