File Coverage

blib/lib/Net/Squid/Purge/HTTP.pm

Criterion	Covered	Total	%
statement	15	34	44.1
branch	0	8	0.0
condition	0	2	0.0
subroutine	5	7	71.4
pod	1	1	100.0
total	21	52	40.3

package Net::Squid::Purge::HTTP;

use strict;
use warnings;

use base qw(Net::Squid::Purge);

use Net::HTTP;
use HTTP::Status;

Net::Squid::Purge::HTTP->mk_accessors(qw(squid_servers));

our $VERSION = '0.1';

sub purge {
    my ($self, @urls) = @_;
    if (! $self->squid_servers) { die 'squid_servers must be set!'; }
    for my $squid_host (@{$self->squid_hosts}) {
        my $squid_host = Net::HTTP->new(
            Host => $squid_host->{'host'},
            PeerPort => $squid_host->{'port'} || 3128,
            Timeout => 2,
            KeepAlive => 1,
        );
        if (! $squid_host) { warn "Could not connect to squid host $squid_host->{'host'}"; next; }
        for my $url (@urls) {
            $squid_host->write_request($self->_format_purge($url));
            my ($status, $message) = $squid_host->read_response_headers;
            if (! is_success($status)) { warn "Purge request failed: $message"; }
        }
    }
    return 1;
}

sub _format_purge {
    my ($self, $url) = @_;
    if (! $url) { die 'url parameter must be passed'; }
    return ('PURGE', $url, 'Accept', '*/*');
}

1;
__END__