Version 0.12

[catagits/Catalyst-Plugin-Cache.git] / lib / Catalyst / Plugin / Cache.pm

diff --git a/lib/Catalyst/Plugin/Cache.pm b/lib/Catalyst/Plugin/Cache.pm
index 6301fd7..9ca7680 100644 (file)
--- a/lib/Catalyst/Plugin/Cache.pm
+++ b/lib/Catalyst/Plugin/Cache.pm
@@ -1,22 +1,24 @@
 #!/usr/bin/perl
 
 package Catalyst::Plugin::Cache;
-use base qw(Class::Accessor::Fast Class::Data::Inheritable);
+use Moose;
 
-use strict;
-use warnings;
+with 'Catalyst::ClassData';
 
-our $VERSION = "0.08";
+our $VERSION = "0.12";
 
 use Scalar::Util ();
 use Catalyst::Utils ();
 use Carp ();
 use MRO::Compat;
-
+use Scalar::Util qw/ blessed /;
 use Catalyst::Plugin::Cache::Curried;
 
 __PACKAGE__->mk_classdata( "_cache_backends" );
-__PACKAGE__->mk_accessors( "_default_curried_cache" );
+has _default_curried_cache => (
+    is => 'rw',
+);
+no Moose;
 
 sub setup {
     my $app = shift;
@@ -154,7 +156,7 @@ sub cache {
     if ( @meta == 1 ) {
         my $name = $meta[0];
         return ( $c->get_preset_curried($name) || $c->get_cache_backend($name) );
-    } elsif ( !@meta ) {
+    } elsif ( !@meta && blessed $c ) {
         # be nice and always return the same one for the simplest case
         return ( $c->_default_curried_cache || $c->_default_curried_cache( $c->curry_cache( @meta ) ) );
     } else {
@@ -301,6 +303,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 +408,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