From 793b80443e556f9ab4f2a46cb0cf11d67ce7d6c7 Mon Sep 17 00:00:00 2001
From: Masahiro Chiba <chiba@everqueue.com>
Date: Fri, 5 Oct 2012 23:05:54 +0900
Subject: [PATCH] support get_cache callback

---
 lib/Plack/Session/Store/Cache.pm | 48 ++++++++++++++++++++++++--------
 t/005_basic_w_cache_store.t      | 18 ++++++++++++
 t/005a_basic_w_cache_store.t     | 18 ++++++++++++
 3 files changed, 73 insertions(+), 11 deletions(-)

diff --git a/lib/Plack/Session/Store/Cache.pm b/lib/Plack/Session/Store/Cache.pm
index cdfd4d4..8d3321c 100644
--- a/lib/Plack/Session/Store/Cache.pm
+++ b/lib/Plack/Session/Store/Cache.pm
@@ -9,33 +9,46 @@ use Scalar::Util qw[ blessed ];
 
 use parent 'Plack::Session::Store';
 
-use Plack::Util::Accessor qw[ cache ];
+use Plack::Util::Accessor qw[ cache get_cache ];
 
 sub new {
     my ($class, %params) = @_;
 
-    die('cache require get, set and remove method.')
-        unless blessed $params{cache}
-            && $params{cache}->can('get')
-            && $params{cache}->can('set')
-            && $params{cache}->can('remove');
+    my $cache;
+    if ( $params{get_cache} ) {
+        $cache = $params{get_cache}->();
+    }
+    else {
+        $cache = $params{cache};
+        $params{get_cache} = sub { $params{cache} };
+    }
 
-    bless { %params } => $class;
+    die('cache require get, set and remove method.')
+        unless blessed $cache
+            && $cache->can('get')
+            && $cache->can('set')
+            && $cache->can('remove');
+
+    bless {
+        prefix => '',
+        %params,
+    } => $class;
 }
 
+
 sub fetch {
     my ($self, $session_id ) = @_;
-    $self->cache->get($session_id);
+    $self->get_cache->()->get($session_id);
 }
 
 sub store {
     my ($self, $session_id, $session) = @_;
-    $self->cache->set($session_id => $session);
+    $self->get_cache->()->set($session_id => $session);
 }
 
 sub remove {
     my ($self, $session_id) = @_;
-    $self->cache->remove($session_id);
+    $self->get_cache->()->remove($session_id);
 }
 
 1;
@@ -66,6 +79,15 @@ Plack::Session::Store::Cache - Cache session store
       $app;
   };
 
+# set get_cache callback for ondemand
+  builder {
+      enable 'Session',
+          store => Plack::Session::Store::Cache->new(
+              get_cache => sub { MyAppSingleton->cache }
+          );
+      $app;
+  };
+
 =head1 DESCRIPTION
 
 This will persist session data using any module which implements the
@@ -81,7 +103,7 @@ its full interface.
 
 =item B<new ( %params )>
 
-The constructor expects the I<cache> param to be an object instance
+The constructor expects the I<cache> param or return of I<get_cache> to be an object instance
 which has the I<get>, I<set>, and I<remove> methods, it will throw an
 exception if that is not the case.
 
@@ -89,6 +111,10 @@ exception if that is not the case.
 
 A simple accessor for the cache handle.
 
+=item B<get_cache>
+
+A callback for the cache handle.
+
 =back
 
 =head1 BUGS
diff --git a/t/005_basic_w_cache_store.t b/t/005_basic_w_cache_store.t
index 3cb9b24..cea7397 100755
--- a/t/005_basic_w_cache_store.t
+++ b/t/005_basic_w_cache_store.t
@@ -55,5 +55,23 @@ t::lib::TestSession::run_all_tests(
     },
 );
 
+my $cache = TestCache->new;
+t::lib::TestSession::run_all_tests(
+    store  => Plack::Session::Store::Cache->new( get_cache => sub { $cache } ),
+    state  => Plack::Session::State->new,
+    env_cb => sub {
+        open my $in, '<', \do { my $d };
+        my $env = {
+            'psgi.version'    => [ 1, 0 ],
+            'psgi.input'      => $in,
+            'psgi.errors'     => *STDERR,
+            'psgi.url_scheme' => 'http',
+            SERVER_PORT       => 80,
+            REQUEST_METHOD    => 'GET',
+            QUERY_STRING      => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}},
+        };
+    },
+);
+
 
 done_testing;
diff --git a/t/005a_basic_w_cache_store.t b/t/005a_basic_w_cache_store.t
index 04b9f7c..58db598 100644
--- a/t/005a_basic_w_cache_store.t
+++ b/t/005a_basic_w_cache_store.t
@@ -54,5 +54,23 @@ t::lib::TestSessionHash::run_all_tests(
     },
 );
 
+my $cache = TestCache->new;
+t::lib::TestSessionHash::run_all_tests(
+    store  => Plack::Session::Store::Cache->new( get_cache => sub { $cache } ),
+    state  => Plack::Session::State->new,
+    env_cb => sub {
+        open my $in, '<', \do { my $d };
+        my $env = {
+            'psgi.version'    => [ 1, 0 ],
+            'psgi.input'      => $in,
+            'psgi.errors'     => *STDERR,
+            'psgi.url_scheme' => 'http',
+            SERVER_PORT       => 80,
+            REQUEST_METHOD    => 'GET',
+            QUERY_STRING      => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}},
+        };
+    },
+);
+
 
 done_testing;