File Coverage

blib/lib/Catalyst/Plugin/Session/DynamicExpiry.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::Session::DynamicExpiry;
2 1     1   32428 use Moose;
  0            
  0            
3             use MRO::Compat;
4             use Try::Tiny;
5             use namespace::autoclean;
6              
7             our $VERSION='0.04';
8              
9             has [qw/_session_time_to_live/] => ( is => 'rw' );
10              
11             sub session_time_to_live {
12             my ( $c, @args ) = @_;
13              
14             if ( @args ) {
15             $c->_session_time_to_live($args[0]);
16             try { $c->_session->{__time_to_live} = $args[0] };
17             }
18              
19             return $c->_session_time_to_live || eval { $c->_session->{__time_to_live} };
20             }
21              
22             sub calculate_initial_session_expires {
23             my $c = shift;
24              
25             if ( defined( my $ttl = $c->_session_time_to_live ) ) {
26             $c->log->debug("Overridden time to live: $ttl") if $c->debug;
27             return time() + $ttl;
28             }
29              
30             return $c->next::method( @_ );
31             }
32              
33             sub calculate_extended_session_expires {
34             my $c = shift;
35              
36              
37             if ( defined(my $ttl = $c->session_time_to_live) ) {
38             $c->log->debug("Overridden time to live: $ttl") if $c->debug;
39             return time() + $ttl;
40             }
41              
42             return $c->next::method( @_ );
43             }
44              
45             sub _save_session {
46             my $c = shift;
47              
48             if ( my $session_data = $c->_session ) {
49             if ( defined( my $ttl = $c->_session_time_to_live ) ) {
50             $session_data->{__time_to_live} = $ttl;
51             }
52             }
53              
54             $c->next::method( @_ );
55             }
56              
57             1;
58              
59             =head1 NAME
60              
61             Catalyst::Plugin::Session::DynamicExpiry - per-session custom expiry times
62              
63             =head1 SYNOPSIS
64              
65             # put Session::DynamicExpiry in your use Catalyst line
66             # note that for this plugin to work it must appear before the Session
67             # plugin, since it overrides some of that plugin's methods.
68            
69             use Catalyst qw/ ...
70              
71             Session::DynamicExpiry
72             Session
73             /;
74            
75             if ($c->req->param('remember') {
76             $c->session_time_to_live( 604800 ) # expire in one week.
77             }
78              
79             =head1 DESCRIPTION
80              
81             This module allows you to expire session cookies indvidually per session.
82              
83             If the C<session_time_to_live> field is defined it will set expiry to that many
84             seconds into the future. Note that the session cookie is set on every request,
85             so a expiry of one week will stay as long as the user visits the site at least
86             once a week.
87              
88             Once ttl has been set for a session the ttl will be stored in the
89             C<__time_to_live> key within the session data itself, and reused for subsequent
90             request, so you only need to set this once per session (not once per request).
91              
92             This is unlike the ttl option in the config in that it allows different
93             sessions to have different times, to implement features like "remember me"
94             checkboxes.
95              
96             =head1 METHODS
97              
98             =head2 session_time_to_live $ttl
99              
100             To set the TTL for this session use this method.
101              
102             =head1 OVERRIDDEN METHODS
103              
104             =head2 calculate_initial_session_expires
105              
106             =head2 calculate_extended_session_expires
107              
108             Overridden to implement dynamic expiry functionality.
109              
110             =head1 CAVEATS
111              
112             When it just doesn't work, it's usually because you put it after
113             L<Catalyst::Plugin::Session> in the plugin list. It must go before it so that
114             it can override L<Catalyst::Plugin::Session>'s methods.
115              
116             =head1 SEE ALSO
117              
118             =head2 L<Catalyst::Plugin::Session> - The new session framework.
119              
120             =head2 L<Catalyst> - The Catalyst framework itself.
121              
122             =head1 AUTHOR
123              
124             Marcus Ramberg, C<mramberg@cpan.org>
125             Yuval Kogman
126              
127             =head1 LICENSE
128              
129             This library is free software, you can redistribute it and/or modify it under
130             the same terms as Perl itself.
131              
132             =cut