File Coverage

blib/lib/CatalystX/ASP/Session.pm
Criterion Covered Total %
statement 48 53 90.5
branch 11 14 78.5
condition 2 3 66.6
subroutine 13 15 86.6
pod 3 3 100.0
total 77 88 87.5


line stmt bran cond sub pod time code
1             package CatalystX::ASP::Session;
2              
3 9     9   3771 use namespace::autoclean;
  9         20  
  9         67  
4 9     9   747 use Moose;
  9         20  
  9         53  
5 9     9   51737 use parent 'Tie::Hash';
  9         23  
  9         61  
6              
7             has 'asp' => (
8             is => 'ro',
9             isa => 'CatalystX::ASP',
10             required => 1,
11             weak_ref => 1,
12             );
13              
14             =head1 NAME
15              
16             CatalystX::ASP::Session - $Session Object
17              
18             =head1 SYNOPSIS
19              
20             use CatalystX::ASP::Session;
21              
22             my $session = CatalystX::ASP::Session->new(asp => $asp);
23             tie %Session, 'CatalystX::ASP::Session', $session;
24             $Session{foo} = $bar;
25              
26             =head1 DESCRIPTION
27              
28             The C<$Session> object keeps track of user and web client state, in a persistent
29             manner, making it relatively easy to develop web applications. The C<$Session>
30             state is stored across HTTP connections, in database files in the C<Global> or
31             C<StateDir> directories, and will persist across web server restarts.
32              
33             The user session is referenced by a 128 bit / 32 byte MD5 hex hashed cookie, and
34             can be considered secure from session id guessing, or session hijacking. When a
35             hacker fails to guess a session, the system times out for a second, and with
36             2**128 (3.4e38) keys to guess, a hacker will not be guessing an id any time
37             soon.
38              
39             If an incoming cookie matches a timed out or non-existent session, a new session
40             is created with the incoming id. If the id matches a currently active session,
41             the session is tied to it and returned. This is also similar to the Microsoft
42             ASP implementation.
43              
44             The C<$Session> reference is a hash ref, and can be used as such to store data
45             as in:
46              
47             $Session->{count}++; # increment count by one
48             %{$Session} = (); # clear $Session data
49              
50             The C<$Session> object state is implemented through L<MLDBM>, and a user should
51             be aware of the limitations of MLDBM. Basically, you can read complex
52             structures, but not write them, directly:
53              
54             $data = $Session->{complex}{data}; # Read ok.
55             $Session->{complex}{data} = $data; # Write NOT ok.
56             $Session->{complex} = {data => $data}; # Write ok, all at once.
57              
58             Please see L<MLDBM> for more information on this topic. C<$Session> can also be
59             used for the following methods and properties:
60              
61             =cut
62              
63             has '_is_new' => (
64             is => 'rw',
65             isa => 'Bool',
66             default => 0,
67             traits => [qw(Bool)],
68             handles => {
69             '_set_is_new' => 'set',
70             '_unset_is_new' => 'unset'
71             },
72             );
73              
74             has '_session_key_index' => (
75             is => 'rw',
76             isa => 'Int',
77             default => 0,
78             traits => [qw(Counter)],
79             handles => {
80             _inc_session_key_index => 'inc',
81             _reset_session_key_index => 'reset',
82             },
83             );
84              
85             has '_session_keys' => (
86             is => 'rw',
87             isa => 'ArrayRef',
88             default => sub { [] },
89             traits => [qw(Array)],
90             handles => {
91             _session_keys_get => 'get',
92             },
93             );
94              
95             =head1 ATTRIBUTES
96              
97             =over
98              
99             =item $Session->{CodePage}
100              
101             Not implemented. May never be until someone needs it.
102              
103             =cut
104              
105             has 'CodePage' => (
106             is => 'ro',
107             isa => 'Item',
108             );
109              
110             =item $Session->{LCID}
111              
112             Not implemented. May never be until someone needs it.
113              
114             =cut
115              
116             has 'LCID' => (
117             is => 'ro',
118             isa => 'item',
119             );
120              
121             =item $Session->{SessionID}
122              
123             SessionID property, returns the id for the current session, which is exchanged
124             between the client and the server as a cookie.
125              
126             =cut
127              
128             has 'SessionID' => (
129             is => 'rw',
130             isa => 'Str',
131             );
132              
133             =item $Session->{Timeout} [= $minutes]
134              
135             Timeout property, if minutes is being assigned, sets this default timeout for
136             the user session, else returns the current session timeout.
137              
138             If a user session is inactive for the full timeout, the session is destroyed by
139             the system. No one can access the session after it times out, and the system
140             garbage collects it eventually.
141              
142             =cut
143              
144             has 'Timeout' => (
145             is => 'rw',
146             isa => 'Int',
147             default => 60,
148             );
149              
150             =back
151              
152             =head1 METHODS
153              
154             =over
155              
156             =item $Session->Abandon()
157              
158             The abandon method times out the session immediately. All Session data is
159             cleared in the process, just as when any session times out.
160              
161             =cut
162              
163             has 'IsAbandoned' => (
164             is => 'ro',
165             isa => 'Bool',
166             default => 0,
167             traits => [qw(Bool)],
168             handles => {
169             Abandon => 'set',
170             },
171             );
172              
173             =item $Session->Lock()
174              
175             Not implemented. This is a no-op. This was meant to be for performance
176             improvement, but it's not necessary.
177              
178             =cut
179              
180             # TODO: will not implement
181             sub Lock {
182 1     1 1 6 my ( $self ) = @_;
183 1         22 $self->asp->c->log->warn( "\$Session->Lock has not been implemented!" );
184 1         1521 return;
185             }
186              
187             =item $Session->UnLock()
188              
189             Not implemented. This is a no-op. This was meant to be for performance
190             improvement, but it's not necessary.
191              
192             =cut
193              
194             # TODO: will not implement
195             sub UnLock {
196 1     1 1 2 my ( $self ) = @_;
197 1         31 $self->asp->c->log->warn( "\$Session->UnLock has not been implemented!" );
198 1         10 return;
199             }
200              
201             =item $Session->Flush()
202              
203             Not implemented.
204              
205             =cut
206              
207             # TODO: will not implement; not part of API so just no-op
208       0 1   sub Flush { }
209              
210             # The Session is tied to Catalyst's $c->session so as to skip the storage of the
211             # $asp object
212             sub TIEHASH {
213 14     14   47 my ( $class, $self ) = @_;
214 14         385 my $c = $self->asp->c;
215              
216             # By default, assume using Catalyst::Plugin::Session otherwise assume using
217             # Catalyst::Plugin::iParadigms::Session
218 14 50       79 my $session_is_valid = $c->can( 'session_is_valid' ) ? 'session_is_valid' : 'is_valid_session_id';
219 14 100       88 unless ( $c->$session_is_valid( $c->sessionid ) ) {
220 9         14967 $self->_set_is_new;
221 9         33 $self->SessionID( $c->sessionid );
222             }
223 14         106 return $self;
224             }
225              
226             sub STORE {
227 100     100   574057 my ( $self, $key, $value ) = @_;
228 100 100       627 return $value if $key =~ /asp|_is_new|_session_key/;
229 44         1246 $self->asp->c->session->{$key} = $value;
230             }
231              
232             sub FETCH {
233 44     44   1234 my ( $self, $key ) = @_;
234 44         118 for ( $key ) {
235 44 100       207 if ( /asp/ ) { return $self->asp }
  2 100       44  
    50          
236 5         155 elsif ( /_is_new/ ) { return $self->_is_new }
237 0         0 elsif ( /_session_key/ ) {return}
238 37         974 else { return $self->asp->c->session->{$key} }
239             }
240             }
241              
242             sub FIRSTKEY {
243 6     6   1659 my ( $self ) = @_;
244 6         11 $self->_session_keys( [ keys %{ $self->asp->c->session } ] );
  6         165  
245 6         229 $self->_reset_session_key_index;
246 6         19 $self->NEXTKEY;
247             }
248              
249             sub NEXTKEY {
250 30     30   2937 my ( $self, $lastkey ) = @_;
251 30         725 my $key = $self->_session_keys_get( $self->_session_key_index );
252 30         886 $self->_inc_session_key_index;
253 30 50 66     114 if ( defined $key && $key =~ m/asp|_is_new|_session_key/ ) {
254 0         0 return $self->NEXTKEY;
255             } else {
256 30         552 return $key;
257             }
258             }
259              
260             sub EXISTS {
261 5     5   295 my ( $self, $key ) = @_;
262 5         119 exists $self->asp->c->session->{$key};
263             }
264              
265             sub DELETE {
266 4     4   256 my ( $self, $key ) = @_;
267 4         85 delete $self->asp->c->session->{$key};
268             }
269              
270             sub CLEAR {
271 1     1   305 my ( $self ) = @_;
272 1         2 $self->DELETE( $_ ) for ( keys %{ $self->asp->c->session } );
  1         28  
273             }
274              
275             sub SCALAR {
276 0     0     my ( $self ) = @_;
277 0           scalar %{ $self->asp->c->session };
  0            
278             }
279              
280             __PACKAGE__->meta->make_immutable;
281              
282             =back
283              
284             =head1 SEE ALSO
285              
286             =over
287              
288             =item * L<CatalystX::ASP::Request>
289              
290             =item * L<CatalystX::ASP::Response>
291              
292             =item * L<CatalystX::ASP::Application>
293              
294             =item * L<CatalystX::ASP::Server>
295              
296             =back