Version 0.12
[catagits/Catalyst-Plugin-Cache.git] / lib / Catalyst / Plugin / Cache.pm
index ed606c5..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.05";
+our $VERSION = "0.12";
 
 use Scalar::Util ();
 use Catalyst::Utils ();
 use Carp ();
-use NEXT;
-
+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;
@@ -25,43 +27,73 @@ sub setup {
     # and don't overwrite if some plugin was wicked
     $app->_cache_backends({}) unless $app->_cache_backends;
 
-    my $ret = $app->NEXT::setup( @_ );
+    my $ret = $app->maybe::next::method( @_ );
 
     $app->setup_cache_backends;
 
     $ret;
 }
+{
+    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 {
     my ( $app, $name ) = @_;
-    $app->config->{cache}{backend} || $app->get_cache_backend_config("default");
+    $app->_get_cache_plugin_config->{backend} || $app->get_cache_backend_config("default");
 }
 
 sub get_cache_backend_config {
     my ( $app, $name ) = @_;
-    $app->config->{cache}{backends}{$name};
+    $app->_get_cache_plugin_config->{backends}{$name};
 }
 
 sub setup_cache_backends {
     my $app = shift;
 
     # give plugins a chance to find things for themselves
-    $app->NEXT::setup_cache_backends;
+    $app->maybe::next::method;
 
-    foreach my $name ( keys %{ $app->config->{cache}{backends} } ) {
+    # FIXME - Don't know why the _get_cache_plugin_config method doesn't work here!
+    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 ) || {} );
     }
 
     if ( !$app->get_cache_backend("default") ) {
-        local $@;
-        eval { $app->setup_generic_cache_backend( default => $app->get_default_cache_backend_config || {} ) };
+        ### XXX currently we dont have a fallback scenario
+        ### so die here with the error message. Once we have
+        ### an in memory fallback, we may consider silently
+        ### logging the error and falling back to that.
+        ### If we dont die here, the app will silently start
+        ### up and then explode at the first cache->get or
+        ### cache->set request with a FIXME error
+        #local $@;
+        #eval { 
+        $app->setup_generic_cache_backend( default => $app->get_default_cache_backend_config || {} );
+        #};
+        
    }
 }
 
 sub default_cache_store {
     my $app = shift;
-    $app->config->{cache}{default_store} || $app->guess_default_cache_store;
+    $app->_get_cache_plugin_config->{default_store} || $app->guess_default_cache_store;
 }
 
 sub guess_default_cache_store {
@@ -81,11 +113,22 @@ sub setup_generic_cache_backend {
     my %config = %$config;
 
     if ( my $class = delete $config{class} ) {
-        eval { $app->setup_cache_backend_by_class( $name, $class, %config ) }
-            ||
-        eval { $app->setup_cache_backend_by_class( $name, $class, \%config ) }
-            ||
-        die "Couldn't construct $class with either list style or hash ref style param passing: $@";
+        
+        ### try as list and as hashref, collect the
+        ### error if things go wrong
+        ### if all goes well, exit the loop
+        my @errors;
+        for my $aref ( [%config], [\%config] ) {
+            eval { $app->setup_cache_backend_by_class( 
+                        $name, $class, @$aref 
+                    );
+            } ? do { @errors = (); last }
+              : push @errors, "\t$@";
+        }
+        
+        ### and die with the errors if we have any
+        die "Couldn't construct $class with either list style or hash ref style param passing:\n @errors" if @errors;
+        
     } elsif ( my $store = delete $config->{store} || $app->default_cache_store ) {
         my $method = lc("setup_${store}_cache_backend");
 
@@ -113,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 {
@@ -128,7 +171,7 @@ sub construct_curried_cache {
 
 sub curried_cache_class {
     my ( $c, @meta ) = @_;
-    $c->config->{cache}{curried_class} || "Catalyst::Plugin::Cache::Curried";
+    $c->_get_cache_plugin_config->{curried_class} || "Catalyst::Plugin::Cache::Curried";
 }
 
 sub curry_cache {
@@ -139,7 +182,7 @@ sub curry_cache {
 sub get_preset_curried {
     my ( $c, $name ) = @_;
 
-    if ( ref( my $preset = $c->config->{cache}{profiles}{$name} ) ) {
+    if ( ref( my $preset = $c->_get_cache_plugin_config->{profiles}{$name} ) ) {
         return $preset if Scalar::Util::blessed($preset);
 
         my @meta = ( ( ref $preset eq "HASH" ) ? %$preset : @$preset );
@@ -242,7 +285,7 @@ sub choose_cache_backend_wrapper {
     return $c->default_cache_backend;
 }
 
-sub choose_cache_backend { shift->NEXT::choose_cache_backend( @_ ) } # a convenient fallback
+sub choose_cache_backend { shift->maybe::next::method( @_ ) } # a convenient fallback
 
 sub cache_set {
     my ( $c, $key, $value, %meta ) = @_;
@@ -260,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__
@@ -277,11 +338,19 @@ Catalyst::Plugin::Cache - Flexible caching support for Catalyst.
     /;
 
     # configure a backend or use a store plugin 
-    __PACKAGE__->config->{cache}{backend} = {
+    __PACKAGE__->config->{'Plugin::Cache'}{backend} = {
         class => "Cache::Bounded",
-        # ... params ...
+        # ... params for Cache::Bounded...
+    };
+
+    # typical example for Cache::Memcached::libmemcached
+    __PACKAGE__->config->{'Plugin::Cache'}{backend} = {
+        class   => "Cache::Memcached::libmemcached",
+        servers => ['127.0.0.1:11211'],
+        debug   => 2,
     };
 
+
     # In a controller:
 
     sub foo : Local {
@@ -339,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
 
@@ -465,12 +542,12 @@ See L<Catalyst::Plugin::Cache::Curried> for details.
 
 =head1 CONFIGURATION
 
-    $c->config->{cache} = {
+    $c->config->{'Plugin::Cache'} = {
         ...
     };
 
 All configuration parameters should be provided in a hash reference
-under the C<cache> key in the C<config> hash.
+under the C<Plugin::Cache> key in the C<config> hash.
 
 =head2 Backend Configuration
 
@@ -486,13 +563,13 @@ of the main config is assumed to be the backend named C<default>.
 
 Instantiate a backend from a L<Cache> compatible class. E.g.
 
-    $c->config->{cache}{backends}{small_things} = {
+    $c->config->{'Plugin::Cache'}{backends}{small_things} = {
         class    => "Cache::Bounded",
         interval => 1000,
         size     => 10000,
     };
     
-    $c->config->{cache}{backends}{large_things} = {
+    $c->config->{'Plugin::Cache'}{backends}{large_things} = {
         class => "Cache::Memcached",
         data  => '1.2.3.4:1234',
     };
@@ -505,7 +582,7 @@ The class will be C<required> as necessary during setup time.
 
 Instantiate a backend using a store plugin, e.g.
 
-    $c->config->{cache}{backend} = {
+    $c->config->{'Plugin::Cache'}{backend} = {
         store => "FastMmap",
     };
 
@@ -530,7 +607,7 @@ C<cache> method.
 
 For example when you specify
 
-    $c->config->{cache}{profiles}{thumbnails} = {
+    $c->config->{'Plugin::Cache'}{profiles}{thumbnails} = {
         backend => "large_things",
     };
 
@@ -611,6 +688,8 @@ name mangler so that every controller gets its own keyspace.
 
 Yuval Kogman, C<nothingmuch@woobling.org>
 
+Jos Boumans, C<kane@cpan.org>
+
 =head1 COPYRIGHT & LICENSE
 
 Copyright (c) Yuval Kogman, 2006. All rights reserved.