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   29411 use strict;
  15         21  
  15         601  
4 15     15   68 use warnings;
  15         19  
  15         766  
5              
6             our $VERSION = '0.32';
7              
8 15     15   66 use base 'Mojo::Base';
  15         24  
  15         4455  
9              
10 15     15   62896 use Mojo::Loader;
  15         441514  
  15         173  
11 15     15   5693 use Mojo::ByteStream;
  15         28858  
  15         623  
12 15     15   4836 use Mojo::Transaction::HTTP;
  15         760842  
  15         123  
13 15     15   7725 use MojoX::Session::Transport::Cookie;
  15         40  
  15         127  
14 15     15   400 use Digest::SHA;
  15         19  
  15         24579  
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 14924 my $class = shift;
38 20         74 my %args = @_;
39              
40 20         47 my $store = delete $args{store};
41 20         29 my $transport = delete $args{transport};
42              
43 20         120 my $self = $class->SUPER::new(%args);
44              
45 20         157 $self->_store($self->_instance(Store => $store));
46 20         136 $self->_transport($self->_instance(Transport => $transport));
47              
48 20         137 return $self;
49             }
50              
51             sub store {
52 100     100 1 111 my $self = shift;
53              
54 100 50       1677 return $self->_store if @_ == 0;
55              
56 0         0 $self->_store($self->_instance(Store => shift));
57             }
58              
59             sub transport {
60 136     136 1 2001536 my $self = shift;
61              
62 136 50       2417 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   24 my $self = shift;
69 17         22 my ($namespace, $name, $args) = @_;
70              
71 17         114 my $class = join('::',
72             __PACKAGE__, $namespace, Mojo::ByteStream->new($name)->camelize);
73              
74 17         1326 my $rv = $self->loader->load($class);
75              
76 17 50       3711 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       27 return $class->new(%{$args || {}});
  17         181  
83             }
84              
85             sub _instance {
86 40     40   47 my $self = shift;
87 40         51 my ($namespace, $instance) = @_;
88              
89 40 100       284 return unless $instance;
90              
91 31 50       148 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         44 $instance = $self->_load_and_build($namespace, $instance);
102             }
103              
104 31         749 return $instance;
105             }
106              
107             sub create {
108 20     20 1 6006 my $self = shift;
109 20         34 my ($cb) = @_;
110              
111 20         365 $self->_expires(time + $self->expires_delta);
112              
113 20         726 $self->_is_new(1);
114              
115 20 100       489 if ($self->ip_match) {
116 1         13 $self->data($PRIVATE_IP_FIELD, $self->_remote_addr);
117             }
118              
119 20         183 $self->_generate_sid;
120              
121 20 50       539 if ($self->transport) {
122 20         188 $self->transport->tx($self->tx);
123 20         714 $self->transport->set($self->sid, $self->expires);
124             }
125              
126 20         5922 $self->_is_flushed(0);
127              
128 20 50       121 return $cb->($self, $self->sid) if $cb;
129              
130 20         304 return $self->sid;
131             }
132              
133             sub load {
134 19     19 1 6403 my $self = shift;
135 19         29 my ($sid, $cb) = @_;
136              
137 19 50       87 ($cb, $sid) = ($sid, undef) if ref $sid eq 'CODE';
138              
139 19         375 $self->sid(undef);
140 19         385 $self->_expires(0);
141 19         386 $self->_data({});
142              
143 19 50       113 if ($self->transport) {
144 19         150 $self->transport->tx($self->tx);
145             }
146              
147 19 100       901 unless ($sid) {
148 7         19 $sid = $self->transport->get;
149 7 50       150 return $cb ? $cb->($self) : undef unless $sid;
    100          
150             }
151              
152 17 50       52 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         446 my ($expires, $data) = $self->store->load($sid);
172              
173 17 50 0     523 return $self->error($self->store->error) && undef
174             if $self->store->error;
175              
176 17         438 my $sid = $self->_on_load($sid, $expires, $data);
177              
178 17 100       105 return unless $sid;
179              
180 11         53 return $sid;
181             }
182             }
183              
184             sub _on_load {
185 17     17   23 my $self = shift;
186 17         28 my ($sid, $expires, $data) = @_;
187              
188 17 100 66     98 unless (defined $expires && defined $data) {
189 5 50       21 $self->transport->set($sid, time - 30 * 24 * 3600)
190             if $self->transport;
191 5         530 return;
192             }
193              
194 12         222 $self->_expires($expires);
195 12         241 $self->_data($data);
196              
197 12 100       303 if ($self->ip_match) {
198 2 50       61 return unless $self->_remote_addr;
199              
200 2 50       208 return unless $self->data($PRIVATE_IP_FIELD);
201              
202 2 100       22 return unless $self->_remote_addr eq $self->data($PRIVATE_IP_FIELD);
203             }
204              
205 11         254 $self->sid($sid);
206              
207 11         249 $self->_is_stored(1);
208              
209 11         199 return $self->sid;
210             }
211              
212             sub flush {
213 25     25 1 2419 my $self = shift;
214 25         37 my ($cb) = @_;
215              
216 25 50 66     451 return $cb ? $cb->($self) : 1 unless $self->sid && !$self->_is_flushed;
    100          
217              
218 24 100 66     687 if ($self->is_expired && $self->_is_stored) {
219 2 50       52 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         46 my $ok = $self->store->delete($self->sid);
241 2         101 $self->_is_stored(0);
242 2         33 $self->_is_flushed(1);
243 2         8 return $ok;
244             }
245             }
246             else {
247 22         203 my $ok = 1;
248              
249 22 100       360 my $action = $self->_is_new ? 'create' : 'update';
250              
251 22         445 $self->_is_new(0);
252              
253 22 50       113 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         657 $ok =
274             $self->store->$action($self->sid, $self->expires, $self->data);
275              
276 22 50       693 unless ($ok) {
277 0         0 $self->error($self->store->error);
278 0         0 return;
279             }
280              
281 22         362 $self->_is_stored(1);
282 22         416 $self->_is_flushed(1);
283              
284 22         103 return $ok;
285             }
286             }
287             }
288              
289             sub data {
290 60     60 1 9478 my $self = shift;
291              
292 60 100       151 if (@_ == 0) {
293 39         747 return $self->_data;
294             }
295              
296 21 100       44 if (@_ == 1) {
297 11         270 return $self->_data->{$_[0]};
298             }
299              
300 10         29 my %params = @_;
301              
302 10         12 $self->_data({%{$self->_data}, %params});
  10         195  
303 10         230 $self->_is_flushed(0);
304             }
305              
306             sub flash {
307 2     2 1 366 my $self = shift;
308 2         3 my ($key) = @_;
309              
310 2 50       5 return unless $key;
311              
312 2         42 $self->_is_flushed(0);
313              
314 2         9 return delete $self->data->{$key};
315             }
316              
317             sub clear {
318 3     3 1 500 my $self = shift;
319 3         5 my ($key) = @_;
320              
321 3 100       6 if ($key) {
322 1         15 delete $self->_data->{$key};
323             }
324             else {
325 2         44 $self->_data({});
326             }
327              
328 3         55 $self->_is_flushed(0);
329             }
330              
331             sub expire {
332 2     2 1 1221 my $self = shift;
333              
334 2         7 $self->expires(0);
335              
336 2 50       14 if ($self->transport) {
337 2         18 $self->transport->tx($self->tx);
338 2         118 $self->transport->set($self->sid, $self->expires);
339             }
340              
341 2         503 return $self;
342             }
343              
344             sub expires {
345 92     92 1 5405 my $self = shift;
346 92         99 my ($val) = @_;
347              
348 92 100       179 if (defined $val) {
349 4         95 $self->_expires($val);
350 4         81 $self->_is_flushed(0);
351             }
352              
353 92         1551 return $self->_expires;
354             }
355              
356             sub extend_expires {
357 3     3 1 1296 my $self = shift;
358              
359 3         173 $self->_expires(time + $self->expires_delta);
360              
361 3 50       97 if ($self->transport) {
362 3         30 $self->transport->tx($self->tx);
363 3         160 $self->transport->set($self->sid, $self->expires);
364             }
365              
366 3         727 $self->_is_flushed(0);
367             }
368              
369             sub is_expired {
370 31     31 1 343 my ($self) = shift;
371              
372 31 100       65 return time > $self->expires ? 1 : 0;
373             }
374              
375             sub _remote_addr {
376 5     5   8 my $self = shift;
377              
378 5         125 return $self->tx->remote_address;
379             }
380              
381             sub _generate_sid {
382 20     20   27 my $self = shift;
383              
384             # based on CGI::Session::ID
385 20         127 my $sha1 = Digest::SHA->new(1);
386 20         1132 $sha1->add($$, time, rand(time));
387 20         630 $self->sid($sha1->hexdigest);
388             }
389              
390             1;
391             __END__