Support the compute() method, and emulate it if the backend doesnt have it.

diff --git a/Changes b/Changes
index 4ccc0d3..3251d1e 100644 (file)
--- a/Changes
+++ b/Changes
@@ -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.
 

diff --git a/lib/Catalyst/Plugin/Cache.pm b/lib/Catalyst/Plugin/Cache.pm
index 6301fd7..cf0e373 100644 (file)
--- a/lib/Catalyst/Plugin/Cache.pm
+++ b/lib/Catalyst/Plugin/Cache.pm
@@ -301,6 +301,24 @@ sub cache_remove {
     $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,8 +406,16 @@ See L</METADATA> for details.
 
 =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
 

diff --git a/lib/Catalyst/Plugin/Cache/Curried.pm b/lib/Catalyst/Plugin/Cache/Curried.pm
index 1021f2e..bbe57d5 100644 (file)
--- a/lib/Catalyst/Plugin/Cache/Curried.pm
+++ b/lib/Catalyst/Plugin/Cache/Curried.pm
@@ -36,15 +36,21 @@ sub set {
 }
 
 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,9 +91,11 @@ the additional meta.
 
 =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
 

diff --git a/t/basic.t b/t/basic.t
index a356a94..1ea8e7e 100644 (file)
--- a/t/basic.t
+++ b/t/basic.t
@@ -93,3 +93,12 @@ my $cache_norm = $c->cache();
 
 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' );
+