File Coverage

lib/Plack/Session/Store/RedisFast.pm
Criterion Covered Total %
statement 36 87 41.3
branch 6 34 17.6
condition 0 9 0.0
subroutine 10 15 66.6
pod 5 5 100.0
total 57 150 38.0


line stmt bran cond sub pod time code
1             package Plack::Session::Store::RedisFast;
2              
3 2     2   144794 use strict;
  2         6  
  2         66  
4 2     2   13 use warnings;
  2         5  
  2         69  
5              
6 2     2   60 use 5.008_005;
  2         7  
7              
8 2     2   18 use Carp qw( carp );
  2         10  
  2         427  
9 2     2   553 use Plack::Util::Accessor qw( prefix redis encoder expires );
  2         260  
  2         12  
10 2     2   1188 use Time::Seconds qw( ONE_MONTH );
  2         5480  
  2         151  
11              
12 2     2   540 use parent 'Plack::Session::Store';
  2         266  
  2         18  
13              
14 2     2   1835 use constant SESSIONS_PER_SCAN => 100;
  2         6  
  2         1686  
15              
16             our $VERSION = '0.05';
17             our $AUTHORITY = 'cpan:AKZHAN';
18              
19             sub new {
20 2     2 1 45 my ( $class, %param ) = @_;
21 2 50       20 $param{prefix} = __PACKAGE__ . ':' unless defined $param{prefix};
22 2 50       12 if ( exists $param{expire} ) {
23 0         0 warn __PACKAGE__
24             . ": DEPRECATED expire. Should be replaced with expires.";
25 0         0 $param{expires} = delete $param{expire};
26             }
27 2 50       16 $param{expires} = ONE_MONTH unless exists $param{expires};
28              
29 2 50       12 unless ( defined $param{redis} ) {
30 2         10 $param{redis} = \&_build_redis;
31             }
32              
33 2 50       19 if ( ref( $param{redis} ) eq 'CODE' ) {
34 2         13 $param{redis} = $param{redis}->();
35             }
36              
37             $param{encoder} ||=
38 0   0     0 _build_encoder( ( delete $param{inflate} ), ( delete $param{deflate} ) );
39              
40             $param{encoder} = $param{encoder}->new()
41 0 0       0 unless ref( $param{encoder} );
42              
43 0         0 bless {%param} => $class;
44             }
45              
46             sub _build_redis {
47 2     2   8 my $instance;
48             eval {
49 2         1448 require Redis::Fast;
50 2         27903 $instance = Redis::Fast->new;
51 0         0 1;
52 2 50       7 } or do {
53 2         2356 require Redis;
54 0           $instance = Redis->new;
55             };
56 0           $instance;
57             }
58              
59             sub _build_encoder {
60 0     0     my ( $inflate, $deflate ) = @_;
61 0 0 0       if ( $inflate && $deflate ) {
62 0           require Plack::Session::Store::RedisFast::Encoder::Custom;
63 0           return Plack::Session::Store::RedisFast::Encoder::Custom->new( $inflate,
64             $deflate );
65             }
66 0           my $instance;
67             eval {
68 0           require Plack::Session::Store::RedisFast::Encoder::JSONXS;
69 0           $instance = Plack::Session::Store::RedisFast::Encoder::JSONXS->new;
70 0           1;
71             } or do {
72 0           require Plack::Session::Store::RedisFast::Encoder::MojoJSON;
73 0           $instance = Plack::Session::Store::RedisFast::Encoder::MojoJSON->new;
74             }
75 0 0 0       or do {
76 0           require Plack::Session::Store::RedisFast::Encoder::JSON;
77 0           $instance = Plack::Session::Store::RedisFast::Encoder::JSON->new;
78             };
79 0           $instance;
80             }
81              
82             sub fetch {
83 0     0 1   my ( $self, $session_id ) = @_;
84 0           my $data = $self->redis->get( $self->prefix . $session_id );
85 0 0         return undef unless defined $data;
86 0           $self->encoder->decode($data);
87             }
88              
89             sub store {
90 0     0 1   my ( $self, $session_id, $session ) = @_;
91 0 0         unless ( defined $session ) {
92 0           carp "store: no session provided";
93 0           return;
94             }
95 0           my $data = $self->encoder->encode($session);
96 0 0         $self->redis->set(
97             $self->prefix . $session_id => $data,
98             ( defined( $self->expires ) ? ( EX => $self->expires ) : () ),
99             );
100 0           1;
101             }
102              
103             sub remove {
104 0     0 1   my ( $self, $session_id ) = @_;
105 0           $self->redis->del( $self->prefix . $session_id );
106 0           1;
107             }
108              
109             sub each_session {
110 0     0 1   my ( $self, $cb ) = @_;
111 0 0         return if ref($cb) ne 'CODE';
112              
113 0           my $prefix = $self->prefix;
114              
115 0           my $cursor = 0;
116 0           for ( ; ; ) {
117 0           ( $cursor, my $keys ) = $self->redis->scan(
118             $cursor,
119             MATCH => $self->prefix . '*',
120             COUNT => SESSIONS_PER_SCAN
121             );
122 0 0         if ( scalar(@$keys) > 0 ) {
123 0           my @sessions = $self->redis->mget(@$keys);
124              
125 0           for ( my $i = 0 ; $i < scalar(@sessions) ; $i++ ) {
126 0 0         next unless $sessions[$i];
127              
128 0 0         next if $keys->[$i] !~ m/^\Q$prefix\E(.+)$/;
129 0           my $session_id = $1;
130              
131 0           $cb->(
132             $self->redis, $prefix, $session_id,
133             $self->encoder->decode( $sessions[$i] ),
134             );
135             }
136             }
137              
138 0 0         last if $cursor == 0;
139             }
140 0           1;
141             }
142              
143             1;
144              
145             __END__