File Coverage

blib/lib/Plack/Middleware/Session/Simple.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             package Plack::Middleware::Session::Simple;
2              
3 1     1   962 use 5.008005;
  1         3  
  1         37  
4 1     1   5 use strict;
  1         2  
  1         33  
5 1     1   15 use warnings;
  1         2  
  1         32  
6 1     1   1080 use parent qw/Plack::Middleware/;
  1         415  
  1         7  
7             use Digest::SHA1 qw//;
8             use Cookie::Baker;
9             use Plack::Util;
10             use Scalar::Util qw/blessed/;
11             use Plack::Util::Accessor qw/
12             store
13             cookie_name
14             sid_generator
15             sid_validator
16             keep_empty
17             path
18             domain
19             expires
20             secure
21             httponly
22             /;
23              
24             our $VERSION = "0.02";
25              
26             sub prepare_app {
27             my $self = shift;
28              
29             my $store = $self->store;
30             die('store require get, set and remove method.')
31             unless blessed $store
32             && $store->can('get')
33             && $store->can('set')
34             && $store->can('remove');
35              
36             $self->cookie_name('simple_session') unless $self->cookie_name;
37             $self->path('/') unless defined $self->path;
38             $self->keep_empty(1) unless defined $self->keep_empty;
39              
40             if ( !$self->sid_generator ) {
41             $self->sid_generator(sub{
42             Digest::SHA1::sha1_hex(rand() . $$ . {} . time)
43             });
44             }
45             if ( !$self->sid_validator ) {
46             $self->sid_validator(
47             qr/\A[0-9a-f]{40}\Z/
48             );
49             }
50              
51             }
52              
53             sub call {
54             my ($self,$env) = @_;
55              
56             my($id, $session) = $self->get_session($env);
57              
58             my $tied;
59             if ($id && $session) {
60             $tied = tie my %session,
61             'Plack::Middleware::Session::Simple::Session', %$session;
62             $env->{'psgix.session'} = \%session;
63             $env->{'psgix.session.options'} = {
64             id => $id,
65             };
66             } else {
67             my $id = $self->{sid_generator}->();
68             $tied = tie my %session,
69             'Plack::Middleware::Session::Simple::Session';
70             $env->{'psgix.session'} = \%session;
71             $env->{'psgix.session.options'} = {
72             id => $id,
73             new_session => 1,
74             };
75             }
76              
77             my $res = $self->app->($env);
78              
79             $self->response_cb(
80             $res, sub {
81             $self->finalize($env, $_[0], $tied)
82             }
83             );
84             }
85              
86             sub get_session {
87             my ($self, $env) = @_;
88             my $cookie = crush_cookie($env->{HTTP_COOKIE} || '')->{$self->{cookie_name}};
89             return unless defined $cookie;
90             return unless $cookie =~ $self->{sid_validator};
91              
92             my $session = $self->{store}->get($cookie) or return;
93             return ($cookie, $session);
94             }
95              
96             sub finalize {
97             my ($self, $env, $res, $session) = @_;
98             my $options = $env->{'psgix.session.options'};
99             my $new_session = delete $options->{new_session};
100              
101             my $need_store;
102             if ( ($new_session && $self->{keep_empty} && ! $session->has_key )
103             || $session->[1] || $options->{expire} || $options->{change_id}) {
104             $need_store = 1;
105             }
106             $need_store = 0 if $options->{no_store};
107              
108             my $set_cookie;
109             if ( ($new_session && $self->{keep_empty} && ! $session->has_key )
110             || ($new_session && $session->[1] )
111             || $options->{expire} || $options->{change_id}) {
112             $set_cookie = 1;
113             }
114              
115             if ( $need_store ) {
116             if ($options->{expire}) {
117             $self->{store}->remove($options->{id});
118             } elsif ($options->{change_id}) {
119             $self->{store}->remove($options->{id});
120             $options->{id} = $self->{sid_generator}->();
121             $self->{store}->set($options->{id}, $session->[0]);
122             } else {
123             $self->{store}->set($options->{id}, $session->[0]);
124             }
125             }
126              
127             if ( $set_cookie ) {
128             if ($options->{expire}) {
129             $self->_set_cookie(
130             $options->{id}, $res, %$options, expires => 'now');
131             } else {
132             $self->_set_cookie(
133             $options->{id}, $res, %$options);
134             }
135             }
136             }
137              
138             sub _set_cookie {
139             my($self, $id, $res, %options) = @_;
140              
141             delete $options{id};
142              
143             $options{path} = $self->{path} || '/' if !exists $options{path};
144             $options{domain} = $self->{domain} if !exists $options{domain} && defined $self->{domain};
145             $options{secure} = $self->{secure} if !exists $options{secure} && defined $self->{secure};
146             $options{httponly} = $self->{httponly} if !exists $options{httponly} && defined $self->{httponly};
147              
148             if (!exists $options{expires} && defined $self->{expires}) {
149             $options{expires} = $self->{expires};
150             }
151              
152             my $cookie = bake_cookie(
153             $self->{cookie_name}, {
154             value => $id,
155             %options,
156             }
157             );
158             Plack::Util::header_push($res->[1], 'Set-Cookie', $cookie);
159             }
160              
161             1;
162              
163             package Plack::Middleware::Session::Simple::Session;
164              
165             use strict;
166             use warnings;
167             use Tie::Hash;
168             use base qw/Tie::ExtraHash/;
169              
170             sub TIEHASH {
171             my $class = shift;
172             bless [{@_},0, scalar @_], $class;
173             }
174              
175             sub STORE {
176             $_[0]->[1]++;
177             $_[0]->[0]{$_[1]} = $_[2]
178             }
179              
180             sub DELETE {
181             $_[0]->[1]++;
182             delete $_[0]->[0]->{$_[1]}
183             }
184              
185             sub CLEAR {
186             $_[0]->[1]++;
187             %{$_[0]->[0]} = ()
188             }
189              
190             sub has_key {
191             scalar keys %{$_[0]->[0]}
192             }
193              
194             1;
195              
196             __END__