File Coverage

blib/lib/Prancer/Session.pm
Criterion Covered Total %
statement 12 68 17.6
branch 0 32 0.0
condition 0 9 0.0
subroutine 4 11 36.3
pod 6 7 85.7
total 22 127 17.3


line stmt bran cond sub pod time code
1             package Prancer::Session;
2              
3 1     1   6 use strict;
  1         2  
  1         29  
4 1     1   5 use warnings FATAL => 'all';
  1         2  
  1         37  
5              
6 1     1   5 use version;
  1         2  
  1         6  
7             our $VERSION = '1.05';
8              
9 1     1   68 use Storable qw(dclone);
  1         2  
  1         973  
10              
11             sub new {
12 0     0 0   my ($class, $env) = @_;
13             my $self = bless({
14             'env' => $env,
15             '_session' => $env->{'psgix.session'},
16 0           '_options' => $env->{'psgix.session.options'},
17             }, $class);
18              
19 0           return $self;
20             }
21              
22             sub id {
23 0     0 1   my $self = shift;
24 0           return $self->{'_options'}->{'id'};
25             }
26              
27             sub has {
28 0     0 1   my ($self, $key) = @_;
29 0           return exists($self->{'_session'}->{$key});
30             }
31              
32             sub get {
33 0     0 1   my ($self, $key, $default) = @_;
34              
35             # only return things if the are running in a non-void context
36 0 0         if (defined(wantarray())) {
37 0           my $value = undef;
38              
39 0 0         if (exists($self->{'_session'}->{$key})) {
40 0           $value = $self->{'_session'}->{$key};
41             } else {
42 0           $value = $default;
43             }
44              
45             # nothing to return
46 0 0         return unless defined($value);
47              
48             # make a clone to avoid changing things
49             # through inadvertent references.
50 0 0         $value = dclone($value) if ref($value);
51              
52 0 0 0       if (wantarray() && ref($value)) {
53             # return a value rather than a reference
54 0 0         if (ref($value) eq "HASH") {
55 0           return %{$value};
  0            
56             }
57 0 0         if (ref($value) eq "ARRAY") {
58 0           return @{$value};
  0            
59             }
60             }
61              
62             # return a reference
63 0           return $value;
64             }
65              
66 0           return;
67             }
68              
69             sub set {
70 0     0 1   my ($self, $key, $value) = @_;
71              
72 0           my $old = undef;
73 0 0         $old = $self->get($key) if defined(wantarray());
74              
75 0 0         if (ref($value)) {
76             # make a copy of the original value to avoid inadvertently changing
77             # things via references
78 0           $self->{'_session'}->{$key} = dclone($value);
79             } else {
80             # can't clone non-references
81 0           $self->{'_session'}->{$key} = $value;
82             }
83              
84 0 0 0       if (wantarray() && ref($old)) {
85             # return a value rather than a reference
86 0 0         if (ref($old) eq "HASH") {
87 0           return %{$old};
  0            
88             }
89 0 0         if (ref($old) eq "ARRAY") {
90 0           return @{$old};
  0            
91             }
92             }
93              
94 0           return $old;
95             }
96              
97             sub remove {
98 0     0 1   my ($self, $key) = @_;
99              
100 0           my $old = undef;
101 0 0         $old = $self->get($key) if defined(wantarray());
102              
103 0           delete($self->{'_session'}->{$key});
104              
105 0 0 0       if (wantarray() && ref($old)) {
106             # return a value rather than a reference
107 0 0         if (ref($old) eq "HASH") {
108 0           return %{$old};
  0            
109             }
110 0 0         if (ref($old) eq "ARRAY") {
111 0           return @{$old};
  0            
112             }
113             }
114              
115 0           return $old;
116             }
117              
118             sub expire {
119 0     0 1   my $self = shift;
120 0           for my $key (keys %{$self->{'_session'}}) {
  0            
121 0           delete($self->{'_session'}->{$key});
122             }
123 0           $self->{'_options'}->{'expire'} = 1;
124 0           return;
125             }
126              
127             1;
128              
129             =head1 NAME
130              
131             Prancer::Session
132              
133             =head1 SYNOPSIS
134              
135             Sessions are just as important in a web application as GET and POST parameters.
136             So if you have configured your application for sessions then every request will
137             include a session object specific to that request.
138              
139             sub handler {
140             my ($self, $env, $request, $response, $session) = @_;
141              
142             # increment this counter every time the user requests a page
143             my $counter = $session->get('counter');
144             $counter ||= 0;
145             ++$counter;
146             $session->set('counter', $counter);
147              
148             sub (GET + /logout) {
149             # blow the user's session away
150             $session->expire();
151              
152             # then redirect the user
153             $response->header('Location' => '/login');
154             return $response->finalize(301);
155             }
156             }
157              
158             =head1 CONFIGURATION
159              
160             The basic configuration for the session engine looks like this:
161              
162             session:
163             state:
164             driver: Prancer::Session::State::Cookie
165             options:
166             session_key: PSESSION
167             store:
168             driver: Prancer::Session::Store::Storable
169             options:
170             dir: /tmp/prancer/sessions
171              
172             The documentation for the state and store drivers will have more information
173             about the specific options available to them.
174              
175             =head1 METHODS
176              
177             =over
178              
179             =item id
180              
181             This will return the session id of the current session. This is set and
182             maintained by the session state package.
183              
184             =item has I
185              
186             This will return true if the named key exists in the session object.
187              
188             if ($session->has('foo')) {
189             print "I see you've set foo already.\n";
190             }
191              
192             It will return false otherwise.
193              
194             =item get I [I]
195              
196             The get method takes two arguments: a key and a default value. If the key does
197             not exist then the default value will be returned instead. If the value that
198             has been stored in the user's session is a reference then a clone of the value
199             will be returned to avoid modifying the session in a strange way. Additionally,
200             this method is context sensitive.
201              
202             my $foo = $session->get('foo');
203             my %bar = $session->get('bar');
204             my @baz = $session->get('baz');
205              
206             =item set I I
207              
208             The set method takes two arguments: a key and a value. If the key already
209             exists in the session then it will be overwritten and the old value will be
210             returned in a context sensitive way. If the value is a reference then it will
211             be cloned before being saved into the user's session to avoid any strangeness.
212              
213             my $old_foo = $session->set('foo', 'bar');
214             my %old_bar = $session->set('bar', { 'baz' => 'bat' });
215             my @old_baz = $session->set('baz', [ 'foo', 'bar', 'baz' ]);
216             $session->set('whatever', 'do not care');
217              
218             =item remove I
219              
220             The remove method takes one argument: the key to remove. The value that was
221             removed will be returned in a context sensitive way.
222              
223             =item expire
224              
225             This will blow the session away.
226              
227             =back
228              
229             =head1 SEE ALSO
230              
231             =over
232              
233             =item L
234             =item L
235             =item L
236             =item L
237             =item L
238              
239             =back
240              
241             =cut