File Coverage

lib/Catalyst/Plugin/Session/Store/RedisFast.pm
Criterion Covered Total %
statement 59 71 83.1
branch 11 18 61.1
condition 0 5 0.0
subroutine 13 16 81.2
pod 0 6 0.0
total 83 116 71.5


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::Session::Store::RedisFast;
2              
3 1     1   1939380 use strict;
  1         3  
  1         37  
4 1     1   6 use warnings;
  1         2  
  1         35  
5 1     1   7 use utf8;
  1         2  
  1         8  
6              
7 1     1   618 use MIME::Base64 qw/encode_base64 decode_base64/;
  1         790  
  1         86  
8 1     1   634 use Redis::Fast;
  1         5430  
  1         34  
9 1     1   651 use CBOR::XS qw/encode_cbor decode_cbor/;
  1         4675  
  1         71  
10 1     1   10 use Carp qw/croak/;
  1         2  
  1         55  
11              
12 1         969 use base qw/
13             Catalyst::Plugin::Session::Store
14             Class::Data::Inheritable
15 1     1   7 /;
  1         2  
16              
17             our $VERSION = '0.03';
18              
19             __PACKAGE__->mk_classdata(qw/_session_redis_storage/);
20              
21             sub get_session_data {
22 3     3 0 8 my ($c, $key) = @_;
23              
24 3 100       20 if (my ($sid) = $key =~ /^expires:(.*)/) {
25             #Return TTL of key
26 2         10 my $ttl = $c->_redis_op('ttl', "session:$sid");
27 2         5 my $exp_time = time() + $ttl;
28 2         7 $c->log->debug("Getting expires key for '$sid'. TTl: $ttl. Expire time: $exp_time");
29 2         803 return $exp_time;
30             }
31              
32 1         6 $c->log->debug("Getting '$key'");
33 1 50       379 my $data = $c->_redis_op('get', $key) or return;
34              
35 1         11 return decode_cbor(decode_base64($data));
36             }
37              
38             sub store_session_data {
39 7     7 0 1700 my ($c, $key, $value) = @_;
40              
41 7 100       41 if (my ($sid) = $key =~ /^expires:(.*)/) {
42             # Store expires for key
43 3         6 my $ttl = $value - time();
44 3         11 $c->log->debug("Set expires to sid '$sid'. TTL: $ttl");
45              
46 3 100       1201 if ($c->_redis_op('exists', "session:$sid")) {
47 1         15 $c->set_session_ttl("session:$sid", $ttl);
48             }
49             else {
50 2         9 $c->_redis_op('set', "session:$sid", '', 'EX', $ttl);
51             }
52 3         14 return 1;
53             }
54              
55 4         19 $c->log->debug("Store session data to '$key'");
56 4         1784 my $ttl = $c->_redis_op('ttl', $key);
57             # If key not exists
58 4 100       16 $ttl = $c->session_expires - time() if $ttl < 0;
59              
60             # Update key with ttl
61 4 50       14 if ($ttl > 0) {
62 4         28 $c->_redis_op('set', $key, encode_base64(encode_cbor($value)), 'EX', $ttl);
63             }
64              
65 4         17 return 1;
66             }
67              
68             sub set_session_ttl {
69 1     1 0 3 my ($c, $key, $ttl) = @_;
70 1         3 $c->_redis_op('expire', $key, $ttl);
71              
72             }
73              
74             sub delete_session_data {
75 1     1 0 4 my ($c, $key) = @_;
76              
77 1         5 $c->log->debug("Deleting key: '$key'");
78 1         393 return $c->_redis_op('del', $key);
79             }
80              
81       0 0   sub delete_expired_sessions {
82             # Null op, Redis handles this for us!
83             }
84              
85             sub setup_session {
86 0     0 0 0 my ($c) = @_;
87              
88 0         0 $c->maybe::next::method(@_);
89             }
90              
91             sub _verify_redis_connect {
92 0     0   0 my ($c) = @_;
93              
94 0         0 my $cfg = $c->_session_plugin_config;
95 0 0       0 croak "Config not contains 'redis_config' section" if not $cfg->{redis_config};
96              
97 0   0     0 my $redis_db = delete $cfg->{redis_config}->{redis_db} // 0;
98              
99 0 0 0     0 if ((not $c->_session_redis_storage) or (not $c->_session_redis_storage->ping)) {
100             $c->_session_redis_storage(Redis::Fast->new(
101 0         0 %{$cfg->{redis_config}},
  0         0  
102             )
103             );
104 0         0 $c->_session_redis_storage->select($redis_db);
105             }
106             }
107              
108             sub _redis_op {
109             #Execute Redis operation
110 18     18   50 my ($c, $op, @args) = @_;
111 18         25 my $retry_count = 10;
112 18         41 while (--$retry_count > 0) {
113 18         27 my $res = eval {$c->_session_redis_storage->$op(@args)};
  18         46  
114 18 50       3215 if ($@) {
115 0         0 $c->_verify_redis_connect;
116             }
117             else {
118 18         65 return $res;
119             }
120             }
121 0           die $@;
122             }
123              
124             1;
125              
126             __END__
127              
128             =pod
129              
130             =encoding UTF-8
131              
132             =head1 NAME
133              
134             Catalyst::Plugin::Session::Store::RedisFast - Redis Session store for Catalyst framework
135              
136             =head1 VERSION
137              
138             version 0.03
139              
140             =head1 SYNOPSYS
141              
142             use Catalyst qw/
143             Session
144             Session::Store::RedisFast
145             /;
146              
147             # Use single instance of Redis
148             MyApp->config->{Plugin::Session} = {
149             expires => 3600,
150             redis_config => {
151             server => '127.0.0.1:6300',
152             },
153             };
154              
155             # or
156             # Use Redis Sentinel
157             MyApp->config->{Plugin::Session} = {
158             expires => 3600,
159             redis_config => {
160             sentinels => [
161             '192.168.136.90:26379',
162             '192.168.136.91:26379',
163             '192.168.136.92:26379',
164             ],
165             reconnect => 1000,
166             every => 100_000,
167             service => 'master01',
168             sentinels_cnx_timeout => 0.1,
169             sentinels_read_timeout => 1,
170             sentinels_write_timeout => 1,
171             redis_db => 0,
172             },
173             };
174              
175             # ... in an action:
176             $c->session->{foo} = 'bar'; # will be saved
177              
178             =head1 DESCRIPTION
179              
180             C<Catalyst::Plugin::Session::Store::RedisFast> - is a session storage plugin for Catalyst that uses the Redis::Fast as Redis storage module and CBOR::XS as serializing/deserealizing prel data to string
181              
182             =head2 CONFIGURATIN
183              
184             =head3 redis_config
185              
186             Options save as L<Redis::Fast>
187              
188             =head3 expires
189              
190             Default ttl time to session keys
191              
192             =head1 DEPENDENCE
193              
194             L<Redis::Fast>, L<CBOR::XS>, L<MIME::Base64>
195              
196             =head1 AUTHORS
197              
198             =over 4
199              
200             =item *
201              
202             Pavel Andryushin <vrag867@gmail.com>
203              
204             =back
205              
206             =head1 COPYRIGHT AND LICENSE
207              
208             This software is copyright (c) 2020 by Pavel Andryushin.
209              
210             This is free software; you can redistribute it and/or modify it under
211             the same terms as the Perl 5 programming language system itself.
212              
213             =cut
214              
215             =cut
216