File Coverage

blib/lib/MojoX/Session/Store/Libmemcached.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package MojoX::Session::Store::Libmemcached;
2             $MojoX::Session::Store::Libmemcached::VERSION = 0.17;
3              
4 1     1   22820 use strict;
  1         3  
  1         49  
5 1     1   7 use warnings;
  1         2  
  1         38  
6              
7 1     1   5 use base 'MojoX::Session::Store';
  1         6  
  1         7370  
8              
9 1     1   30627 use Memcached::libmemcached;
  0            
  0            
10             use MIME::Base64;
11             use Storable qw/nfreeze thaw/;
12              
13             __PACKAGE__->attr('servers');
14             __PACKAGE__->attr('_handle' => sub { Memcached::libmemcached->new });
15             __PACKAGE__->attr('___expiration___');
16              
17             sub new {
18             my $class = shift;
19              
20             my $self = $class->SUPER::new(@_);
21             bless $self, $class;
22              
23             my $servers = ref $self->servers ?
24             $self->servers : [ split(/ /, $self->servers) ];
25              
26             foreach my $server (@$servers) {
27             my ($host, $port) = split(/:/, $server);
28              
29             unless ($self->_handle->memcached_server_add($host, $port)) {
30             print STDERR "failed to add server $host:$port\n";
31             }
32             }
33              
34             return $self;
35             }
36              
37             sub create {
38             my ($self, $sid, $expires, $data) = @_;
39              
40             if ($data) {
41             $data->{___expiration___} = $expires;
42             $data = encode_base64(nfreeze($data));
43             }
44              
45             return $self->_handle->memcached_set($sid, $data, $expires);
46             }
47              
48             sub update {
49             my ($self, $sid, $expires, $data) = @_;
50              
51             if ($data) {
52             $data->{___expiration___} = $expires;
53             $data = encode_base64(nfreeze($data));
54             }
55              
56             return $self->_handle->memcached_replace($sid, $data, $expires);
57             }
58              
59             sub load {
60             my ($self, $sid) = @_;
61              
62             my $data_base64 = $self->_handle->memcached_get($sid);
63             return unless $data_base64;
64              
65             my $data = thaw(decode_base64($data_base64));
66              
67             $self->___expiration___(delete $data->{___expiration___});
68              
69             return ($self->___expiration___, $data);
70             }
71              
72             sub delete {
73             my ($self, $sid) = @_;
74              
75             return $self->_handle->memcached_delete($sid);
76             }
77              
78             1;
79             __END__