File Coverage

lib/Plack/Session/Store/RedisFast.pm
Criterion Covered Total %
statement 35 84 41.6
branch 4 30 13.3
condition 1 11 9.0
subroutine 10 15 66.6
pod 5 5 100.0
total 55 145 37.9


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