lib/Plack/Session/State.pm

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