add Store::Cache

diff --git a/lib/Plack/Session/Store/Cache.pm b/lib/Plack/Session/Store/Cache.pm
new file mode 100644 (file)
index 0000000..399c608
--- /dev/null
+++ b/lib/Plack/Session/Store/Cache.pm
@@ -0,0 +1,117 @@
+package Plack::Session::Store::Cache;
+use strict;
+use warnings;
+
+use Scalar::Util qw/blessed/;
+
+use parent 'Plack::Session::Store';
+
+use Plack::Util::Accessor qw[ 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');
+
+    bless { %params } => $class;
+}
+
+sub fetch {
+    my ($self, $session_id, $key) = @_;
+    my $cache = $self->cache->get($session_id);
+    return unless $cache;
+    return $cache->{ $key };
+}
+
+sub store {
+    my ($self, $session_id, $key, $data) = @_;
+    my $cache = $self->cache->get($session_id);
+    if ( !$cache ) {
+        $cache = {$key => $data};
+    }
+    else {
+        $cache->{$key} = $data;
+    }
+    $self->cache->set($session_id => $cache);
+}
+
+sub delete {
+    my ($self, $session_id, $key) = @_;
+    my $cache = $self->cache->get($session_id);
+    return unless exists $cache->{$key};
+
+    delete $cache->{ $key };
+    $self->cache->set($session_id => $cache);
+}
+
+sub cleanup {
+    my ($self, $session_id) = @_;
+    $self->cache->remove($session_id);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Plack::Session::Store::Cache - Cache session store
+
+=head1 SYNOPSIS
+
+  use Plack::Builder;
+  use Plack::Session::Store::Cache;
+  use CHI;
+
+  my $app = sub {
+      return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ];
+  };
+
+  builder {
+      enable 'Session',
+          store => Plack::Session::Store::Cache->new(
+              cache => CHI->new(driver => 'FastMmap')
+          );
+      $app;
+  };
+
+=head1 DESCRIPTION
+
+This will persist session data using the L<Cache> module. This
+offers a lot of flexibility due to the many excellent L<CHI>
+drivers available.
+
+This is a subclass of L<Plack::Session::Store> and implements
+it's full interface.
+
+=head1 METHODS
+
+=over 4
+
+=item B<new ( %params )>
+
+The constructor expects an the I<cache> param to be an
+instance have get, set, and remove method, it will throw an exception
+if that is not the case.
+
+=item B<cache>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Masahiro Chiba
+
+=cut

diff --git a/t/007_basic_w_cache_store.t b/t/007_basic_w_cache_store.t
new file mode 100644 (file)
index 0000000..ebd1f80
--- /dev/null
+++ b/t/007_basic_w_cache_store.t
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Plack::Request;
+use Plack::Session;
+use Plack::Session::State;
+use Plack::Session::Store::Cache;
+
+use t::lib::TestSession;
+
+{
+    package TestCache;
+
+    sub new {
+        bless {} => shift;
+    }
+
+    sub set {
+        my ($self, $key, $val ) = @_;
+
+        $self->{$key} = $val;
+    }
+
+    sub get {
+        my ($self, $key ) = @_;
+
+        $self->{$key};
+    }
+
+    sub remove {
+        my ($self, $key ) = @_;
+
+        delete $self->{$key};
+    }
+}
+
+t::lib::TestSession::run_all_tests(
+    store           => Plack::Session::Store::Cache->new( cache => TestCache->new ),
+    state           => Plack::Session::State->new,
+    request_creator => 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',
+        };
+        my $r = Plack::Request->new( $env );
+        $r->parameters( @_ );
+        $r;
+    },
+);
+
+
+done_testing;