File Coverage

blib/lib/MojoX/Session.pm
Criterion Covered Total %
statement 157 190 82.6
branch 57 100 57.0
condition 6 11 54.5
subroutine 26 29 89.6
pod 13 13 100.0
total 259 343 75.5


line stmt bran cond sub pod time code
1             package MojoX::Session;
2              
3 15     15   83614 use strict;
  15         31  
  15         557  
4 15     15   84 use warnings;
  15         27  
  15         949  
5              
6             our $VERSION = '0.31';
7              
8 15     15   77 use base 'Mojo::Base';
  15         30  
  15         11104  
9              
10 15     15   144985 use Mojo::Loader;
  15         841119  
  15         257  
11 15     15   11818 use Mojo::ByteStream;
  15         57983  
  15         728  
12 15     15   11528 use Mojo::Transaction::HTTP;
  15         1405583  
  15         151  
13 15     15   11054 use MojoX::Session::Transport::Cookie;
  15         53  
  15         157  
14 15     15   439 use Digest::SHA;
  15         30  
  15         45841  
15              
16             my $PRIVATE_IP_FIELD = 'mojox.session.ip_address';
17              
18             __PACKAGE__->attr(loader => sub { Mojo::Loader->new });
19             __PACKAGE__->attr(tx => sub { Mojo::Transaction::HTTP->new });
20             __PACKAGE__->attr([qw/sid _store/]);
21             __PACKAGE__->attr(_transport => sub { MojoX::Session::Transport::Cookie->new }
22             );
23              
24             __PACKAGE__->attr(ip_match => 0);
25             __PACKAGE__->attr(expires_delta => 3600);
26              
27             __PACKAGE__->attr(_is_new => 0);
28             __PACKAGE__->attr(_is_stored => 0);
29             __PACKAGE__->attr(_is_flushed => 1);
30              
31             __PACKAGE__->attr(_expires => 0);
32             __PACKAGE__->attr(_data => sub { {} });
33              
34             __PACKAGE__->attr('error');
35              
36             sub new {
37 20     20 1 18191 my $class = shift;
38 20         93 my %args = @_;
39              
40 20         53 my $store = delete $args{store};
41 20         162 my $transport = delete $args{transport};
42              
43 20         167 my $self = $class->SUPER::new(%args);
44              
45 20         208 $self->_store($self->_instance(Store => $store));
46 20         301 $self->_transport($self->_instance(Transport => $transport));
47              
48 20         211 return $self;
49             }
50              
51             sub store {
52 100     100 1 154 my $self = shift;
53              
54 100 50       3256 return $self->_store if @_ == 0;
55              
56 0         0 $self->_store($self->_instance(Store => shift));
57             }
58              
59             sub transport {
60 136     136 1 2002389 my $self = shift;
61              
62 136 50       3964 return $self->_transport if @_ == 0;
63              
64 0         0 $self->_transport($self->_instance(Transport => shift));
65             }
66              
67             sub _load_and_build {
68 17     17   70 my $self = shift;
69 17         37 my ($namespace, $name, $args) = @_;
70              
71 17         316 my $class = join('::',
72             __PACKAGE__, $namespace, Mojo::ByteStream->new($name)->camelize);
73              
74 17         2113 my $rv = $self->loader->load($class);
75              
76 17 50       6227 if (defined $rv) {
77 0 0       0 die qq/Store "$class" can not be loaded : $rv/ if ref $rv;
78              
79 0         0 die qq/Store "$class" not found/;
80             }
81              
82 17 50       36 return $class->new(%{$args || {}});
  17         270  
83             }
84              
85             sub _instance {
86 40     40   65 my $self = shift;
87 40         79 my ($namespace, $instance) = @_;
88              
89 40 100       408 return unless $instance;
90              
91 31 50       202 if (ref $instance eq 'HASH') {
    50          
    100          
92 0         0 die 'HASH';
93              
94             #$store
95             }
96             elsif (ref $instance eq 'ARRAY') {
97 0         0 $instance =
98             $self->_load_and_build($namespace, $instance->[0], $instance->[1]);
99             }
100             elsif (!ref $instance) {
101 17         62 $instance = $self->_load_and_build($namespace, $instance);
102             }
103              
104 31         1014 return $instance;
105             }
106              
107             sub create {
108 20     20 1 11242 my $self = shift;
109 20         43 my ($cb) = @_;
110              
111 20         604 $self->_expires(time + $self->expires_delta);
112              
113 20         1138 $self->_is_new(1);
114              
115 20 100       588 if ($self->ip_match) {
116 1         13 $self->data($PRIVATE_IP_FIELD, $self->_remote_addr);
117             }
118              
119 20         275 $self->_generate_sid;
120              
121 20 50       740 if ($self->transport) {
122 20         394 $self->transport->tx($self->tx);
123 20         1992 $self->transport->set($self->sid, $self->expires);
124             }
125              
126 20         9795 $self->_is_flushed(0);
127              
128 20 50       169 return $cb->($self, $self->sid) if $cb;
129              
130 20         701 return $self->sid;
131             }
132              
133             sub load {
134 19     19 1 13753 my $self = shift;
135 19         44 my ($sid, $cb) = @_;
136              
137 19 50       86 ($cb, $sid) = ($sid, undef) if ref $sid eq 'CODE';
138              
139 19         553 $self->sid(undef);
140 19         530 $self->_expires(0);
141 19         537 $self->_data({});
142              
143 19 50       151 if ($self->transport) {
144 19         225 $self->transport->tx($self->tx);
145             }
146              
147 19 100       1271 unless ($sid) {
148 7         25 $sid = $self->transport->get;
149 7 50       238 return $cb ? $cb->($self) : undef unless $sid;
    100          
150             }
151              
152 17 50       61 if ($self->store->is_async) {
153             $self->store->load(
154             $sid => sub {
155 0     0   0 my ($store, $expires, $data) = @_;
156              
157 0 0       0 if ($store->error) {
158 0         0 $self->error($store->error);
159 0 0       0 return $cb ? $cb->($self) : undef;
160             }
161              
162 0         0 my $sid = $self->_on_load($sid, $expires, $data);
163              
164 0 0       0 return $cb->($self, $sid) if $cb;
165              
166 0         0 return $sid;
167             }
168 0         0 );
169             }
170             else {
171 17         677 my ($expires, $data) = $self->store->load($sid);
172              
173 17 50 0     817 return $self->error($self->store->error) && undef
174             if $self->store->error;
175              
176 17         636 my $sid = $self->_on_load($sid, $expires, $data);
177              
178 17 100       145 return unless $sid;
179              
180 11         74 return $sid;
181             }
182             }
183              
184             sub _on_load {
185 17     17   33 my $self = shift;
186 17         36 my ($sid, $expires, $data) = @_;
187              
188 17 100 66     132 unless (defined $expires && defined $data) {
189 5 50       30 $self->transport->set($sid, time - 30 * 24 * 3600)
190             if $self->transport;
191 5         1060 return;
192             }
193              
194 12         419 $self->_expires($expires);
195 12         329 $self->_data($data);
196              
197 12 100       335 if ($self->ip_match) {
198 2 50       20 return unless $self->_remote_addr;
199              
200 2 50       211 return unless $self->data($PRIVATE_IP_FIELD);
201              
202 2 100       19 return unless $self->_remote_addr eq $self->data($PRIVATE_IP_FIELD);
203             }
204              
205 11         512 $self->sid($sid);
206              
207 11         336 $self->_is_stored(1);
208              
209 11         331 return $self->sid;
210             }
211              
212             sub flush {
213 25     25 1 2775 my $self = shift;
214 25         48 my ($cb) = @_;
215              
216 25 50 66     587 return $cb ? $cb->($self) : 1 unless $self->sid && !$self->_is_flushed;
    100          
217              
218 24 100 66     979 if ($self->is_expired && $self->_is_stored) {
219 2 50       84 if ($self->store->is_async) {
220              
221             $self->store->delete(
222             $self->sid => sub {
223 0     0   0 my ($store) = @_;
224              
225 0 0       0 if (my $error = $store->error) {
226 0         0 $self->error($error);
227 0 0       0 return $cb ? $cb->($self) : undef;
228             }
229              
230 0         0 $self->_is_stored(0);
231 0         0 $self->_is_flushed(1);
232              
233 0 0       0 return $cb->($self) if $cb;
234              
235 0         0 return 1;
236             }
237 0         0 );
238             }
239             else {
240 2         72 my $ok = $self->store->delete($self->sid);
241 2         164 $self->_is_stored(0);
242 2         54 $self->_is_flushed(1);
243 2         12 return $ok;
244             }
245             }
246             else {
247 22         323 my $ok = 1;
248              
249 22 100       514 my $action = $self->_is_new ? 'create' : 'update';
250              
251 22         629 $self->_is_new(0);
252              
253 22 50       169 if ($self->store->is_async) {
254             $self->store->$action(
255             $self->sid,
256             $self->expires,
257             $self->data => sub {
258 0     0   0 my ($store) = @_;
259              
260 0 0       0 if ($store->error) {
261 0         0 $self->error($store->error);
262 0 0       0 return $cb ? $cb->($self) : undef;
263             }
264              
265 0         0 $self->_is_stored(1);
266 0         0 $self->_is_flushed(1);
267              
268 0 0       0 return $cb ? $cb->($self) : 1;
269             }
270 0         0 );
271             }
272             else {
273 22         880 $ok =
274             $self->store->$action($self->sid, $self->expires, $self->data);
275              
276 22 50       983 unless ($ok) {
277 0         0 $self->error($self->store->error);
278 0         0 return;
279             }
280              
281 22         525 $self->_is_stored(1);
282 22         638 $self->_is_flushed(1);
283              
284 22         139 return $ok;
285             }
286             }
287             }
288              
289             sub data {
290 60     60 1 26449 my $self = shift;
291              
292 60 100       196 if (@_ == 0) {
293 39         1159 return $self->_data;
294             }
295              
296 21 100       61 if (@_ == 1) {
297 11         314 return $self->_data->{$_[0]};
298             }
299              
300 10         44 my %params = @_;
301              
302 10         19 $self->_data({%{$self->_data}, %params});
  10         2486  
303 10         426 $self->_is_flushed(0);
304             }
305              
306             sub flash {
307 2     2 1 428 my $self = shift;
308 2         2 my ($key) = @_;
309              
310 2 50       7 return unless $key;
311              
312 2         42 $self->_is_flushed(0);
313              
314 2         13 return delete $self->data->{$key};
315             }
316              
317             sub clear {
318 3     3 1 12240 my $self = shift;
319 3         9 my ($key) = @_;
320              
321 3 100       235 if ($key) {
322 1         34 delete $self->_data->{$key};
323             }
324             else {
325 2         70 $self->_data({});
326             }
327              
328 3         96 $self->_is_flushed(0);
329             }
330              
331             sub expire {
332 2     2 1 4841 my $self = shift;
333              
334 2         9 $self->expires(0);
335              
336 2 50       18 if ($self->transport) {
337 2         43 $self->transport->tx($self->tx);
338 2         137 $self->transport->set($self->sid, $self->expires);
339             }
340              
341 2         2218 return $self;
342             }
343              
344             sub expires {
345 92     92 1 8607 my $self = shift;
346 92         140 my ($val) = @_;
347              
348 92 100       245 if (defined $val) {
349 4         104 $self->_expires($val);
350 4         107 $self->_is_flushed(0);
351             }
352              
353 92         2297 return $self->_expires;
354             }
355              
356             sub extend_expires {
357 3     3 1 1668 my $self = shift;
358              
359 3         133 $self->_expires(time + $self->expires_delta);
360              
361 3 50       259 if ($self->transport) {
362 3         41 $self->transport->tx($self->tx);
363 3         205 $self->transport->set($self->sid, $self->expires);
364             }
365              
366 3         1967 $self->_is_flushed(0);
367             }
368              
369             sub is_expired {
370 31     31 1 639 my ($self) = shift;
371              
372 31 100       120 return time > $self->expires ? 1 : 0;
373             }
374              
375             sub _remote_addr {
376 5     5   8 my $self = shift;
377              
378 5         110 return $self->tx->remote_address;
379             }
380              
381             sub _generate_sid {
382 20     20   45 my $self = shift;
383              
384             # based on CGI::Session::ID
385 20         170 my $sha1 = Digest::SHA->new(1);
386 20         1561 $sha1->add($$, time, rand(time));
387 20         876 $self->sid($sha1->hexdigest);
388             }
389              
390             1;
391             __END__