preliminary docs added, improved support for subclassing and sid_generator callback...
[catagits/Web-Session.git] / lib / Plack / Session / State.pm
CommitLineData
06190e8b 1package Plack::Session::State;
2use strict;
3use warnings;
4
ac4892f4 5use Plack::Util::Accessor qw[
6 session_key
7 sid_generator
8];
06190e8b 9
10sub new {
11 my ($class, %params) = @_;
ac4892f4 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;
06190e8b 21}
22
23sub expire_session_id {
24 my ($self, $id) = @_;
ac4892f4 25 $self->{'_expired'}->{ $id }++;
06190e8b 26}
27
bd992981 28sub check_expired {
29 my ($self, $id) = @_;
ac4892f4 30 return unless $id && not exists $self->{'_expired'}->{ $id };
06190e8b 31 return $id;
32}
33
06190e8b 34sub get_session_id {
35 my ($self, $request) = @_;
36 $self->extract( $request )
37 ||
bd992981 38 $self->generate( $request )
39}
40
41sub extract {
42 my ($self, $request) = @_;
43 $self->check_expired( $request->param( $self->session_key ) );
44}
45
fe1bfe7d 46sub generate {
47 my $self = shift;
ac4892f4 48 $self->sid_generator->( @_ );
bd992981 49}
50
fe1bfe7d 51
bd992981 52sub finalize {
53 my ($self, $id, $response) = @_;
54 ();
06190e8b 55}
56
fe1bfe7d 571;
ac4892f4 58
59__END__
60
61=pod
62
63=head1 NAME
64
65Plack::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
103All complex software has bugs lurking in it, and this module is no
104exception. If you find a bug please either email me, or add the bug
105to cpan-RT.
106
107=head1 AUTHOR
108
109Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
110
111=head1 COPYRIGHT AND LICENSE
112
113Copyright 2009 Infinity Interactive, Inc.
114
115L<http://www.iinteractive.com>
116
117This library is free software; you can redistribute it and/or modify
118it under the same terms as Perl itself.
119
120=cut
121
122