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__ |