File Coverage

blib/lib/Memcached/Server/Default.pm
Criterion Covered Total %
statement 28 29 96.5
branch 3 4 75.0
condition n/a
subroutine 9 9 100.0
pod 0 1 0.0
total 40 43 93.0


line stmt bran cond sub pod time code
1             package Memcached::Server::Default;
2              
3 1     1   21415 use warnings;
  1         2  
  1         34  
4 1     1   7 use strict;
  1         2  
  1         32  
5              
6 1     1   570 use Memcached::Server;
  1         4  
  1         337  
7              
8             =head1 NAME
9              
10             Memcached::Server::Default - A pure perl Memcached server
11              
12             =head1 VERSION
13              
14             Version 0.04
15              
16             =cut
17              
18             sub new {
19 2     2 0 35 shift;
20 2         6 my $data = {};
21             return Memcached::Server->new(
22             cmd => {
23             set => sub {
24 12     12   29 my($cb, $key, $flag, $expire) = @_;
25 12         46 $data->{$key} = $_[4];
26 12         46 $cb->(1);
27             },
28             get => sub {
29 18     18   42 my($cb, $key) = @_;
30 18 100       56 if( exists $data->{$key} ) {
31 17         69 $cb->(1, $data->{$key});
32             }
33             else {
34 1         37 $cb->(0);
35             }
36             },
37             _find => sub {
38 7     7   17 my($cb, $key) = @_;
39 7         31 $cb->( exists $data->{$key} );
40             },
41             delete => sub {
42 1     1   4 my($cb, $key) = @_;
43 1 50       5 if( exists $data->{$key} ) {
44 1         4 delete $data->{$key};
45 1         5 $cb->(1);
46             }
47             else {
48 0         0 $cb->(0);
49             }
50             },
51             flush_all => sub {
52 2     2   4 my($cb) = @_;
53 2         6 $data = {};
54 2         13 $cb->();
55             },
56             },
57             @_
58 2         63 );
59             }
60              
61             =head1 SYNOPSIS
62              
63             use Memcached::Server::Default;
64             use AE;
65              
66             Memcached::Server::Default->new(
67             open => [[0, 8888]]
68             );
69              
70             AE::cv->recv;
71              
72             =head1 DESCRIPTION
73              
74             This module is a simple but complete example for using L.
75             It works like a normal Memcached server, but not good at efficiency as the
76             real one. It is just a example.
77              
78             =head1 SEE ALSO
79              
80             L, L, L
81              
82             =head1 AUTHOR
83              
84             Cindy Wang (CindyLinz)
85              
86             =head1 BUGS
87              
88             Please report any bugs or feature requests to C, or through
89             the web interface at L. I will be notified, and then you'll
90             automatically be notified of progress on your bug as I make changes.
91              
92             =head1 SUPPORT
93              
94             You can find documentation for this module with the perldoc command.
95              
96             perldoc Memcached::Server::Default
97              
98              
99             You can also look for information at:
100              
101             =over 4
102              
103             =item * RT: CPAN's request tracker
104              
105             L
106              
107             =item * AnnoCPAN: Annotated CPAN documentation
108              
109             L
110              
111             =item * CPAN Ratings
112              
113             L
114              
115             =item * Search CPAN
116              
117             L
118              
119             =back
120              
121             =head1 LICENSE AND COPYRIGHT
122              
123             Copyright 2010 Cindy Wang (CindyLinz).
124              
125             This program is free software; you can redistribute it and/or modify it
126             under the terms of either: the GNU General Public License as published
127             by the Free Software Foundation; or the Artistic License.
128              
129             See http://dev.perl.org/licenses/ for more information.
130              
131             =cut
132              
133             1;