lib/Plack/Session/State.pm

   1 package Plack::Session::State;
   2 use strict;
   3 use warnings;
   4
   5 use Digest::SHA1 ();
   6
   7 use Plack::Util::Accessor qw[
   8     session_key
   9     sid_generator
  10 ];
  11
  12 sub new {
  13     my ($class, %params) = @_;
  14
  15     $params{'_expired'}      ||= +{};
  16     $params{'session_key'}   ||= 'plack_session';
  17     $params{'sid_generator'} ||= sub {
  18         Digest::SHA1::sha1_hex(rand() . $$ . {} . time)
  19     };
  20
  21     bless { %params } => $class;
  22 }
  23
  24 sub expire_session_id {
  25     my ($self, $id) = @_;
  26     $self->{'_expired'}->{ $id }++;
  27 }
  28
  29 sub is_session_expired {
  30     my ($self, $id) = @_;
  31     exists $self->{'_expired'}->{ $id }
  32 }
  33
  34 sub check_expired {
  35     my ($self, $id) = @_;
  36     return unless $id && not $self->is_session_expired( $id );
  37     return $id;
  38 }
  39
  40 sub get_session_id {
  41     my ($self, $request) = @_;
  42     $self->extract( $request )
  43         ||
  44     $self->generate( $request )
  45 }
  46
  47 sub extract {
  48     my ($self, $request) = @_;
  49     $self->check_expired( $request->param( $self->session_key ) );
  50 }
  51
  52 sub generate {
  53     my $self = shift;
  54     $self->sid_generator->( @_ );
  55 }
  56
  57
  58 sub finalize {
  59     my ($self, $id, $response) = @_;
  60     ();
  61 }
  62
  63 1;
  64
  65 __END__
  66
  67 =pod
  68
  69 =head1 NAME
  70
  71 Plack::Session::State - Basic parameter-based session state
  72
  73 =head1 DESCRIPTION
  74
  75 =head1 METHODS
  76
  77 =over 4
  78
  79 =item B<new ( %params )>
  80
  81 =item B<session_key>
  82
  83 This is the name of the session key, it default to 'plack_session'.
  84
  85 =item B<sid_generator>
  86
  87 This is a CODE ref used to generate unique session ids.
  88
  89 =back
  90
  91 =head2 Session ID Managment
  92
  93 =over 4
  94
  95 =item B<get_session_id ( $request )>
  96
  97 Given a C<$request> this will first attempt to extract the session,
  98 if the is expired or does not exist, it will then generate a new
  99 session. The C<$request> is expected to be a L<Plack::Request> instance
 100 or an object with an equivalent interface.
 101
 102 =item B<extract ( $request )>
 103
 104 This will attempt to extract the session from a C<$request> by looking
 105 for the C<session_key> in the C<$request> params. It will then check to
 106 see if the session has expired and return the session id if it is not.
 107 The C<$request> is expected to be a L<Plack::Request> instance or an
 108 object with an equivalent interface.
 109
 110 =item B<generate ( $request )>
 111
 112 This will generate a new session id using the C<sid_generator> callback.
 113 The C<$request> argument is not used by this method but is there for
 114 use by subclasses. The C<$request> is expected to be a L<Plack::Request>
 115 instance or an object with an equivalent interface.
 116
 117 =item B<finalize ( $session_id, $response )>
 118
 119 Given a C<$session_id> and a C<$response> this will perform any
 120 finalization nessecary to preserve state. This method is called by
 121 the L<Plack::Session> C<finalize> method. The C<$response> is expected
 122 to be a L<Plack::Response> instance or an object with an equivalent
 123 interface.
 124
 125 =back
 126
 127 =head2 Session Expiration Handling
 128
 129 =over 4
 130
 131 =item B<expire_session_id ( $id )>
 132
 133 This will mark the session for C<$id> as expired. This method is called
 134 by the L<Plack::Session> C<expire> method.
 135
 136 =item B<is_session_expired ( $id )>
 137
 138 This will check to see if the session C<$id> has been marked as
 139 expired.
 140
 141 =item B<check_expired ( $id )>
 142
 143 Given an session C<$id> this will return C<undef> if the session is
 144 expired or return the C<$id> if it is not.
 145
 146 =back
 147
 148 =head1 BUGS
 149
 150 All complex software has bugs lurking in it, and this module is no
 151 exception. If you find a bug please either email me, or add the bug
 152 to cpan-RT.
 153
 154 =head1 AUTHOR
 155
 156 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
 157
 158 =head1 COPYRIGHT AND LICENSE
 159
 160 Copyright 2009 Infinity Interactive, Inc.
 161
 162 L<http://www.iinteractive.com>
 163
 164 This library is free software; you can redistribute it and/or modify
 165 it under the same terms as Perl itself.
 166
 167 =cut
 168
 169