File Coverage

blib/lib/Mail/MtPolicyd/SessionCache/Redis.pm
Criterion Covered Total %
statement 6 38 15.7
branch 0 10 0.0
condition 0 3 0.0
subroutine 2 6 33.3
pod 0 2 0.0
total 8 59 13.5


line stmt bran cond sub pod time code
1             package Mail::MtPolicyd::SessionCache::Redis;
2              
3 1     1   1184 use Moose;
  1         2  
  1         6  
4              
5             our $VERSION = '2.01'; # VERSION
6             # ABSTRACT: a session cache adapter for redis
7              
8 1     1   4119 use Storable;
  1         1  
  1         385  
9              
10             extends 'Mail::MtPolicyd::SessionCache::Base';
11              
12             with 'Mail::MtPolicyd::Role::Connection' => {
13             name => 'redis',
14             type => 'Redis',
15             };
16              
17              
18             has 'expire' => ( is => 'ro', isa => 'Int', default => 5 * 60 );
19              
20             has 'lock_wait' => ( is => 'rw', isa => 'Int', default => 50 );
21             has 'lock_max_retry' => ( is => 'rw', isa => 'Int', default => 50 );
22             has 'lock_timeout' => ( is => 'rw', isa => 'Int', default => 10 );
23              
24             sub _acquire_session_lock {
25 0     0     my ( $self, $instance ) = @_;
26 0           my $lock = 'lock_'.$instance;
27              
28 0           for( my $try = 1 ; $try < $self->lock_max_retry ; $try++ ) {
29 0 0         if( $self->_redis_handle->set($lock, 1, 'EX', $self->lock_timeout, 'NX' ) ) {
30 0           return; # lock created
31             }
32 0           usleep( $self->lock_wait * $try );
33             }
34              
35 0           die('could not acquire lock for session '.$instance);
36 0           return;
37             }
38              
39             sub _release_session_lock {
40 0     0     my ( $self, $instance ) = @_;
41 0           my $lock = 'lock_'.$instance;
42              
43 0           $self->_redis_handle->del($lock);
44              
45 0           return;
46             }
47              
48             sub retrieve_session {
49 0     0 0   my ($self, $instance ) = @_;
50              
51 0 0         if( ! defined $instance ) {
52 0           return;
53             }
54              
55 0           $self->_acquire_session_lock( $instance );
56              
57 0 0         if( my $blob = $self->_redis_handle->get($instance) ) {
58 0           my $session;
59 0           eval { $session = Storage::thaw( $blob ) };
  0            
60 0 0         if( $@ ) {
61 0           die("could not restore session $instance: $@");
62             }
63 0           return($session);
64             }
65            
66 0           return( { '_instance' => $instance } );
67             }
68              
69             sub store_session {
70 0     0 0   my ($self, $session ) = @_;
71 0           my $instance = $session->{'_instance'};
72              
73 0 0 0       if( ! defined $session || ! defined $instance ) {
74 0           return;
75             }
76            
77 0           my $data = Storable::freeze( $session );
78 0           $self->_redis_handle->set($instance, $data, 'EX', $self->expire);
79              
80 0           $self->_release_session_lock($instance);
81              
82 0           return;
83             }
84              
85             1;
86              
87             __END__
88              
89             =pod
90              
91             =encoding UTF-8
92              
93             =head1 NAME
94              
95             Mail::MtPolicyd::SessionCache::Redis - a session cache adapter for redis
96              
97             =head1 VERSION
98              
99             version 2.01
100              
101             =head1 SYNOPSIS
102              
103             <SessionCache>
104             module = "Redis"
105             #redis = "redis"
106             # expire session cache entries
107             expire = "300"
108             # wait timeout will be increased each time 50,100,150,... (usec)
109             lock_wait=50
110             # abort after n retries
111             lock_max_retry=50
112             # session lock times out after (sec)
113             lock_timeout=10
114             </SessionCache>
115              
116             =head1 PARAMETERS
117              
118             =over
119              
120             =item redis (default: redis)
121              
122             Name of the database connection to use.
123              
124             You have to define this connection first.
125              
126             see L<Mail::MtPolicyd::Connection::Redis>
127              
128             =item expire (default: 5*60)
129              
130             Timeout in seconds for sessions.
131              
132             =item lock_wait (default: 50)
133              
134             Timeout for retry when session is locked in milliseconds.
135              
136             The retry will be done in multiples of this timeout.
137              
138             When set to 50 retry will be done in 50, 100, 150ms...
139              
140             =item lock_max_retry (default: 50)
141              
142             Maximum number of retries before giving up to obtain lock on a
143             session.
144              
145             =item lock_timeout (default: 10)
146              
147             Timeout of session locks in seconds.
148              
149             =back
150              
151             =head1 AUTHOR
152              
153             Markus Benning <ich@markusbenning.de>
154              
155             =head1 COPYRIGHT AND LICENSE
156              
157             This software is Copyright (c) 2014 by Markus Benning <ich@markusbenning.de>.
158              
159             This is free software, licensed under:
160              
161             The GNU General Public License, Version 2, June 1991
162              
163             =cut