File Coverage

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

Criterion	Covered	Total	%
statement	12	26	46.1
branch	0	8	0.0
condition			n/a
subroutine	4	6	66.6
pod	1	1	100.0
total	17	41	41.4

package Net::Squid::Purge::Multicast;

use warnings;
use strict;

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

use IO::Socket::Multicast;

Net::Squid::Purge::Multicast->mk_accessors(qw(multicast_group multicast_port));

our $VERSION = '0.1';

sub purge {
	my ($self, @urls) = @_;
    if (! $self->multicast_group) { die 'multicast_group must be set!'; }
    if (! $self->multicast_port) { die 'multicast_port must be set!'; }

	my $socket = IO::Socket::Multicast->new( Proto => 'icp', LocalPort => $self->multicast_port);
    if (! $socket->mcast_add($self->multicast_group)) {
        die "Couldn't set group: $!\n";
    }
    for my $url (@urls) {
        if (! $socket->mcast_send($self->_format_request($url))) { warn 'purge request failed'; }
	}
	return 1;
}

sub _format_purge {
	my ($self, $url) = @_;
	return <<"EOF";
	PURGE $url HTTP/1.0
	Accept: */*

EOF
}

1;
__END__