Browse files

first commit

  • Loading branch information...
0 parents commit 8786a464b9d3c162f7a7ef4b5429d305c1f43d6f @sekimura committed Dec 4, 2008
Showing with 153 additions and 0 deletions.
  1. +113 −0 lib/LWP/UserAgent/WithCache.pm
  2. +4 −0 t/00_compile.t
  3. +36 −0 t/10_request.t
113 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<LWP::UserAgent>, L<Cache::Cache>, L<Cache::FileCache>
+
+=head1 AUTHOR
+
+Masayoshi Sekimura E<lt>sekimura@qootas.orgE<gt>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
4 t/00_compile.t
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'LWP::UserAgent::WithCache' }
36 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);

0 comments on commit 8786a46

Please sign in to comment.