From 8786a464b9d3c162f7a7ef4b5429d305c1f43d6f Mon Sep 17 00:00:00 2001 From: Masayoshi Sekimura Date: Thu, 4 Dec 2008 18:29:18 -0800 Subject: [PATCH] first commit --- lib/LWP/UserAgent/WithCache.pm | 113 +++++++++++++++++++++++++++++++++ t/00_compile.t | 4 ++ t/10_request.t | 36 +++++++++++ 3 files changed, 153 insertions(+) create mode 100644 lib/LWP/UserAgent/WithCache.pm create mode 100644 t/00_compile.t create mode 100644 t/10_request.t diff --git a/lib/LWP/UserAgent/WithCache.pm b/lib/LWP/UserAgent/WithCache.pm new file mode 100644 index 0000000..6a01afd --- /dev/null +++ b/lib/LWP/UserAgent/WithCache.pm @@ -0,0 +1,113 @@ +# $Id: WithCache.pm,v 1.4 2005/02/23 11:25:44 sekimura Exp $ + +package LWP::UserAgent::WithCache; +use strict; + +use base qw(LWP::UserAgent); +use Cache::FileCache; + +our $VERSION = '0.06'; + +our $HOME = $ENV{'HOME'} || $ENV{'LOGDIR'}; +our %default_cache_args = ( + 'namespace' => 'lwp-cache', + 'cache_root' => "$HOME/.cache", + 'default_expires_in' => 600 ); + +sub new { + my $class = shift; + my $cache_opt = shift || {}; + my $self = $class->SUPER::new(@_); + my %cache_args = (%default_cache_args, %$cache_opt); + $self->{cache} = Cache::FileCache->new(\%cache_args); + return $self +} + +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); + $self->set_cache($uri, $res) if $res->code eq HTTP::Status::RC_OK; + + return $res; +} + +sub set_cache { + my $self = shift; + my ($uri, $res) = @_; + 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, + }); +} + +1; +__END__ + +=head1 NAME + +LWP::UserAgent::WithCache - LWP::UserAgent extension with local cache + +=head1 SYNOPSIS + + use LWP::UserAgent::WithCache; + my %cache_opt = ( + 'namespace' => 'lwp-cache', + 'cache_root' => "$HOME/.cache", + 'default_expires_in' => 600 ); + my $ua = LWP::UserAgent::WithCache->new(\%cache_opt); + my $response = $ua->get('http://search.cpan.org/'); + +=head1 DESCRIPTION + +LWP::UserAgent::WithCache is a LWP::UserAgent extention. +It handle 'If-Modified-Since' request header with local cache file. +local cache files are implemented by Cache::FileCache. + +=head1 METHODS + +TBD. + +=head1 SEE ALSO + +L, L, L + +=head1 AUTHOR + +Masayoshi Sekimura Esekimura@qootas.orgE + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/t/00_compile.t b/t/00_compile.t new file mode 100644 index 0000000..0e14984 --- /dev/null +++ b/t/00_compile.t @@ -0,0 +1,4 @@ +use strict; +use Test::More tests => 1; + +BEGIN { use_ok 'LWP::UserAgent::WithCache' } diff --git a/t/10_request.t b/t/10_request.t new file mode 100644 index 0000000..3ce0e40 --- /dev/null +++ b/t/10_request.t @@ -0,0 +1,36 @@ +use Test::More qw(no_plan); + +use File::Temp qw/ tempfile tempdir /; +use LWP::UserAgent::WithCache; + +my $tempdir = tempdir( CLEANUP => 1 ); + +my $ua = LWP::UserAgent::WithCache->new({ cache_root => $tempdir }); + +my $res; +$res = HTTP::Response->parse(<<'EOF'); +HTTP/1.1 200 OK +Connection: close +Date: Tue, 09 Oct 2007 06:03:01 GMT +Accept-Ranges: bytes +ETag: "3bf60b-ed-61bb4b40" +Server: Apache +Content-Length: 237 +Content-Type: text/css +Last-Modified: Wed, 03 Oct 2007 00:00:13 GMT +Client-Date: Mon, 08 Oct 2007 12:52:55 GMT +Client-Peer: 59.106.15.125:80 +Client-Response-Num: 1 + +/* This is the StyleCatcher theme addition. Do not remove this block. */ +/* Selected Layout: */ +@import url(base_theme.css); +@import url(http://mt.qootas.org/mt/mt-static/themes/minimalist-red/screen.css); +/* end StyleCatcher imports */ +EOF + +my $uri = 'http://www.example.com/styles.css'; +$ua->set_cache($uri, $res); +$res = $ua->get('http://www.example.com/styles.css'); + +is ($res->code, 200);