File Coverage

blib/lib/Net/Squid/Purge/UDP.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::UDP;

use strict;
use warnings;

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

use Socket;
use IO::Socket::INET;

Net::Squid::Purge::UDP->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 $s = IO::Socket::INET->new(
            PeerAddr => $squid_host->{'host'},
            PeerPort => $squid_host->{'port'} || 3128,
            Proto    => 'udp',
            Type     => SOCK_DGRAM
        );
        if (! $s) { die 'Could not create socket to host ' . $squid_host->{'host'}; }
        for my $url (@urls) {
        if (! $s->send($self->_format_purge($url))) { die 'Purge request failed'; }
        }
    }
    return 1;
}

sub _format_purge {
    my ($self, $url) = @_;
    if (! $url) { die 'url parameter must be passed'; }
    my $spec = pack(
        'na4na*na8n',
        4, 'NONE', length( $url ), $url,
        8, 'HTTP/1.0', 0
    );
    my $dlen = 8 + 2 + length( $spec );
    my $len = 4 + $dlen + 2;
    return pack( 'nxxnCxNxxa*n', $len, $dlen, 4, rand(), $spec, 2);
}

1;
__END__