File Coverage

blib/lib/MojoX/Session.pm
Criterion Covered Total %
statement 157 190 82.6
branch 58 102 56.8
condition 6 11 54.5
subroutine 26 29 89.6
pod 13 13 100.0
total 260 345 75.3


line stmt bran cond sub pod time code
1             package MojoX::Session;
2              
3 15     15   26577 use strict;
  15         28  
  15         604  
4 15     15   66 use warnings;
  15         25  
  15         752  
5              
6             our $VERSION = '0.33';
7              
8 15     15   70 use base 'Mojo::Base';
  15         28  
  15         4803  
9              
10 15     15   69059 use Mojo::Loader;
  15         465423  
  15         698  
11 15     15   5607 use Mojo::ByteStream;
  15         30309  
  15         510  
12 15     15   4838 use Mojo::Transaction::HTTP;
  15         816686  
  15         129  
13 15     15   7685 use MojoX::Session::Transport::Cookie;
  15         41  
  15         143  
14 15     15   428 use Digest::SHA;
  15         20  
  15         27423  
15              
16             my $PRIVATE_IP_FIELD = 'mojox.session.ip_address';
17              
18             __PACKAGE__->attr(loader => sub { my $l; eval { $l = Mojo::Loader->new }; $l });
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 20410 my $class = shift;
38 20         120 my %args = @_;
39              
40 20         55 my $store = delete $args{store};
41 20         43 my $transport = delete $args{transport};
42              
43 20         147 my $self = $class->SUPER::new(%args);
44              
45 20         193 $self->_store($self->_instance(Store => $store));
46 20         159 $self->_transport($self->_instance(Transport => $transport));
47              
48 20         155 return $self;
49             }
50              
51             sub store {
52 100     100 1 108 my $self = shift;
53              
54 100 50       1868 return $self->_store if @_ == 0;
55              
56 0         0 $self->_store($self->_instance(Store => shift));
57             }
58              
59             sub transport {
60 136     136 1 2001413 my $self = shift;
61              
62 136 50       2503 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   23 my $self = shift;
69 17         28 my ($namespace, $name, $args) = @_;
70              
71 17         115 my $class = join('::',
72             __PACKAGE__, $namespace, Mojo::ByteStream->new($name)->camelize);
73              
74 17 50       1423 my $rv = $self->loader ? $self->loader->load($class) : Mojo::Loader::load_class($class);
75              
76 17 50       3971 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       30 return $class->new(%{$args || {}});
  17         187  
83             }
84              
85             sub _instance {
86 40     40   56 my $self = shift;
87 40         91 my ($namespace, $instance) = @_;
88              
89 40 100       299 return unless $instance;
90              
91 31 50       162 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         40 $instance = $self->_load_and_build($namespace, $instance);
102             }
103              
104 31         823 return $instance;
105             }
106              
107             sub create {
108 20     20 1 6713 my $self = shift;
109 20         33 my ($cb) = @_;
110              
111 20         448 $self->_expires(time + $self->expires_delta);
112              
113 20         1104 $self->_is_new(1);
114              
115 20 100       480 if ($self->ip_match) {
116 1         8 $self->data($PRIVATE_IP_FIELD, $self->_remote_addr);
117             }
118              
119 20         228 $self->_generate_sid;
120              
121 20 50       642 if ($self->transport) {
122 20         239 $self->transport->tx($self->tx);
123 20         994 $self->transport->set($self->sid, $self->expires);
124             }
125              
126 20         7321 $self->_is_flushed(0);
127              
128 20 50       163 return $cb->($self, $self->sid) if $cb;
129              
130 20         382 return $self->sid;
131             }
132              
133             sub load {
134 19     19 1 5390 my $self = shift;
135 19         28 my ($sid, $cb) = @_;
136              
137 19 50       59 ($cb, $sid) = ($sid, undef) if ref $sid eq 'CODE';
138              
139 19         354 $self->sid(undef);
140 19         381 $self->_expires(0);
141 19         337 $self->_data({});
142              
143 19 50       115 if ($self->transport) {
144 19         134 $self->transport->tx($self->tx);
145             }
146              
147 19 100       772 unless ($sid) {
148 7         16 $sid = $self->transport->get;
149 7 50       135 return $cb ? $cb->($self) : undef unless $sid;
    100          
150             }
151              
152 17 50       35 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         436 my ($expires, $data) = $self->store->load($sid);
172              
173 17 50 0     558 return $self->error($self->store->error) && undef
174             if $self->store->error;
175              
176 17         472 my $sid = $self->_on_load($sid, $expires, $data);
177              
178 17 100       101 return unless $sid;
179              
180 11         54 return $sid;
181             }
182             }
183              
184             sub _on_load {
185 17     17   24 my $self = shift;
186 17         27 my ($sid, $expires, $data) = @_;
187              
188 17 100 66     78 unless (defined $expires && defined $data) {
189 5 50       18 $self->transport->set($sid, time - 30 * 24 * 3600)
190             if $self->transport;
191 5         434 return;
192             }
193              
194 12         241 $self->_expires($expires);
195 12         245 $self->_data($data);
196              
197 12 100       224 if ($self->ip_match) {
198 2 50       12 return unless $self->_remote_addr;
199              
200 2 50       110 return unless $self->data($PRIVATE_IP_FIELD);
201              
202 2 100       12 return unless $self->_remote_addr eq $self->data($PRIVATE_IP_FIELD);
203             }
204              
205 11         235 $self->sid($sid);
206              
207 11         193 $self->_is_stored(1);
208              
209 11         198 return $self->sid;
210             }
211              
212             sub flush {
213 25     25 1 2624 my $self = shift;
214 25         39 my ($cb) = @_;
215              
216 25 50 66     527 return $cb ? $cb->($self) : 1 unless $self->sid && !$self->_is_flushed;
    100          
217              
218 24 100 66     770 if ($self->is_expired && $self->_is_stored) {
219 2 50       71 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         60 my $ok = $self->store->delete($self->sid);
241 2         137 $self->_is_stored(0);
242 2         49 $self->_is_flushed(1);
243 2         13 return $ok;
244             }
245             }
246             else {
247 22         276 my $ok = 1;
248              
249 22 100       416 my $action = $self->_is_new ? 'create' : 'update';
250              
251 22         559 $self->_is_new(0);
252              
253 22 50       136 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         747 $ok =
274             $self->store->$action($self->sid, $self->expires, $self->data);
275              
276 22 50       811 unless ($ok) {
277 0         0 $self->error($self->store->error);
278 0         0 return;
279             }
280              
281 22         439 $self->_is_stored(1);
282 22         517 $self->_is_flushed(1);
283              
284 22         116 return $ok;
285             }
286             }
287             }
288              
289             sub data {
290 60     60 1 8957 my $self = shift;
291              
292 60 100       168 if (@_ == 0) {
293 39         829 return $self->_data;
294             }
295              
296 21 100       46 if (@_ == 1) {
297 11         263 return $self->_data->{$_[0]};
298             }
299              
300 10         30 my %params = @_;
301              
302 10         11 $self->_data({%{$self->_data}, %params});
  10         236  
303 10         245 $self->_is_flushed(0);
304             }
305              
306             sub flash {
307 2     2 1 392 my $self = shift;
308 2         5 my ($key) = @_;
309              
310 2 50       14 return unless $key;
311              
312 2         69 $self->_is_flushed(0);
313              
314 2         18 return delete $self->data->{$key};
315             }
316              
317             sub clear {
318 3     3 1 367 my $self = shift;
319 3         6 my ($key) = @_;
320              
321 3 100       7 if ($key) {
322 1         15 delete $self->_data->{$key};
323             }
324             else {
325 2         38 $self->_data({});
326             }
327              
328 3         68 $self->_is_flushed(0);
329             }
330              
331             sub expire {
332 2     2 1 920 my $self = shift;
333              
334 2         7 $self->expires(0);
335              
336 2 50       43 if ($self->transport) {
337 2         16 $self->transport->tx($self->tx);
338 2         111 $self->transport->set($self->sid, $self->expires);
339             }
340              
341 2         339 return $self;
342             }
343              
344             sub expires {
345 92     92 1 5665 my $self = shift;
346 92         106 my ($val) = @_;
347              
348 92 100       195 if (defined $val) {
349 4         76 $self->_expires($val);
350 4         71 $self->_is_flushed(0);
351             }
352              
353 92         1707 return $self->_expires;
354             }
355              
356             sub extend_expires {
357 3     3 1 1609 my $self = shift;
358              
359 3         190 $self->_expires(time + $self->expires_delta);
360              
361 3 50       192 if ($self->transport) {
362 3         26 $self->transport->tx($self->tx);
363 3         157 $self->transport->set($self->sid, $self->expires);
364             }
365              
366 3         531 $self->_is_flushed(0);
367             }
368              
369             sub is_expired {
370 31     31 1 548 my ($self) = shift;
371              
372 31 100       83 return time > $self->expires ? 1 : 0;
373             }
374              
375             sub _remote_addr {
376 5     5   6 my $self = shift;
377              
378 5         73 return $self->tx->remote_address;
379             }
380              
381             sub _generate_sid {
382 20     20   36 my $self = shift;
383              
384             # based on CGI::Session::ID
385 20         159 my $sha1 = Digest::SHA->new(1);
386 20         1399 $sha1->add($$, time, rand(time));
387 20         867 $self->sid($sha1->hexdigest);
388             }
389              
390             1;
391             __END__