Cache::Curried

diff --git a/lib/Catalyst/Plugin/Cache.pm b/lib/Catalyst/Plugin/Cache.pm
index 6aebac4..6d1aa97 100644 (file)
--- a/lib/Catalyst/Plugin/Cache.pm
+++ b/lib/Catalyst/Plugin/Cache.pm
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 
 package Catalyst::Plugin::Cache;
-use base qw/Class::Data::Inheritable/;
+use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
 
 use strict;
 use warnings;
@@ -10,7 +10,10 @@ use Scalar::Util ();
 use Carp ();
 use NEXT;
 
+use Catalyst::Plugin::Cache::Curried;
+
 __PACKAGE__->mk_classdata( "_cache_backends" );
+__PACKAGE__->mk_accessors( "_default_curried_cache" );
 
 sub setup {
     my $app = shift;
@@ -26,19 +29,41 @@ sub setup {
     $ret;
 }
 
+# don't die even if we don't have cache backends
 sub setup_cache_backends { shift->NEXT::setup_cache_backends(@_) }
 
 sub cache {
-    my $c = shift;
+    my ( $c, @meta ) = @_;
 
-    if ( @_ ) {
-        my $name = shift;
-        $c->get_cache_backend($name);
+    if ( @meta == 1 ) {
+        my $name = $meta[0];
+        return ( $c->get_preset_curried($name) || $c->get_cache_backend($name) );
+    } elsif ( !@meta ) {
+        # 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 {
-        $c->default_cache_backend;
+        return $c->curry_cache( @meta );
     }
 }
 
+sub curry_cache {
+    my ( $c, @meta ) = @_;
+    return Catalyst::Plugin::Cache::Curried->new( $c, @meta );
+}
+
+sub get_preset_curried {
+    my ( $c, $name ) = @_;
+
+    if ( ref( my $preset = $c->config->{cache}{profiles}{$name} ) ) {
+        return $preset if Scalar::Util::blessed($preset);
+
+        my @meta = ( ( ref $preset eq "HASH" ) ? %$preset : @$preset );
+        return $c->curry_cache( @meta );
+    }
+
+    return;
+}
+
 sub get_cache_backend {
     my ( $c, $name ) = @_;
     $c->_cache_backends->{$name};

diff --git a/lib/Catalyst/Plugin/Cache/Curried.pm b/lib/Catalyst/Plugin/Cache/Curried.pm
new file mode 100644 (file)
index 0000000..a32087e
--- /dev/null
+++ b/lib/Catalyst/Plugin/Cache/Curried.pm
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+package Catalyst::Plugin::Cache::Curried;
+
+use strict;
+use warnings;
+
+use base qw/Class::Accessor::Fast/;
+
+use Scalar::Util ();
+
+__PACKAGE__->mk_accessors(qw/c meta/);
+
+sub new {
+    my ( $class, $c, @meta ) = @_;
+
+    my $self = $class->SUPER::new({
+        c    => $c,
+        meta => \@meta,
+    });
+
+    Scalar::Util::weaken( $self->{c} );
+
+    return $self;
+}
+
+sub backend {
+    my ( $self, $key ) = @_;
+    $self->c->choose_cache_backend( @{ $self->meta }, key => $key )
+}
+
+sub set {
+    my ( $self, $key, $value ) = @_;
+    $self->c->cache_set( $key, $value, @{ $self->meta } );
+}
+
+sub get {
+    my ( $self, $key ) = @_;
+    $self->c->cache_get( $key, @{ $self->meta } );
+}
+
+sub delete {
+    my ( $self, $key ) = @_;
+    $self->c->cache_delete( $key, @{ $self->meta } );
+}
+
+__PACKAGE__;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Plugin::Cache::Curried - Curried versions of C<cache_set>,
+C<cache_get> and C<cache_delete> that look more like a backend.
+
+=head1 SYNOPSIS
+
+       sub begin : Private {
+
+    }
+
+=head1 DESCRIPTION
+
+=cut
+
+

diff --git a/t/basic.t b/t/basic.t
index 89700b2..ac7dab6 100644 (file)
--- a/t/basic.t
+++ b/t/basic.t
@@ -12,6 +12,9 @@ use ok "Catalyst::Plugin::Cache";
     package MockApp;
     use base qw/Catalyst::Plugin::Cache/;
 
+    my %config;
+    sub config { \%config };
+
     package MemoryCache;
     use Storable qw/freeze thaw/;
     
@@ -56,7 +59,6 @@ dies_ok {
 
 
 can_ok( $c, "default_cache_backend" );
-is( $c->default_cache_backend, $c->cache, "cache with no args retrurns default" );
 
 can_ok( $c, "choose_cache_backend_wrapper" );
 can_ok( $c, "choose_cache_backend" );
@@ -81,3 +83,8 @@ $c->cache_set( foo => "gorch", backend => "elk" );
 is( $c->cache_get("foo"), undef, "set to custom backend (get from non custom)" );
 is( $c->cache_get("foo", backend => "elk"), "gorch", "set to custom backend (get from custom)" );
 
+my $cache_elk = $c->cache( backend => "elk" );
+my $cache_norm = $c->cache();
+
+is( $cache_norm->get("foo"), undef, "default curried cache has no foo");
+is( $cache_elk->get("foo"), "gorch", "curried custom backend has foo" );

diff --git a/t/currying_conf.t b/t/currying_conf.t
new file mode 100644 (file)
index 0000000..6fc8be7
--- /dev/null
+++ b/t/currying_conf.t
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use Scalar::Util qw/refaddr/;
+
+use ok "Catalyst::Plugin::Cache";
+
+{
+    package MockApp;
+    use base qw/Catalyst::Plugin::Cache/;
+
+    my %config = (
+        cache => {
+            profiles => {
+                foo => {
+                    bah => "foo",
+                },
+                bar => MemoryCache->new,
+            },
+        },
+    );
+    sub config { \%config };
+
+    package MemoryCache;
+    use Storable qw/freeze thaw/;
+    
+    sub new { bless {}, shift }
+    sub get { ${thaw($_[0]{$_[1]}) || return} };
+    sub set { $_[0]{$_[1]} = freeze(\$_[2]) };
+    sub delete { delete $_[0]{$_[1]} };
+}
+
+MockApp->setup;
+my $c = bless {}, "MockApp";
+
+MockApp->register_cache_backend( default => MemoryCache->new );
+
+can_ok( $c, "curry_cache" );
+can_ok( $c, "get_preset_curried" );
+
+isa_ok( $c->cache, "Catalyst::Plugin::Cache::Curried" );
+
+is( refaddr($c->cache), refaddr($c->cache), "default cache is memoized, so it is ==");
+
+isa_ok( $c->cache("foo"), "Catalyst::Plugin::Cache::Curried", "cache('foo')" );
+
+is_deeply( $c->cache("foo")->meta, [ bah => "foo" ], "meta is in place" ); 
+
+is( refaddr( $c->cache("bar") ), refaddr( $c->cache("bar") ), "since bar is hard coded as an object it's always the same" );
+

diff --git a/t/key_regexes.t b/t/key_regexes.t
index 6cdaf26..c1709f0 100644 (file)
--- a/t/key_regexes.t
+++ b/t/key_regexes.t
@@ -39,26 +39,26 @@ MockApp->register_cache_backend( default => MemoryCache->new );
 MockApp->register_cache_backend( foo_store => MemoryCache->new );
 MockApp->register_cache_backend( bar_store => MemoryCache->new );
 
-is( $c->choose_cache_backend_wrapper( key => "baz" ), $c->cache, "chose default" );
-is( $c->choose_cache_backend_wrapper( key => "foo" ), $c->cache("foo_store"), "chose foo" );
-is( $c->choose_cache_backend_wrapper( key => "bar" ), $c->cache("bar_store"), "chose bar" );
+is( $c->choose_cache_backend_wrapper( key => "baz" ), $c->default_cache_backend, "chose default" );
+is( $c->choose_cache_backend_wrapper( key => "foo" ), $c->get_cache_backend("foo_store"), "chose foo" );
+is( $c->choose_cache_backend_wrapper( key => "bar" ), $c->get_cache_backend("bar_store"), "chose bar" );
 
 $c->cache_set( foo_laa => "laa" );
 $c->cache_set( bar_laa => "laa" );
 $c->cache_set( baz_laa => "laa" );
 
-is( $c->cache->get("baz_laa"), "laa", "non match stored in default" );
-is( $c->cache->get("foo_laa"), undef, "no foo key" );
-is( $c->cache->get("bar_laa"), undef, "no bar key" );
+is( $c->default_cache_backend->get("baz_laa"), "laa", "non match stored in default" );
+is( $c->default_cache_backend->get("foo_laa"), undef, "no foo key" );
+is( $c->default_cache_backend->get("bar_laa"), undef, "no bar key" );
 
 
-is( $c->cache("foo_store")->get("baz_laa"), undef, "no non match in foo store" );
-is( $c->cache("foo_store")->get("foo_laa"), "laa", "has foo key" );
-is( $c->cache("foo_store")->get("bar_laa"), undef, "no bar key" );
+is( $c->get_cache_backend("foo_store")->get("baz_laa"), undef, "no non match in foo store" );
+is( $c->get_cache_backend("foo_store")->get("foo_laa"), "laa", "has foo key" );
+is( $c->get_cache_backend("foo_store")->get("bar_laa"), undef, "no bar key" );
 
 
-is( $c->cache("bar_store")->get("baz_laa"), undef, "no non match in bar store" );
-is( $c->cache("bar_store")->get("foo_laa"), undef, "no foo key" );
-is( $c->cache("bar_store")->get("bar_laa"), "laa", "has bar key" );
+is( $c->get_cache_backend("bar_store")->get("baz_laa"), undef, "no non match in bar store" );
+is( $c->get_cache_backend("bar_store")->get("foo_laa"), undef, "no foo key" );
+is( $c->get_cache_backend("bar_store")->get("bar_laa"), "laa", "has bar key" );