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 check_expired {
  29     my ($self, $id) = @_;
  30     return unless $id && not exists $self->{'_expired'}->{ $id };
  31     return $id;
  32 }
  33
  34 sub get_session_id {
  35     my ($self, $request) = @_;
  36     $self->extract( $request )
  37         ||
  38     $self->generate( $request )
  39 }
  40
  41 sub extract {
  42     my ($self, $request) = @_;
  43     $self->check_expired( $request->param( $self->session_key ) );
  44 }
  45
  46 sub generate {
  47     my $self = shift;
  48     $self->sid_generator->( @_ );
  49 }
  50
  51
  52 sub finalize {
  53     my ($self, $id, $response) = @_;
  54     ();
  55 }
  56
  57 1;
  58
  59 __END__
  60
  61 =pod
  62
  63 =head1 NAME
  64
  65 Plack::Session::State - Basic parameter-based session state
  66
  67 =head1 DESCRIPTION
  68
  69 =head1 METHODS
  70
  71 =over 4
  72
  73 =item B<new ( %params )>
  74
  75 =item B<session_key>
  76
  77 =item B<sid_generator>
  78
  79 =back
  80
  81 =over 4
  82
  83 =item B<get_session_id ( $request )>
  84
  85 =item B<extract ( $request )>
  86
  87 =item B<generate ( $request )>
  88
  89 =item B<finalize ( $session_id, $response )>
  90
  91 =back
  92
  93 =over 4
  94
  95 =item B<expire_session_id ( $id )>
  96
  97 =item B<check_expired ( $id )>
  98
  99 =back
 100
 101 =head1 BUGS
 102
 103 All complex software has bugs lurking in it, and this module is no
 104 exception. If you find a bug please either email me, or add the bug
 105 to cpan-RT.
 106
 107 =head1 AUTHOR
 108
 109 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
 110
 111 =head1 COPYRIGHT AND LICENSE
 112
 113 Copyright 2009 Infinity Interactive, Inc.
 114
 115 L<http://www.iinteractive.com>
 116
 117 This library is free software; you can redistribute it and/or modify
 118 it under the same terms as Perl itself.
 119
 120 =cut
 121
 122