--- /dev/null
+package Plack::Session;
+use strict;
+use warnings;
+
+use Plack::Util::Accessor qw[
+ id
+ store
+ state
+];
+
+sub new {
+ my ($class, %params) = @_;
+ bless {
+ id => $params{ state }->get_session_id( $params{ request } ),
+ state => $params{ state },
+ store => $params{ store },
+ } => $class;
+}
+
+## Data Managment
+
+sub get {
+ my ($self, $key) = @_;
+ $self->store->fetch( $self->id, $key )
+}
+
+sub set {
+ my ($self, $key, $value) = @_;
+ $self->store->store( $self->id, $key, $value );
+}
+
+sub remove {
+ my ($self, $key) = @_;
+ $self->store->delete( $self->id, $key );
+}
+
+## Lifecycle Management
+
+sub expire {
+ my $self = shift;
+ $self->store->cleanup( $self->id );
+ $self->state->expire_session_id( $self->id );
+}
+
+sub finalize {
+ my $self = shift;
+ $self->store->persist( $self->id )
+}
+
+1;
\ No newline at end of file
--- /dev/null
+package Plack::Session::State;
+use strict;
+use warnings;
+
+use Plack::Util::Accessor qw[
+ generator
+ extractor
+ session_key
+];
+
+sub new {
+ my ($class, %params) = @_;
+ bless {
+ session_key => $params{ session_key } || 'plack_session',
+ generator => do { my $id = 1; sub { $id++ } },
+ extractor => sub { $_[0]->param( $_[1] ) },
+ expired => {}
+ } => $class;
+}
+
+sub expire_session_id {
+ my ($self, $id) = @_;
+ $self->{expired}->{ $id }++;
+}
+
+sub extract {
+ my ($self, $request) = @_;
+ my $id = $self->extractor->( $request, $self->session_key );
+ return unless $id && not exists $self->{expired}->{ $id };
+ return $id;
+}
+
+sub generate {
+ my $self = shift;
+ $self->generator->()
+}
+
+# given a request, get the
+# session id from it
+sub get_session_id {
+ my ($self, $request) = @_;
+ $self->extract( $request )
+ ||
+ $self->generate
+}
+
+1;
\ No newline at end of file
--- /dev/null
+package Plack::Session::Store;
+use strict;
+use warnings;
+
+use Plack::Util::Accessor qw[ _stash ];
+
+sub new { bless { _stash => {} } => shift }
+
+sub fetch {
+ my ($self, $session_id, $key) = @_;
+ $self->_stash->{ $session_id }->{ $key }
+}
+
+sub store {
+ my ($self, $session_id, $key, $data) = @_;
+ $self->_stash->{ $session_id }->{ $key } = $data;
+}
+
+sub delete {
+ my ($self, $session_id, $key) = @_;
+ delete $self->_stash->{ $session_id }->{ $key };
+}
+
+sub persist {
+ my ($self, $session_id) = @_;
+ ()
+}
+
+sub cleanup {
+ my ($self, $session_id) = @_;
+ delete $self->_stash->{ $session_id }
+}
+
+1;
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use Plack::Request;
+
+use Plack::Session;
+use Plack::Session::State;
+use Plack::Session::Store;
+
+sub request {
+ 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;
+}
+
+my $storage = Plack::Session::Store->new;
+my $state = Plack::Session::State->new;
+
+{
+ my $s = Plack::Session->new(
+ state => $state,
+ store => $storage,
+ request => request(),
+ );
+
+ is($s->id, 1, '... got a basic session id (1)');
+
+ ok(!$s->get('foo'), '... no value stored in foo for session (1)');
+
+ lives_ok {
+ $s->set( foo => 'bar' );
+ } '... set the value successfully in session (1)';
+
+ is($s->get('foo'), 'bar', '... got the foo value back successfully from session (1)');
+
+ lives_ok {
+ $s->finalize;
+ } '... finalized session (1) successfully';
+}
+
+{
+ my $s = Plack::Session->new(
+ state => $state,
+ store => $storage,
+ request => request(),
+ );
+
+ is($s->id, 2, '... got a basic session id (2)');
+
+ ok(!$s->get('foo'), '... no value stored for foo in session (2)');
+
+ lives_ok {
+ $s->set( foo => 'baz' );
+ } '... set the value successfully';
+
+ is($s->get('foo'), 'baz', '... got the foo value back successfully from session (2)');
+
+ lives_ok {
+ $s->finalize;
+ } '... finalized session (2) successfully';
+}
+
+{
+ my $s = Plack::Session->new(
+ state => $state,
+ store => $storage,
+ request => request({ plack_session => 1 }),
+ );
+
+ is($s->id, 1, '... got a basic session id (1)');
+
+ is($s->get('foo'), 'bar', '... got the value for foo back successfully from session (1)');
+
+ lives_ok {
+ $s->remove( 'foo' );
+ } '... removed the foo value successfully from session (1)';
+
+ ok(!$s->get('foo'), '... no value stored for foo in session (1)');
+
+ lives_ok {
+ $s->finalize;
+ } '... finalized session (1) successfully';
+}
+
+
+{
+ my $s = Plack::Session->new(
+ state => $state,
+ store => $storage,
+ request => request({ plack_session => 2 }),
+ );
+
+ is($s->id, 2, '... got a basic session id (2)');
+
+ is($s->get('foo'), 'baz', '... got the foo value back successfully from session (2)');
+
+ lives_ok {
+ $s->finalize;
+ } '... finalized session (2) successfully';
+}
+
+{
+ my $s = Plack::Session->new(
+ state => $state,
+ store => $storage,
+ request => request({ plack_session => 1 }),
+ );
+
+ is($s->id, 1, '... got a basic session id (1)');
+
+ ok(!$s->get('foo'), '... no value stored for foo in session (1)');
+
+ lives_ok {
+ $s->set( bar => 'baz' );
+ } '... set the bar value successfully in session (1)';
+
+ lives_ok {
+ $s->finalize;
+ } '... finalized session (1) successfully';
+}
+
+{
+ my $s = Plack::Session->new(
+ state => $state,
+ store => $storage,
+ request => request({ plack_session => 1 }),
+ );
+
+ is($s->id, 1, '... got a basic session id (1)');
+
+ is($s->get('bar'), 'baz', '... got the bar value back successfully from session (1)');
+
+ lives_ok {
+ $s->expire;
+ } '... expired session (1) successfully';
+}
+
+{
+ my $s = Plack::Session->new(
+ state => $state,
+ store => $storage,
+ request => request({ plack_session => 1 }),
+ );
+
+ is($s->id, 3, '... got a new session id (3)');
+
+ ok(!$s->get('bar'), '... no bar value stored (from session (1)) in session (3)');
+}
+
+{
+ my $s = Plack::Session->new(
+ state => $state,
+ store => $storage,
+ request => request({ plack_session => 2 }),
+ );
+
+ is($s->id, 2, '... got a basic session id (2)');
+
+ is($s->get('foo'), 'baz', '... got the foo value back successfully from session (2)');
+
+ lives_ok {
+ $s->finalize;
+ } '... finalized session (2) successfully';
+}
+
+done_testing;
\ No newline at end of file