File Coverage

blib/lib/Dancer/Session/Memcached.pm
Criterion Covered Total %
statement 34 41 82.9
branch 4 4 100.0
condition n/a
subroutine 9 12 75.0
pod 5 5 100.0
total 52 62 83.8


line stmt bran cond sub pod time code
1 1     1   141034 use strict;
  1         2  
  1         31  
2 1     1   6 use warnings;
  1         1  
  1         49  
3             package Dancer::Session::Memcached;
4             {
5             $Dancer::Session::Memcached::VERSION = '0.202';
6             }
7             # ABSTRACT: Memcached-based session backend for Dancer
8              
9 1     1   6 use base 'Dancer::Session::Abstract';
  1         2  
  1         920  
10              
11 1     1   84840 use Carp;
  1         3  
  1         62  
12 1     1   1142 use Cache::Memcached;
  1         117006  
  1         39  
13 1     1   10 use Dancer::Config 'setting';
  1         2  
  1         98  
14 1     1   6 use Dancer::ModuleLoader;
  1         2  
  1         353  
15              
16             # static
17              
18             # singleton for the Memcached hanlde
19             my $MEMCACHED;
20              
21             sub init {
22 3     3 1 31 my $self = shift;
23              
24 3         16 $self->SUPER::init(@_);
25              
26 3         715 my $servers = setting("memcached_servers");
27 3 100       323 croak "The setting memcached_servers must be defined"
28             unless defined $servers;
29 2         10 $servers = [split /,/, $servers];
30              
31             # make sure the servers look good
32 2         6 foreach my $s (@$servers) {
33 2 100       16 if ($s =~ /^\d+\.\d+\.\d+\.\d+$/) {
34 1         224 croak "server `$s' is invalid; port is missing, use `server:port'";
35             }
36             }
37              
38 1         11 $MEMCACHED = Cache::Memcached->new(servers => $servers);
39             }
40              
41             # create a new session and return the newborn object
42             # representing that session
43             sub create {
44 3     3 1 1826 my ($class) = @_;
45 3         27 my $self = $class->new;
46 1         4284 $MEMCACHED->set($self->id => $self);
47 1         255980 return $self;
48             }
49              
50             # Return the session object corresponding to the given id
51             sub retrieve($$) { ## no critic
52 0     0 1   my ($class, $id) = @_;
53 0           return $MEMCACHED->get($id);
54             }
55              
56             # instance
57              
58             sub destroy {
59 0     0 1   my ($self) = @_;
60 0           $MEMCACHED->delete($self->id);
61             }
62              
63             sub flush {
64 0     0 1   my $self = shift;
65 0           $MEMCACHED->set($self->id => $self);
66 0           return $self;
67             }
68              
69             1;
70              
71              
72              
73             =pod
74              
75             =head1 NAME
76              
77             Dancer::Session::Memcached - Memcached-based session backend for Dancer
78              
79             =head1 VERSION
80              
81             version 0.202
82              
83             =head1 DESCRIPTION
84              
85             This module implements a session engine based on the Memcache API. Session are
86             stored as memcache objects via a list of Memcached servers.
87              
88             =head1 CONFIGURATION
89              
90             The setting B should be set to C in order to use this
91             session engine in a Dancer application.
92              
93             A mandatory setting is needed as well: C, which should
94             contain a comma-separated list of reachable memecached servers (can be either
95             address:port or sockets).
96              
97             Here is an example configuration that uses this session engine
98              
99             session: "memcached"
100             memcached_servers: "10.0.1.31:11211,10.0.1.32:11211,10.0.1.33:11211,/var/sock/memcached"
101              
102             =head1 DEPENDENCY
103              
104             This module depends on L.
105              
106             =head1 SEE ALSO
107              
108             See L for details about session usage in route handlers.
109              
110             =head1 AUTHOR
111              
112             Alexis Sukrieh
113              
114             =head1 COPYRIGHT AND LICENSE
115              
116             This software is copyright (c) 2011 by Alexis Sukrieh.
117              
118             This is free software; you can redistribute it and/or modify it under
119             the same terms as the Perl 5 programming language system itself.
120              
121             =cut
122              
123              
124             __END__