fix the bug in state where it handles expires as an object state.
psgi.streaming is supported in most Plack servers especially
Standalone, so there's no need to depend on AnyEvent in the test.
Added $session->commit now that all write code to the database is
delayed till the finalization phase.
license 'perl';
# prereqs
-requires 'Plack' => '0.9021';
+requires 'Plack' => '0.9028';
requires 'Plack::Request' => '0.09';
# for session ID gen
Plack::Util::load_class(@class)->new();
}
+sub fetch_or_create_session {
+ my($self, $req) = @_;
+ $self->session_class->fetch_or_create($req, $self);
+}
+
sub call {
my $self = shift;
my $env = shift;
- my $session = $self->session_class->fetch_or_create( Plack::Request->new($env), $self );
+ my $session = $self->fetch_or_create_session(Plack::Request->new($env));
$env->{'psgix.session'} = $env->{'plack.session'} = $session;
my $res = $self->app->($env);
$self->response_cb($res, sub {
my $res = Plack::Response->new(@{$_[0]});
- $env->{'psgix.session'}->finalize( $res );
+ $env->{'psgix.session'}->finalize($res);
$res = $res->finalize;
$_[0]->[0] = $res->[0];
$_[0]->[1] = $res->[1];
our $VERSION = '0.03';
our $AUTHORITY = 'cpan:STEVAN';
-use Plack::Util::Accessor qw( id is_new manager );
+use Plack::Util::Accessor qw( id expired _manager );
sub fetch_or_create {
my($class, $request, $manager) = @_;
- my $id = $manager->state->extract($request);
- if ($id) {
- my $store = $manager->store->fetch($id);
- return $class->new( id => $id, _stash => $store, manager => $manager );
+ my($id, $session);
+ if ($id = $manager->state->extract($request) and
+ $session = $manager->store->fetch($id)) {
+ return $class->new( id => $id, _stash => $session, _manager => $manager, _changed => 0 );
} else {
$id = $manager->state->generate($request);
- return $class->new( id => $id, _stash => {}, manager => $manager, is_new => 1 );
+ return $class->new( id => $id, _stash => {}, _manager => $manager, _changed=> 1 );
}
}
sub set {
my ($self, $key, $value) = @_;
+ $self->{_changed}++;
$self->{_stash}{$key} = $value;
}
sub remove {
my ($self, $key) = @_;
+ $self->{_changed}++;
delete $self->{_stash}{$key};
}
sub expire {
my $self = shift;
$self->{_stash} = {};
- $self->manager->store->cleanup( $self->id );
- $self->manager->state->expire_session_id( $self->id );
+ $self->expired(1);
+}
+
+sub commit {
+ my $self = shift;
+
+ if ($self->expired) {
+ $self->_manager->store->cleanup($self->id);
+ } else {
+ $self->_manager->store->store($self->id, $self);
+ }
+
+ $self->{_changed} = 0;
+}
+
+sub is_changed {
+ my $self = shift;
+ $self->{_changed} > 0;
}
sub finalize {
my ($self, $response) = @_;
- $self->manager->store->store( $self->id, $self );
- $self->manager->state->finalize( $self->id, $response );
+
+ $self->commit if $self->is_changed || $self->expired;
+ if ($self->expired) {
+ $self->_manager->state->expire_session_id($self->id, $response);
+ } else {
+ $self->_manager->state->finalize($self->id, $response, $self);
+ }
}
1;
=over 4
+=item B<commit>
+
+This method synchronizes the session data to the data store, without
+waiting for the response final phase.
+
=item B<expire>
-This method can be called to expire the current session id. It
-will call the C<cleanup> method on the C<store> and the C<finalize>
-method on the C<state>, passing both of them the session id and
-the C<$response>.
+This method can be called to expire the current session id. It marks
+the session as expire and call the C<cleanup> method on the C<store>
+and the C<expire_session_id> method on the C<state>.
-=item B<finalize ( $response )>
+=item B<finalize ( $manager, $response )>
-This method should be called at the end of the response cycle. It
-will call the C<store> method on the C<store> and the
-C<expire_session_id> method on the C<state>, passing both of them
-the session id. The C<$response> is expected to be a L<Plack::Response>
-instance or an object with an equivalent interface.
+This method should be called at the end of the response cycle. It will
+call the C<store> method on the C<store> and the C<expire_session_id>
+method on the C<state>. The C<$response> is expected to be a
+L<Plack::Response> instance or an object with an equivalent interface.
=back
sub new {
my ($class, %params) = @_;
- $params{'_expired'} ||= +{};
$params{'session_key'} ||= 'plack_session';
$params{'sid_generator'} ||= sub {
Digest::SHA1::sha1_hex(rand() . $$ . {} . time)
}
sub expire_session_id {
- my ($self, $id) = @_;
- $self->{'_expired'}->{ $id }++;
-}
-
-sub is_session_expired {
- my ($self, $id) = @_;
- exists $self->{'_expired'}->{ $id }
-}
-
-sub check_expired {
- my ($self, $id) = @_;
- return if $self->is_session_expired( $id );
- return $id;
+ my ($self, $id, $response) = @_;
}
sub validate_session_id {
my $id = $self->get_session_id( $request );
return unless defined $id;
- $self->validate_session_id( $id )
- &&
- $self->check_expired( $id );
+ return $id if $self->validate_session_id( $id );
+ return;
}
sub generate {
=over 4
-=item B<expire_session_id ( $id )>
+=item B<expire_session_id ( $id, $response )>
This will mark the session for C<$id> as expired. This method is called
by the L<Plack::Session> C<expire> method.
-=item B<is_session_expired ( $id )>
-
-This will check to see if the session C<$id> has been marked as
-expired.
-
-=item B<check_expired ( $id )>
-
-Given an session C<$id> this will return C<undef> if the session is
-expired or return the C<$id> if it is not.
-
=back
=head1 BUGS
secure
];
-sub expire_session_id {
- my ($self, $id) = @_;
- $self->SUPER::expire_session_id( $id );
- $self->expires( 0 );
-}
-
sub get_session_id {
my ($self, $request) = @_;
( $request->cookie( $self->session_key ) || return )->value;
}
+sub expire_session_id {
+ my ($self, $id, $response) = @_;
+ $response->cookies->{ $self->session_key } = +{
+ value => $id,
+ path => ($self->path || '/'),
+ expires => 0,
+ ( defined $self->domain ? ( domain => $self->domain ) : () ),
+ ( defined $self->secure ? ( secure => $self->secure ) : () ),
+ };
+}
+
sub finalize {
my ($self, $id, $response) = @_;
$response->cookies->{ $self->session_key } = +{
( defined $self->expires ? ( expires => $self->expires ) : () ),
( defined $self->secure ? ( secure => $self->secure ) : () ),
};
-
- # clear the expires after
- # finalization if the session
- # has been expired - SL
- $self->expires( undef )
- if defined $self->expires
- && $self->expires == 0
- && $self->is_session_expired( $id );
}
1;
=item B<fetch ( $session_id )>
-=item B<store ( $session_id, $data )>
+=item B<store ( $session_id, $session )>
=back
sub fetch {
my ($self, $session_id) = @_;
- return $self->_deserialize( $session_id );
+
+ my $file_path = $self->_get_session_file_path( $session_id );
+ return unless -f $file_path;
+
+ $self->deserializer->( $file_path );
}
sub store {
my ($self, $session_id, $session) = @_;
- $self->_serialize( $session_id, $session->dump );
+ my $file_path = $self->_get_session_file_path( $session_id );
+ $self->serializer->( $session->dump, $file_path );
}
sub cleanup {
$self->dir . '/' . $session_id;
}
-sub _serialize {
- my ($self, $session_id, $value) = @_;
- my $file_path = $self->_get_session_file_path( $session_id );
- $self->serializer->( $value, $file_path );
-}
-
-sub _deserialize {
- my ($self, $session_id) = @_;
- my $file_path = $self->_get_session_file_path( $session_id );
- $self->_serialize( $session_id, {} ) unless -f $file_path;
- $self->deserializer->( $file_path );
-}
-
1;
__END__
my $resp = $r->new_response;
lives_ok {
- $s->finalize( $resp );
+ $s->finalize( $m, $resp );
} '... finalized session successfully';
}
use strict;
use Test::More;
-use Test::Requires qw(Plack::Server::AnyEvent);
use Plack::Test;
use Plack::Middleware::Session;
use HTTP::Request::Common;
$Plack::Test::Impl = 'Server';
-$ENV{PLACK_SERVER} = 'AnyEvent';
my $app = sub {
return sub {
projects / catagits/Web-Session.git / commitdiff