File Coverage

blib/lib/Metabrik/Client/Memcached.pm
Criterion Covered Total %
statement 9 58 15.5
branch 0 24 0.0
condition 0 6 0.0
subroutine 3 11 27.2
pod 2 8 25.0
total 14 107 13.0


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # client::memcached Brik
5             #
6             package Metabrik::Client::Memcached;
7 1     1   804 use strict;
  1         2  
  1         30  
8 1     1   7 use warnings;
  1         3  
  1         29  
9              
10 1     1   15 use base qw(Metabrik);
  1         2  
  1         869  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             servers => [ qw(server|server_list) ],
20             _c => [ qw(INTERNAL) ],
21             },
22             attributes_default => {
23             servers => [ qw(127.0.0.1:11211) ],
24             },
25             commands => {
26             open => [ qw(server|server_list|OPTIONAL) ],
27             close => [ ],
28             write => [ qw(key value) ],
29             read => [ qw(key) ],
30             stats => [ ],
31             get_slabs_info => [ ],
32             },
33             require_modules => {
34             'Cache::Memcached' => [ ],
35             },
36             };
37             }
38              
39             sub brik_init {
40 0     0 1   my $self = shift;
41              
42 0 0         $self->open or return 0;
43              
44 0           return $self->SUPER::brik_init;
45             }
46              
47             #
48             # run client::memcached open "[qw(127.0.0.1:11211)]"
49             #
50             sub open {
51 0     0 0   my $self = shift;
52 0           my ($servers) = @_;
53              
54 0   0       $servers ||= $self->servers;
55 0 0         $self->brik_help_set_undef_arg('servers', $servers) or return;
56              
57 0           my $c = Cache::Memcached->new({
58             servers => $servers,
59             });
60 0 0         if (!defined($c)) {
61 0           return $self->log->error("open: memcached failed: $!");
62             }
63 0           $c->enable_compress(0);
64              
65 0           return $self->_c($c);
66             }
67              
68             sub close {
69 0     0 0   my $self = shift;
70              
71 0           my $c = $self->_c;
72 0 0         if (defined($c)) {
73 0           $c->disconnect_all;
74 0           $self->_c(undef);
75             }
76              
77 0           return 1;
78             }
79              
80             sub write {
81 0     0 0   my $self = shift;
82 0           my ($k, $v) = @_;
83              
84 0           my $c = $self->_c;
85 0 0         $self->brik_help_run_undef_arg('open', $c) or return;
86 0 0         $self->brik_help_run_undef_arg('write', $k) or return;
87 0 0         $self->brik_help_run_undef_arg('write', $v) or return;
88              
89 0           return $c->set($k, $v);
90             }
91              
92             sub read {
93 0     0 0   my $self = shift;
94 0           my ($k) = @_;
95              
96 0           my $c = $self->_c;
97 0 0         $self->brik_help_run_undef_arg('open', $c) or return;
98 0 0         $self->brik_help_run_undef_arg('read', $k) or return;
99              
100 0           return $c->get($k);
101             }
102              
103             # stats
104             # stats items
105             sub stats {
106 0     0 0   my $self = shift;
107 0           my ($k) = @_;
108              
109 0           my $c = $self->_c;
110 0 0         $self->brik_help_run_undef_arg('open', $c) or return;
111              
112 0           return $c->stats($k);
113             }
114              
115             #
116             # High level functions:
117             #
118             sub get_slabs_info {
119 0     0 0   my $self = shift;
120              
121 0 0         my $stats = $self->stats('items') or return;
122              
123 0           my @keys = ();
124 0           for my $host (keys %{$stats->{hosts}}) {
  0            
125 0           my $items = $stats->{hosts}{$host}{items};
126 0           my @lines = split(/\r\n/, $items);
127              
128             # Example: 'STAT items:3:number 628916'
129 0           for my $line (@lines) {
130 0           my ($slab, $count) = $line =~ m{^STAT\s+items:(\d+):number\s+(\d+)};
131 0 0 0       next unless (defined($slab) && defined($count));
132 0           push @keys, [ $slab, $count ];
133             }
134             }
135              
136 0           return \@keys;
137             }
138              
139             1;
140              
141             __END__