use warnings;
use Scalar::Util ();
+use Catalyst::Utils ();
use Carp ();
use NEXT;
$ret;
}
-# don't die even if we don't have cache backends
-sub setup_cache_backends { shift->NEXT::setup_cache_backends(@_) }
+sub get_default_cache_backend_config {
+ my ( $app, $name ) = @_;
+ $app->config->{cache}{backend} || $app->get_cache_backend_config("default");
+}
+
+sub get_cache_backend_config {
+ my ( $app, $name ) = @_;
+ $app->config->{cache}{backends}{$name};
+}
+
+sub setup_cache_backends {
+ my $app = shift;
+
+ # give plugins a chance to find things for themselves
+ $app->NEXT::setup_cache_backends;
+
+ foreach my $name ( keys %{ $app->config->{cache}{backends} } ) {
+ 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 || {} ) };
+ }
+}
+
+sub default_cache_store {
+ my $app = shift;
+ $app->config->{cache}{default_store} || $app->guess_default_cache_store;
+}
+
+sub guess_default_cache_store {
+ my $app = shift;
+
+ my @stores = map { /Cache::Store::(.*)$/ ? $1 : () } $app->registered_plugins;
+
+ if ( @stores == 1 ) {
+ return $stores[0];
+ } else {
+ Carp::croak "You must configure a default store type unless you use exactly one store plugin.";
+ }
+}
+
+sub setup_generic_cache_backend {
+ my ( $app, $name, $config ) = @_;
+ my %config = %$config;
+
+ if ( my $class = delete $config{class} ) {
+ $app->setup_cache_backend_by_class( $name, $class, %config );
+ } elsif ( my $store = delete $config->{store} || $app->default_cache_store ) {
+ my $method = lc("setup_${store}_cache_backend");
+
+ Carp::croak "You must load the $store cache store plugin (if it exists). ".
+ "Please consult the Catalyst::Plugin::Cache documentation on how to configure hetrogeneous stores."
+ unless $app->can($method);
+
+ $app->$method( $name, %config );
+ } else {
+ $app->log->warn("Couldn't setup the cache backend named '$name'");
+ }
+}
+
+sub setup_cache_backend_by_class {
+ my ( $app, $name, $class, @args ) = @_;
+ Catalyst::Utils::ensure_class_loaded( $class );
+ $app->register_cache_backend( $name => $class->new( @args ) );
+}
+
+# end of spaghetti setup DWIM
sub cache {
my ( $c, @meta ) = @_;
}
}
+sub construct_curried_cache {
+ my ( $c, @meta ) = @_;
+ return $c->curried_cache_class( @meta )->new( @meta );
+}
+
+sub curried_cache_class {
+ my ( $c, @meta ) = @_;
+ $c->config->{cache}{curried_class} || "Catalyst::Plugin::Cache::Curried";
+}
+
sub curry_cache {
my ( $c, @meta ) = @_;
- return Catalyst::Plugin::Cache::Curried->new( $c, @meta );
+ return $c->construct_curried_cache( $c, $c->_cache_caller_meta, @meta );
}
sub get_preset_curried {
no warnings 'uninitialized';
Carp::croak("$backend does not look like a cache backend - "
- . "it must be an object supporting get, set and delete")
- unless eval { $backend->can("get") && $backend->can("set") && $backend->can("delete") };
+ . "it must be an object supporting get, set and remove")
+ unless eval { $backend->can("get") && $backend->can("set") && $backend->can("remove") };
$c->_cache_backends->{$name} = $backend;
}
die "FIXME - make up an in memory cache backend, that hopefully works well for the current engine";
}
+sub _cache_caller_meta {
+ my $c = shift;
+
+ my ( $caller, $component, $controller );
+
+ for my $i ( 0 .. 15 ) { # don't look to far
+ my @info = caller(2 + $i) or last;
+
+ $caller ||= \@info unless $info[0] =~ /Catalyst::Plugin::Cache/;
+ $component ||= \@info if $info[0]->isa("Catalyst::Component");
+ $controller ||= \@info if $info[0]->isa("Catalyst::Controller");
+
+ last if $caller && $component && $controller;
+ }
+
+ return (
+ 'caller' => $caller,
+ component => $component,
+ controller => $controller,
+ );
+}
+
# this gets a shit name so that the plugins can override a good name
sub choose_cache_backend_wrapper {
my ( $c, @meta ) = @_;
Carp::croak("meta data must be an even sized list") unless @meta % 2 == 0;
my %meta = @meta;
+
+ unless ( exists $meta{'caller'} ) {
+ my %caller = $c->_cache_caller_meta;
+ @meta{keys %caller} = values %caller;
+ }
# allow the cache client to specify who it wants to cache with (but loeave room for a hook)
if ( exists $meta{backend} ) {
}
};
-
- $meta{caller} = [ caller(2) ] unless exists $meta{caller}; # might be interesting
-
if ( my $chosen = $c->choose_cache_backend( %meta ) ) {
$chosen = $c->get_cache_backend( $chosen ) unless Scalar::Util::blessed($chosen); # if it's a name find it
return $chosen if Scalar::Util::blessed($chosen); # only return if it was an object or name lookup worked
$c->choose_cache_backend_wrapper( key => $key, @meta )->get( $key );
}
-sub cache_delete {
+sub cache_remove {
my ( $c, $key, @meta ) = @_;
- $c->choose_cache_backend_wrapper( key => $key, @meta )->delete( $key );
+ $c->choose_cache_backend_wrapper( key => $key, @meta )->remove( $key );
}
__PACKAGE__;
=head1 SYNOPSIS
- use Catalyst::Plugin::Cache;
+ use Catalyst qw/
+ Cache
+ /;
+
+ # configure a backend or use a store plugin
+ __PACKAGE__->config( cache => {
+ backend => {
+ class => "Cache::Bounded",
+ # ... params ...
+ },
+ });
+
+ # ... in a controller
+
+ sub foo : Local {
+ my ( $self, $c, $id ) = @_;
+
+ my $cache = $c->cache;
+
+ my $result;
+
+ unless ( $result = $cache->get( $id ) ) {
+ # ... calulate 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.
+
+Amongst it's features are support for multiple backends, segmentation based on
+component or controller, keyspace partitioning and so forth, in various sub
+plugins.
+
+=head1 TERMINOLIGY
+
+=over 4
+
+=item backend
+
+An object that responds to the methods detailed in
+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.
+
+=item curried cache
+
+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.
+
+=back
+
=cut