Changeset 9694 for lang/perl/WebService-Simple/branch/lwp-base

Timestamp:

04/18/08 19:00:39 (8 months ago)

Author:

daisuke

Message:

lang/perl/WebService-Simple; Add caching

Location:

lang/perl/WebService-Simple/branch/lwp-base

Files:

• Makefile.PL (modified) (1 diff)
• lib/WebService/Simple.pm (modified) (7 diffs)
• t/01_basic.t (modified) (3 diffs)

lang/perl/WebService-Simple/branch/lwp-base/Makefile.PL

@@ -7 +7 @@
 requires( 'Class::Data::ConfigHash' );
 requires( 'Data::Dumper' );
+requires( 'Digest::MD5' );
 requires( 'LWP::UserAgent' );
-requires( 'Storable' );
 requires( 'UNIVERSAL::require' );
 requires( 'XML::Simple' );

lang/perl/WebService-Simple/branch/lwp-base/lib/WebService/Simple.pm

@@ -5 +5 @@
 use warnings;
 use base qw(LWP::UserAgent Class::Data::ConfigHash);
+use Data::Dumper ();
+use Digest::MD5 ();
 use WebService::Simple::Response;
 use UNIVERSAL::require;
@@ -12 +14 @@
 __PACKAGE__->config(
     base_url => '',
+    cache => {
+        module => "Cache::FileCache",
+        args   => {
+        }
+    },
     response_parser => {
         module => "XML::Simple"
@@ -24 +31 @@
         $class->config->{base_url} ||
         Carp::croak("base_url is required");
-    my $basic_params = delete $args{params} || {};
+    my $basic_params = delete $args{params} || delete $args{param} || {};
     my $response_parser = delete $args{response_parser};
     if (! $response_parser) {
@@ -38 +45 @@
         $response_parser = $module->new( %{ $config->{args} || {} } );
     };
-    die if $@;
+
+    my $cache = delete $args{cache};
+    if (! $cache || ref $cache eq 'HASH') {
+        my $config = ref $cache eq 'HASH' ? $cache : $class->config->{cache};
+        if ($config) {
+            if (! ref $config) {
+                $config = { module => $config };
+            }
+
+            my $module = $config->{module};
+            $module->require or die;
+            $cache = $module->new( $config->{hashref_args} ? $config->{args} : %{ $config->{args} } );
+        }
+    }
 
     my $self = $class->SUPER::new(%args);
@@ -44 +64 @@
     $self->{basic_params} = $basic_params;
     $self->{response_parser} = $response_parser;
+    $self->{cache} = $cache;
     return $self;
 }
@@ -50 +71 @@
 sub basic_params { $_[0]->{basic_params} }
 sub response_parser { $_[0]->{response_parser} }
+sub cache { $_[0]->{cache} }
+
+sub __cache_get
+{
+    my $self  = shift;
+    my $cache = $self->cache;
+    return unless $cache;
+
+    my $key   = $self->__cache_key( shift );
+    return $cache->get( $key, @_ );
+}
+
+sub __cache_set
+{
+    my $self  = shift;
+    my $cache = $self->cache;
+    return unless $cache;
+
+    my $key   = $self->__cache_key( shift );
+    return $cache->set( $key, @_ );
+}
+
+sub __cache_remove
+{
+    my $self  = shift;
+    my $cache = $self->cache;
+    return unless $cache;
+
+    my $key   = $self->__cache_key( shift );
+    return $cache->remove( $key, @_ );
+}
+
+sub __cache_key
+{
+    my $self  = shift;
+    local $Data::Dumper::Indent   = 1;
+    local $Data::Dumper::Terse    = 1;
+    local $Data::Dumper::Sortkeys = 1;
+    return Digest::MD5::md5_hex( Data::Dumper::Dumper( $_[0] ) );
+}
 
 sub get
@@ -72 +133 @@
 
     $uri->query_form( %{$self->basic_params}, %extra );
-    my $response = $self->SUPER::get($uri, @headers);
+
+    my $response;
+
+    $response = $self->__cache_get([$uri, @headers]);
+    if ($response) {
+        return $response;
+    }
+
+    $response = $self->SUPER::get($uri, @headers);
     if (! $response->is_success) {
         Carp::croak("request to $url failed");
     }
 
-    return WebService::Simple::Response->new_from_response(
+    $response = WebService::Simple::Response->new_from_response(
         response => $response,
         parser   => $self->response_parser
     );
+    $self->__cache_set([$uri, @headers], $response);
+    return $response;
+
 }
 

lang/perl/WebService-Simple/branch/lwp-base/t/01_basic.t

@@ -1 +1 @@
 use strict;
 use Test::More;
+use Test::MockObject;
 
 my ($flickr_api_key);
@@ -9 +10 @@
         plan( skip_all => "Please set FLICKR_API_KEY to enable this test" );
     } else {
-        plan( tests => 10 );
+        plan( tests => 13 );
     }
 
@@ -38 +39 @@
 
     is( $h->{name}, 'value' );
+
+    # Make sure the response is NOT cached by default
+    {
+        my $tmp = $simple->get( { method => "flickr.test.echo", name => "value" } );
+        isnt( $tmp, $response, "response is NOT cached ($response <=> $tmp)" );
+    }
 }
+
+SKIP: {
+    eval { require Cache::Memory };
+    if ($@) {
+        skip(2, "Cache::Memory not installed");
+    }
+
+    my $called = 0;
+    my $simple = WebService::Simple->new(
+        base_url => "http://api.flickr.com/services/rest/",
+        params   => {
+            api_key => $flickr_api_key
+        },
+        cache => {
+            module => 'Cache::Memory',
+        }
+    );
+
+    my $response;
+    for (1..3) {
+        my $tmp = $simple->get( { method => "flickr.test.echo", name => "value" } );
+        if ($response) {
+            is( $tmp, $response, "got cached $response" );
+        } else {
+            $response = $tmp;
+        }
+    }
+}