File Coverage

blib/lib/LWP/UserAgent/Cache/Memcached.pm

Criterion	Covered	Total	%
statement	35	58	60.3
branch	3	20	15.0
condition	1	7	14.2
subroutine	6	8	75.0
pod	2	4	50.0
total	47	97	48.4

package LWP::UserAgent::Cache::Memcached;

use strict;
use warnings;
use base qw(LWP::UserAgent);
use Module::Load;

our $VERSION = '0.02';

our $FAST = 1;
our %default_cache_args = (
	'servers' => [ "127.0.0.1:11211" ],
	'namespace' => 'lwp-cache',
	'exptime' => 0,
);

sub new {
	my $class = shift;
	my $cache_opt = shift || {};
	my $self = $class->SUPER::new(@_);
	my %cache_args = (%default_cache_args, %$cache_opt);
	$self->{lwp_useragent_cache_memcached_config} = {
		exptime => $cache_args{exptime},
	};
	delete $cache_args{exptime};
	$self->{cache} = $self->cacher->new(\%cache_args);
	return $self
}

sub cacher {
	my @cacher = qw/Cache::Memcached::Fast Cache::Memcached/;
	my $cacher;

	if ($FAST) {
		$cacher = $cacher[0];
		eval {load $cacher};
		if ($@) {
			$cacher = $cacher[1];
			eval {load $cacher};
			$FAST = 0;
		}
	}
	else {
		$cacher = $cacher[1];
		eval {load $cacher};
	}

	return $cacher;
}

sub request {
	my $self = shift;
	my @args = @_;
	my $request = $args[0];

	return $self->SUPER::request(@args) if $request->method ne 'GET';

	my $uri = $request->uri->as_string;
	my $cache = $self->{cache};
	my $obj = $cache->get( $uri );

	if ( defined $obj ) {

		unless (defined $obj->{expires} and $obj->{expires} <= time()) {
			return HTTP::Response->parse($obj->{as_string});
		}

		if (defined $obj->{last_modified}) {
			$request->header(
				'If-Modified-Since' => HTTP::Date::time2str($obj->{last_modified})
			);
		}

		if (defined $obj->{etag}) {
			$request->header('If-None-Match' => $obj->{etag});
		}

		$args[0] = $request;
	}

	my $res = $self->SUPER::request(@args);
	my $exptime = int($self->{lwp_useragent_cache_memcached_config}->{exptime} || 0);
	$self->set_cache($uri, $res, $exptime) if $res->code eq HTTP::Status::RC_OK;

	return $res;
}

sub set_cache {
	my $self = shift;
	my ($uri, $res, $exptime) = @_;
	my $cache = $self->{cache};

	$cache->set($uri,{
		content       => $res->content,
		last_modified => $res->last_modified,
		etag          => $res->header('Etag') ? $res->header('Etag') : undef,
		expires       => $res->expires ? $res->expires : undef,
		as_string     => $res->as_string,
	},$exptime);
}

1;
__END__