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 =item B<sid_generator>
  83
  84 =back
  85
  86 =over 4
  87
  88 =item B<get_session_id ( $request )>
  89
  90 =item B<extract ( $request )>
  91
  92 =item B<generate ( $request )>
  93
  94 =item B<finalize ( $session_id, $response )>
  95
  96 =back
  97
  98 =over 4
  99
 100 =item B<expire_session_id ( $id )>
 101
 102 =item B<check_expired ( $id )>
 103
 104 =back
 105
 106 =head1 BUGS
 107
 108 All complex software has bugs lurking in it, and this module is no
 109 exception. If you find a bug please either email me, or add the bug
 110 to cpan-RT.
 111
 112 =head1 AUTHOR
 113
 114 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
 115
 116 =head1 COPYRIGHT AND LICENSE
 117
 118 Copyright 2009 Infinity Interactive, Inc.
 119
 120 L<http://www.iinteractive.com>
 121
 122 This library is free software; you can redistribute it and/or modify
 123 it under the same terms as Perl itself.
 124
 125 =cut
 126
 127