File Coverage

blib/lib/Dancer/Session.pm
Criterion Covered Total %
statement 46 46 100.0
branch 12 16 75.0
condition 5 5 100.0
subroutine 11 11 100.0
pod 0 6 0.0
total 74 84 88.1


line stmt bran cond sub pod time code
1             package Dancer::Session;
2             our $AUTHORITY = 'cpan:SUKRIA';
3             #ABSTRACT: session engine for the Dancer framework
4             $Dancer::Session::VERSION = '1.3520';
5 184     184   143593 use strict;
  184         499  
  184         5791  
6 184     184   983 use warnings;
  184         476  
  184         4636  
7              
8 184     184   968 use Carp;
  184         503  
  184         10695  
9 184     184   81912 use Dancer::Cookies;
  184         528  
  184         5651  
10 184     184   1386 use Dancer::Engine;
  184         429  
  184         78465  
11              
12             # Singleton representing the session engine class to use
13             my $ENGINE = undef;
14 485     485 0 1858 sub engine {$ENGINE}
15              
16             # This wrapper look for the session engine and try to load it.
17             sub init {
18 97     97 0 1521 my ($class, $name, $config) = @_;
19 97         831 $ENGINE = Dancer::Engine->build(session => $name, $config);
20              
21             #$ENGINE->init(); already done
22             }
23              
24             # retrieve or create a session for the client
25             sub get_current_session {
26 177     177 0 277 shift;
27 177         337 my %p = @_;
28 177         436 my $sid = engine->read_session_id;
29 177         335 my $session = undef;
30 177         363 my $class = ref(engine);
31              
32 177   100     557 my $sessions = Dancer::SharedData->sessions || {};
33 177         642 my $name = $class->session_name();
34 177 100 100     898 if ($sid and $session = $sessions->{$name}{$sid}) {
35 80         297 return $session;
36             }
37            
38 97 100       423 $session = $class->retrieve($sid) if $sid;
39              
40 97 100       329 if (not defined $session) {
41 34         195 $session = $class->create();
42             }
43              
44 97         399 $sessions->{$name}{$session->id} = $session;
45 97         388 Dancer::SharedData->sessions($sessions);
46              
47             # Generate a session cookie; we want to do this regardless of whether the
48             # session is new or existing, so that the cookie expiry is updated.
49             engine->write_session_id($session->id)
50 97 100       370 unless $p{no_update};
51              
52 97         400 return $session;
53             }
54              
55 132     132 0 364 sub get { get_current_session(@_) }
56              
57             sub read {
58 8     8 0 35 my ($class, $key) = @_;
59 8 50       20 return unless $key;
60 8         39 my $session = get_current_session();
61 8         56 return $session->get_value($key);
62             }
63              
64             sub write {
65 8     8 0 26 my ($class, $key, $value) = @_;
66              
67 8 50       26 return unless $key;
68 8 50       27 $key eq 'id' and croak 'Can\'t store to session key with name "id"';
69              
70 8         21 my $session = get_current_session();
71 8         51 $session->set_value($key, $value);
72              
73             # TODO : should be moved as an "after" filter
74 8 50       35 $session->flush unless $session->is_lazy;
75 8         26 return $value;
76             }
77              
78             1;
79              
80             __END__