Support the compute() method, and emulate it if the backend doesnt have it.
[catagits/Catalyst-Plugin-Cache.git] / lib / Catalyst / Plugin / Cache.pm
index c4cc4ae..cf0e373 100644 (file)
@@ -1,15 +1,17 @@
 #!/usr/bin/perl
 
 package Catalyst::Plugin::Cache;
-use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
+use base qw(Class::Accessor::Fast Class::Data::Inheritable);
 
 use strict;
 use warnings;
 
+our $VERSION = "0.08";
+
 use Scalar::Util ();
 use Catalyst::Utils ();
 use Carp ();
-use NEXT;
+use MRO::Compat;
 
 use Catalyst::Plugin::Cache::Curried;
 
@@ -23,43 +25,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 {
@@ -79,7 +111,22 @@ sub setup_generic_cache_backend {
     my %config = %$config;
 
     if ( my $class = delete $config{class} ) {
-        $app->setup_cache_backend_by_class( $name, $class, %config );
+        
+        ### 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");
 
@@ -87,7 +134,7 @@ sub setup_generic_cache_backend {
         "Please consult the Catalyst::Plugin::Cache documentation on how to configure hetrogeneous stores."
             unless $app->can($method);
 
-        $app->$method( $name, %config );
+        $app->$method( $name, \%config );
     } else {
         $app->log->warn("Couldn't setup the cache backend named '$name'");
     }
@@ -122,7 +169,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 {
@@ -133,7 +180,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 );
@@ -206,7 +253,7 @@ sub _cache_caller_meta {
 sub choose_cache_backend_wrapper {
     my ( $c, @meta ) = @_;
 
-    Carp::croak("meta data must be an even sized list") unless @meta % 2 == 0;
+    Carp::croak("metadata must be an even sized list") unless @meta % 2 == 0;
 
     my %meta = @meta;
 
@@ -236,11 +283,12 @@ 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 ) = @_;
-    $c->choose_cache_backend_wrapper( key =>  $key, value => $value, @meta )->set( $key, $value );
+    my ( $c, $key, $value, %meta ) = @_;
+    $c->choose_cache_backend_wrapper( key =>  $key, value => $value, %meta )
+        ->set( $key, $value, exists $meta{expires} ? $meta{expires} : () );
 }
 
 sub cache_get {
@@ -253,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__
@@ -270,12 +336,20 @@ 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...
     };
 
-    # ... in a controller
+    # 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 {
         my ( $self, $c, $id ) = @_;
@@ -285,19 +359,20 @@ Catalyst::Plugin::Cache - Flexible caching support for Catalyst.
         my $result;
 
         unless ( $result = $cache->get( $id ) ) {
-            # ... calulate result ...
+            # ... calculate result ...
             $c->cache->set( $id, $result );
         }
     };
 
 =head1 DESCRIPTION
 
-This plugin allows you to use a very simple configuration API without losing
-the possibility of flexibility when you need it later.
+This plugin gives you access to a variety of systems for caching
+data. It allows you to use a very simple configuration API, while
+maintaining the possibility of flexibility when you need it later.
 
-Amongst it's features are support for multiple backends, segmentation based on
-component or controller, keyspace partitioning and so forth, in various sub
-plugins.
+Among its features are support for multiple backends, segmentation based
+on component or controller, keyspace partitioning, and so more, in
+various subsidiary plugins.
 
 =head1 METHODS
 
@@ -307,23 +382,23 @@ plugins.
 
 =item cache %meta
 
-Return a curried object with meta data from $profile_name or as explicitly
-specified.
+Return a curried object with metadata from C<$profile_name> or as
+explicitly specified.
 
-If a profile by the name $profile_name doesn't exist but a backend object by
-that name does exist, the backend will be returned instead, since the interface
-for curried caches and backends is almost identical.
+If a profile by the name C<$profile_name> doesn't exist, but a backend
+object by that name does exist, the backend will be returned instead,
+since the interface for curried caches and backends is almost identical.
 
-This method can also be called without arguments, in which case is treated as
-though the %meta hash was empty.
+This method can also be called without arguments, in which case is
+treated as though the C<%meta> hash was empty.
 
-See L</META DATA> for details.
+See L</METADATA> for details.
 
 =item curry_cache %meta
 
-Return a L<Catalyst::Plugin::Cache::Curried> object, curried with %meta.
+Return a L<Catalyst::Plugin::Cache::Curried> object, curried with C<%meta>.
 
-See L</META DATA> for details.
+See L</METADATA> for details.
 
 =item cache_set $key, $value, %meta
 
@@ -331,13 +406,22 @@ See L</META DATA> for details.
 
 =item cache_remove $key, %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.
+=item cache_compute $key, $code, %meta
+
+These cache operations will call L<choose_cache_backend> with %meta, and
+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 was
-selected - it's caller will handle getting C<default_cache_backend> on it's own.
+Select a backend object. This should return undef if no specific backend
+was selected - its caller will handle getting C<default_cache_backend>
+on its own.
 
 This method is typically used by plugins.
 
@@ -351,38 +435,39 @@ Return the default backend object.
 
 =item temporary_cache_backend
 
-When no default cache backend is configured this method might return a backend
-known to work well with the current L<Catalyst::Engine>. This is a stup.
+When no default cache backend is configured this method might return a
+backend known to work well with the current L<Catalyst::Engine>. This is
+a stub.
 
 =item 
 
 =back
 
-=head1 META DATA
+=head1 METADATA
 
 =head2 Introduction
 
-Whenever you set or retrieve a key you may specify additional meta data that
-will be used to select a specific backend.
+Whenever you set or retrieve a key you may specify additional metadata
+that will be used to select a specific backend.
 
 This metadata is very freeform, and the only key that has any meaning by
 default is the C<backend> key which can be used to explicitly choose a backend
 by name.
 
-The C<choose_cache_backend> method can be overridden in order to facilitate
-more intelligent backend selection. For example,
-L<Catalyst::Plugin::Cache::Choose::KeyRegexes> overrides that method to select
-a backend based on key regexes.
+The C<choose_cache_backend> method can be overridden in order to
+facilitate more intelligent backend selection. For example,
+L<Catalyst::Plugin::Cache::Choose::KeyRegexes> overrides that method to
+select a backend based on key regexes.
 
-Another example is a L<Catalyst::Plugin::Cache::ControllerNamespacing>, which
-that wraps backends in objects that perform key mangling, in order to keep
-caches namespaced per controller.
+Another example is a L<Catalyst::Plugin::Cache::ControllerNamespacing>,
+which wraps backends in objects that perform key mangling, in order to
+keep caches namespaced per controller.
 
 However, this is generally left as a hook for larger, more complex
-applications. Most configurations should make due 
+applications. Most configurations should make due XXXX
 
-The simplest way to dynamically select a backend is based on the L</Cache
-Profiles> configuratrion.
+The simplest way to dynamically select a backend is based on the
+L</Cache Profiles> configuration.
 
 =head2 Meta Data Keys
 
@@ -392,11 +477,11 @@ C<choose_cache_backend> is called with some default keys.
 
 =item key
 
-Supplied by C<cache_get>, C<cache_set> and C<cache_remove>.
+Supplied by C<cache_get>, C<cache_set>, and C<cache_remove>.
 
 =item value
 
-Supplied by C<cache_set>
+Supplied by C<cache_set>.
 
 =item caller
 
@@ -409,7 +494,8 @@ The entire C<caller($i)> frame of C<caller>.
 
 =item component
 
-The package name of the innermost caller who C<isa> L<Catalyst::Component>.
+The package name of the innermost caller who C<isa>
+L<Catalyst::Component>.
 
 =item component_frame
 
@@ -417,7 +503,8 @@ This entire C<caller($i)> frame of C<component>.
 
 =item controller
 
-The package name of the innermost caller who C<isa> L<Catalyst::Controller>.
+The package name of the innermost caller who C<isa>
+L<Catalyst::Controller>.
 
 =item controller_frame
 
@@ -425,13 +512,13 @@ This entire C<caller($i)> frame of C<controller>.
 
 =back
 
-=head2 Meta Data Currying
+=head2 Metadata Currying
 
-In order to avoid specifying %meta over and over again you may call C<cache> or
-C<curry_cache> with %meta once, and get back a B<curried cache object>. This
-object responds to the methods C<get>, C<set> and C<remove>, by appending it's
-captured meta data and delegating them to C<cache_get>, C<cache_set> and
-C<cache_remove>.
+In order to avoid specifying C<%meta> over and over again you may call
+C<cache> or C<curry_cache> with C<%meta> once, and get back a B<curried
+cache object>. This object responds to the methods C<get>, C<set>, and
+C<remove>, by appending its captured metadata and delegating them to
+C<cache_get>, C<cache_set>, and C<cache_remove>.
 
 This is simpler than it sounds.
 
@@ -453,20 +540,20 @@ 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.
+All configuration parameters should be provided in a hash reference
+under the C<Plugin::Cache> key in the C<config> hash.
 
 =head2 Backend Configuration
 
 Configuring backend objects is done by adding hash entries under the
-C<backends> keys in the main config.
+C<backends> key in the main config.
 
-A special case is that the hash key under the C<backend> (singular) key of the
-main config is assumed to be the backend named C<default>.
+A special case is that the hash key under the C<backend> (singular) key
+of the main config is assumed to be the backend named C<default>.
 
 =over 4
 
@@ -474,14 +561,14 @@ 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} = {
-        class => "Cache::Memcached::Mangaed",
+    $c->config->{'Plugin::Cache'}{backends}{large_things} = {
+        class => "Cache::Memcached",
         data  => '1.2.3.4:1234',
     };
 
@@ -491,17 +578,17 @@ The class will be C<required> as necessary during setup time.
 
 =item store
 
-Instrantiate a backend using a store plugin, e.g.
+Instantiate a backend using a store plugin, e.g.
 
-    $c->config->{cache}{backend} = {
+    $c->config->{'Plugin::Cache'}{backend} = {
         store => "FastMmap",
     };
 
-Store plugins typically require less configuration because they are specialized
-for L<Catalyst> applications. For example
+Store plugins typically require less configuration because they are
+specialized for L<Catalyst> applications. For example
 L<Catalyst::Plugin::Cache::Store::FastMmap> will specify a default
-C<share_file>, and additionally use a subclass of L<Cache::FastMmap> that can
-also store non reference data.
+C<share_file>, and additionally use a subclass of L<Cache::FastMmap>
+that can also store non reference data.
 
 The store plugin must be loaded.
 
@@ -513,12 +600,12 @@ The store plugin must be loaded.
 
 =item profiles
 
-Supply your own predefined profiles for cache metadata, when using the C<cache>
-method.
+Supply your own predefined profiles for cache metadata, when using the
+C<cache> method.
 
 For example when you specify
 
-    $c->config->{cache}{profiles}{thumbnails} = {
+    $c->config->{'Plugin::Cache'}{profiles}{thumbnails} = {
         backend => "large_things",
     };
 
@@ -532,15 +619,15 @@ It is the same as if you had done:
 
 =back
 
-=head2 Misc Configuration
+=head2 Miscellaneous Configuration
 
 =over 4
 
 =item default_store
 
-When you do not specify a C<store> parameter in the backend configuration this
-one will be used instead. This configuration parameter is not necessary if only
-one store plugin is loaded.
+When you do not specify a C<store> parameter in the backend
+configuration this one will be used instead. This configuration
+parameter is not necessary if only one store plugin is loaded.
 
 =back
 
@@ -555,31 +642,58 @@ L<Catalyst::Plugin::Cache::Backend> (or more).
 
 =item store
 
-A plugin that provides backends of a certain type. This is a bit like a factory.
+A plugin that provides backends of a certain type. This is a bit like a
+factory.
 
 =item cache
 
 Stored key/value pairs of data for easy re-access.
 
-=item meta data
+=item metadata
 
-"extra" information about the item being stored, which can be used to locate an
-appropriate backend.
+"Extra" information about the item being stored, which can be used to
+locate an appropriate backend.
 
 =item curried cache
 
   my $cache = $c->cache(type => 'thumbnails');
   $cache->set('pic01', $thumbnaildata);
 
-A cache which has been pre-configured with a particular set of namespacing
-data. In the example the cache returned could be one specifically tuned
-for storing thumbnails.
+A cache which has been pre-configured with a particular set of
+namespacing data. In the example the cache returned could be one
+specifically tuned for storing thumbnails.
 
-An object that responds to C<get>, C<set> and C<remove>, and will automatically
-add meta data to calls to C<< $c->cache_get >>, etc.
+An object that responds to C<get>, C<set>, and C<remove>, and will
+automatically add metadata to calls to C<< $c->cache_get >>, etc.
 
 =back
 
-=cut
+=head1 SEE ALSO
+
+L<Cache> - the generic cache API on CPAN.
+
+L<Catalyst::Plugin::Cache::Store> - how to write a store plugin.
+
+L<Catalyst::Plugin::Cache::Curried> - the interface for curried caches.
+
+L<Catalyst::Plugin::Cache::Choose::KeyRegexes> - choose a backend based on
+regex matching on the keys. Can be used to partition the keyspace.
+
+L<Catalyst::Plugin::Cache::ControllerNamespacing> - wrap backend objects in a
+name mangler so that every controller gets its own keyspace.
 
+=head1 AUTHOR
+
+Yuval Kogman, C<nothingmuch@woobling.org>
+
+Jos Boumans, C<kane@cpan.org>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) Yuval Kogman, 2006. All rights reserved.
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself, as well as under the terms of the MIT license.
+
+=cut