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     sid_checker
  11 ];
  12
  13 sub new {
  14     my ($class, %params) = @_;
  15
  16     $params{'_expired'}      ||= +{};
  17     $params{'session_key'}   ||= 'plack_session';
  18     $params{'sid_generator'} ||= sub {
  19         Digest::SHA1::sha1_hex(rand() . $$ . {} . time)
  20     };
  21     $params{'sid_checker'} ||= qr/\A[0-9a-f]{40}\Z/;
  22
  23     bless { %params } => $class;
  24 }
  25
  26 sub expire_session_id {
  27     my ($self, $id) = @_;
  28     $self->{'_expired'}->{ $id }++;
  29 }
  30
  31 sub is_session_expired {
  32     my ($self, $id) = @_;
  33     exists $self->{'_expired'}->{ $id }
  34 }
  35
  36 sub check_expired {
  37     my ($self, $id) = @_;
  38     return unless $id && not $self->is_session_expired( $id );
  39     return $id;
  40 }
  41
  42 sub check_request_session_id {
  43     my ($self, $request) = @_;
  44
  45     my $reqest_session_id = $self->get_request_session_id($request);
  46     my $sid_checker = $self->sid_checker;
  47
  48     defined $reqest_session_id && $reqest_session_id =~ m{$sid_checker};
  49 }
  50
  51 sub get_session_id {
  52     my ($self, $request) = @_;
  53     (
  54         $self->check_request_session_id($request)
  55         &&
  56         $self->extract( $request )
  57     )
  58         ||
  59     $self->generate( $request )
  60 }
  61
  62 sub get_request_session_id {
  63     my ($self, $request ) = @_;
  64
  65     $request->param( $self->session_key );
  66 }
  67
  68 sub extract {
  69     my ($self, $request) = @_;
  70
  71     $self->check_expired( $self->get_request_session_id($request) );
  72 }
  73
  74 sub generate {
  75     my $self = shift;
  76     $self->sid_generator->( @_ );
  77 }
  78
  79
  80 sub finalize {
  81     my ($self, $id, $response) = @_;
  82     ();
  83 }
  84
  85 1;
  86
  87 __END__
  88
  89 =pod
  90
  91 =head1 NAME
  92
  93 Plack::Session::State - Basic parameter-based session state
  94
  95 =head1 SYNOPSIS
  96
  97   use Plack::Builder;
  98   use Plack::Middleware::Session;
  99   use Plack::Session::State;
 100
 101   my $app = sub {
 102       return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ];
 103   };
 104
 105   builder {
 106       enable 'Session',
 107           state => Plack::Session::State->new;
 108       $app;
 109   };
 110
 111 =head1 DESCRIPTION
 112
 113 This will maintain session state by passing the session through
 114 the request params. It does not do this automatically though,
 115 you are responsible for passing the session param.
 116
 117 This should be considered the state "base" class (although
 118 subclassing is not a requirement) and defines the spec for
 119 all B<Plack::Session::State::*> modules. You will only
 120 need to override a couple methods if you do subclass. See
 121 L<Plack::Session::State::Cookie> for an example of this.
 122
 123 =head1 METHODS
 124
 125 =over 4
 126
 127 =item B<new ( %params )>
 128
 129 The C<%params> can include I<session_key>, I<sid_generator> and I<sid_checker>
 130 however in both cases a default will be provided for you.
 131
 132 =item B<session_key>
 133
 134 This is the name of the session key, it default to 'plack_session'.
 135
 136 =item B<sid_generator>
 137
 138 This is a CODE ref used to generate unique session ids, by default
 139 it will generate a SHA1 using fairly sufficient entropy. If you are
 140 concerned or interested, just read the source.
 141
 142 =item B<sid_checker>
 143
 144 This is a regex used to check requested session id,
 145
 146 =back
 147
 148 =head2 Session ID Managment
 149
 150 =over 4
 151
 152 =item B<get_session_id ( $request )>
 153
 154 Given a C<$request> this will first attempt to extract the session,
 155 if the is expired or does not exist, it will then generate a new
 156 session. The C<$request> is expected to be a L<Plack::Request> instance
 157 or an object with an equivalent interface.
 158
 159 =item B<extract ( $request )>
 160
 161 This will attempt to extract the session from a C<$request> by looking
 162 for the C<session_key> in the C<$request> params. It will then check to
 163 see if the session has expired and return the session id if it is not.
 164 The C<$request> is expected to be a L<Plack::Request> instance or an
 165 object with an equivalent interface.
 166
 167 =item B<generate ( $request )>
 168
 169 This will generate a new session id using the C<sid_generator> callback.
 170 The C<$request> argument is not used by this method but is there for
 171 use by subclasses. The C<$request> is expected to be a L<Plack::Request>
 172 instance or an object with an equivalent interface.
 173
 174 =item B<finalize ( $session_id, $response )>
 175
 176 Given a C<$session_id> and a C<$response> this will perform any
 177 finalization nessecary to preserve state. This method is called by
 178 the L<Plack::Session> C<finalize> method. The C<$response> is expected
 179 to be a L<Plack::Response> instance or an object with an equivalent
 180 interface.
 181
 182 =back
 183
 184 =head2 Session Expiration Handling
 185
 186 =over 4
 187
 188 =item B<expire_session_id ( $id )>
 189
 190 This will mark the session for C<$id> as expired. This method is called
 191 by the L<Plack::Session> C<expire> method.
 192
 193 =item B<is_session_expired ( $id )>
 194
 195 This will check to see if the session C<$id> has been marked as
 196 expired.
 197
 198 =item B<check_expired ( $id )>
 199
 200 Given an session C<$id> this will return C<undef> if the session is
 201 expired or return the C<$id> if it is not.
 202
 203 =back
 204
 205 =head1 BUGS
 206
 207 All complex software has bugs lurking in it, and this module is no
 208 exception. If you find a bug please either email me, or add the bug
 209 to cpan-RT.
 210
 211 =head1 AUTHOR
 212
 213 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
 214
 215 =head1 COPYRIGHT AND LICENSE
 216
 217 Copyright 2009 Infinity Interactive, Inc.
 218
 219 L<http://www.iinteractive.com>
 220
 221 This library is free software; you can redistribute it and/or modify
 222 it under the same terms as Perl itself.
 223
 224 =cut
 225
 226