Catalyst::Plugin::Cache configuration thingy

diff --git a/lib/Catalyst/Plugin/Cache.pm b/lib/Catalyst/Plugin/Cache.pm
index f8bd7a8..15a73fa 100644 (file)
--- a/lib/Catalyst/Plugin/Cache.pm
+++ b/lib/Catalyst/Plugin/Cache.pm
@@ -7,6 +7,7 @@ use strict;
 use warnings;
 
 use Scalar::Util ();
+use Catalyst::Utils ();
 use Carp ();
 use NEXT;
 
@@ -29,8 +30,75 @@ sub setup {
     $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") and my $default_config = $app->get_default_cache_backend_config) {
+        $app->setup_generic_cache_backend( default => $default_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 ) = @_;
@@ -160,6 +228,26 @@ Catalyst::Plugin::Cache -
 
 =head1 DESCRIPTION
 
+=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 generic "type" of backend. Typically a plugin used to construct backends.
+
+=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
 
 

diff --git a/t/basic.t b/t/basic.t
index d25f69f..8e20614 100644 (file)
--- a/t/basic.t
+++ b/t/basic.t
@@ -11,6 +11,8 @@ use ok "Catalyst::Plugin::Cache";
 {
     package MockApp;
     use base qw/Catalyst::Plugin::Cache/;
+    
+    sub registered_plugins {}
 
     my %config;
     sub config { \%config };

diff --git a/t/config_backend_class.t b/t/config_backend_class.t
new file mode 100644 (file)
index 0000000..d03e76b
--- /dev/null
+++ b/t/config_backend_class.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use ok "Catalyst::Plugin::Cache";
+
+{
+    package MockApp;
+    use base qw/Catalyst::Plugin::Cache/;
+
+    package MyCache;
+    sub new {
+        my ( $class, @p ) = @_;
+        bless \@p, $class;
+    }
+    sub get {}
+    sub set {}
+    sub remove {}
+}
+
+MockApp->_cache_backends({});
+
+MockApp->setup_generic_cache_backend( "foo", {
+    class => "MyCache",
+    param => "foo",
+});
+
+my $registered = MockApp->get_cache_backend( "foo" );
+
+ok( $registered, "registered a backend" );
+
+is_deeply( $registered, MyCache->new( param => "foo" ), "params sent correctly" );
+

diff --git a/t/config_guess_backend.t b/t/config_guess_backend.t
new file mode 100644 (file)
index 0000000..fbddaac
--- /dev/null
+++ b/t/config_guess_backend.t
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+use Test::Exception;
+
+{
+    package ManyStores;
+    use base qw/Catalyst::Plugin::Cache/;
+
+    sub registered_plugins {
+        qw/
+            Bar
+            Cache
+            Cache::Store::Foo
+            Cache::Store::Bar
+            MyApp::Plugin::Cache::Store::Moose
+            Cheese
+        /;
+    }
+
+    package OneStore;
+    use base qw/Catalyst::Plugin::Cache/;
+
+    sub registered_plugins {
+        qw/
+            Aplugin
+            Cache
+            Cache::Store::Foo
+        /
+    }
+
+    package NoStores;
+    use base qw/Catalyst::Plugin::Cache/;
+
+    sub registered_plugins {
+        qw/
+            Bar
+            Cache
+            Lala
+        /
+    }
+}
+
+# store guessing
+
+lives_ok { OneStore->guess_default_cache_store } "can guess if only one plugin";
+is( OneStore->guess_default_cache_store, "Foo", "guess is right" );
+
+dies_ok { ManyStores->guess_default_cache_store } "can't guess if many";
+dies_ok { NoStores->guess_default_cache_store } "can't guess if none";
+
+