lib/Plack/Session/State.pm

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