Version 0.12
[catagits/Catalyst-Plugin-Cache.git] / lib / Catalyst / Plugin / Cache.pm
index 959c480..9ca7680 100644 (file)
@@ -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;
@@ -31,10 +33,23 @@ sub setup {
 
     $ret;
 }
-
-sub _get_cache_plugin_config {
-    my ($app) = @_;
-    return $app->config->{'Plugin::Cache'} || $app->config->{cache};
+{
+    my %has_warned_for;
+    sub _get_cache_plugin_config {
+        my ($app) = @_;
+        my $config = $app->config->{'Plugin::Cache'};
+        if (!$config) {
+            $config = $app->config->{cache};
+            my $appname = ref($app);
+            if (! $has_warned_for{$appname}++ ) {
+                $app->log->warn($config ?
+                    'Catalyst::Plugin::Cache config found in deprecated $c->config->{cache}, please move to $c->config->{"Plugin::Cache"}.'
+                    : 'Catalyst::Plugin::Cache config not found, using empty config!'
+                );
+            }
+        }
+        return $config || {};
+    }
 }
 
 sub get_default_cache_backend_config {
@@ -54,7 +69,7 @@ sub setup_cache_backends {
     $app->maybe::next::method;
 
     # FIXME - Don't know why the _get_cache_plugin_config method doesn't work here!
-    my $conf = $app->config->{'Plugin::Cache'} ? $app->config->{'Plugin::Cache'}->{backends} : $app->config->{cache}->{backends};
+    my $conf = $app->_get_cache_plugin_config->{backends};
     foreach my $name ( keys %$conf ) {
         next if $app->get_cache_backend( $name );
         $app->setup_generic_cache_backend( $name, $app->get_cache_backend_config( $name ) || {} );
@@ -141,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 {
@@ -288,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__
@@ -375,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