[Catalyst-commits] r10967 - in trunk/Catalyst-Plugin-Cache: . lib/Catalyst/Plugin lib/Catalyst/Plugin/Cache t

[bluefeet at dev.catalyst.perl.org]

Author: bluefeet
Date: 2009-07-23 18:08:48 +0000 (Thu, 23 Jul 2009)
New Revision: 10967

Modified:
   trunk/Catalyst-Plugin-Cache/Changes
   trunk/Catalyst-Plugin-Cache/lib/Catalyst/Plugin/Cache.pm
   trunk/Catalyst-Plugin-Cache/lib/Catalyst/Plugin/Cache/Curried.pm
   trunk/Catalyst-Plugin-Cache/t/basic.t
Log:
Support the compute() method, and emulate it if the backend doesnt have it.

Modified: trunk/Catalyst-Plugin-Cache/Changes
===================================================================
--- trunk/Catalyst-Plugin-Cache/Changes	2009-07-23 14:39:57 UTC (rev 10966)
+++ trunk/Catalyst-Plugin-Cache/Changes	2009-07-23 18:08:48 UTC (rev 10967)
@@ -1,5 +1,8 @@
         - Generate a warning if no config is specified, or config
           is specified using the old key.
+        - Support the compute() method, and emulate it if the backend
+          doesn't have it.
+
 0.08
         - Forgot to add MRO::Compat to Makefile.PL, fail.
 

Modified: trunk/Catalyst-Plugin-Cache/lib/Catalyst/Plugin/Cache/Curried.pm
===================================================================
--- trunk/Catalyst-Plugin-Cache/lib/Catalyst/Plugin/Cache/Curried.pm	2009-07-23 14:39:57 UTC (rev 10966)
+++ trunk/Catalyst-Plugin-Cache/lib/Catalyst/Plugin/Cache/Curried.pm	2009-07-23 18:08:48 UTC (rev 10967)
@@ -36,15 +36,21 @@
 }
 
 sub get {
-    my ( $self, $key, @meta ) = @_;
+    my ( $self, $key ) = @_;
     $self->c->cache_get( $key, @{ $self->meta } );
 }
 
 sub remove {
-    my ( $self, $key, @meta ) = @_;
+    my ( $self, $key ) = @_;
     $self->c->cache_remove( $key, @{ $self->meta } );
 }
 
+sub compute {
+    my ($self, $key, $code, @meta) = @_;
+    @meta = ( expires => $meta[0] ) if @meta == 1;
+    $self->c->cache_compute( $key, $code, @{ $self->meta }, @meta );
+}
+
 __PACKAGE__;
 
 __END__
@@ -85,10 +91,12 @@
 
 =item remove $key, %additional_meta
 
-Dellegate to the C<c> object's C<cache_set>, C<cache_get> or C<cache_remove>
-with the arguments, then the captured meta from C<meta>, and then the
-additional meta.
+=item compute $key, $code, %additional_meta
 
+Dellegate to the C<c> object's C<cache_set>, C<cache_get>, C<cache_remove>
+or C<cache_compute> with the arguments, then the captured meta from C<meta>,
+and then the additional meta.
+
 =item meta
 
 Returns the array ref that captured %meta from C<new>.

Modified: trunk/Catalyst-Plugin-Cache/lib/Catalyst/Plugin/Cache.pm
===================================================================
--- trunk/Catalyst-Plugin-Cache/lib/Catalyst/Plugin/Cache.pm	2009-07-23 14:39:57 UTC (rev 10966)
+++ trunk/Catalyst-Plugin-Cache/lib/Catalyst/Plugin/Cache.pm	2009-07-23 18:08:48 UTC (rev 10967)
@@ -301,6 +301,24 @@
     $c->choose_cache_backend_wrapper( key => $key, @meta )->remove( $key );
 }
 
+sub cache_compute {
+    my ($c, $key, $code, %meta) = @_;
+
+    my $backend = $c->choose_cache_backend_wrapper( key =>  $key, %meta );
+    if ($backend->can('compute')) {
+        return $backend->compute( $key, $code, exists $meta{expires} ? $meta{expires} : () );
+    }
+
+    Carp::croak "must specify key and code" unless defined($key) && defined($code);
+
+    my $value = $c->cache_get( $key, %meta );
+    if ( !defined $value ) {
+        $value = $code->();
+        $c->cache_set( $key, $value, %meta );
+    }
+    return $value;
+}
+
 __PACKAGE__;
 
 __END__
@@ -388,9 +406,17 @@
 
 =item cache_remove $key, %meta
 
+=item cache_compute $key, $code, %meta
+
 These cache operations will call L<choose_cache_backend> with %meta, and
-then call C<set>, C<get>, or C<remove> on the resulting backend object.
+then call C<set>, C<get>, C<remove>, or C<compute> on the resulting backend
+object.
 
+If the backend object does not support C<compute> then we emulate it by
+calling L<cache_get>, and if the returned value is undefined we call the passed
+code reference, stores the returned value with L<cache_set>, and then returns
+the value.  Inspired by L<CHI>.
+
 =item choose_cache_backend %meta
 
 Select a backend object. This should return undef if no specific backend

Modified: trunk/Catalyst-Plugin-Cache/t/basic.t
===================================================================
--- trunk/Catalyst-Plugin-Cache/t/basic.t	2009-07-23 14:39:57 UTC (rev 10966)
+++ trunk/Catalyst-Plugin-Cache/t/basic.t	2009-07-23 18:08:48 UTC (rev 10967)
@@ -93,3 +93,12 @@
 
 is( $cache_norm->get("foo"), undef, "default curried cache has no foo");
 is( $cache_elk->get("foo"), "gorch", "curried custom backend has foo" );
+
+
+is( $c->cache->get('compute_test'), undef, 'compute_test key is undef by default' );
+is( $c->cache->compute('compute_test',sub{'monkey'}), 'monkey', 'compute returned code value' );
+is( $c->cache->get('compute_test'), 'monkey', 'compute_test key is now set' );
+is( $c->cache->compute('compute_test',sub{'donkey'}), 'monkey', 'compute returned cached value' );
+$c->cache->remove('compute_test');
+is( $c->cache->compute('compute_test',sub{'donkey'}), 'donkey', 'compute returned second code value' );
+