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

#
# $Id$
#
# client::memcached Brik
#
package Metabrik::Client::Memcached;
use strict;
use warnings;

use base qw(Metabrik);

sub brik_properties {
   return {
      revision => '$Revision$',
      tags => [ qw(unstable) ],
      author => 'GomoR ',
      license => 'http://opensource.org/licenses/BSD-3-Clause',
      attributes => {
         servers => [ qw(server|server_list) ],
         _c => [ qw(INTERNAL) ],
      },
      attributes_default => {
         servers => [ qw(127.0.0.1:11211) ],
      },
      commands => {
         open => [ qw(server|server_list|OPTIONAL) ],
         close => [ ],
         write => [ qw(key value) ],
         read => [ qw(key) ],
         stats => [ ],
         get_slabs_info => [ ],
      },
      require_modules => {
         'Cache::Memcached' => [ ],
      },
   };
}

sub brik_init {
   my $self = shift;

   $self->open or return 0;

   return $self->SUPER::brik_init;
}

#
# run client::memcached open "[qw(127.0.0.1:11211)]"
#
sub open {
   my $self = shift;
   my ($servers) = @_;

   $servers ||= $self->servers;
   $self->brik_help_set_undef_arg('servers', $servers) or return;

   my $c = Cache::Memcached->new({
      servers => $servers,
   });
   if (!defined($c)) {
      return $self->log->error("open: memcached failed: $!");
   }
   $c->enable_compress(0);

   return $self->_c($c);
}

sub close {
   my $self = shift;

   my $c = $self->_c;
   if (defined($c)) {
      $c->disconnect_all;
      $self->_c(undef);
   }

   return 1;
}

sub write {
   my $self = shift;
   my ($k, $v) = @_;

   my $c = $self->_c;
   $self->brik_help_run_undef_arg('open', $c) or return;
   $self->brik_help_run_undef_arg('write', $k) or return;
   $self->brik_help_run_undef_arg('write', $v) or return;

   return $c->set($k, $v);
}

sub read {
   my $self = shift;
   my ($k) = @_;

   my $c = $self->_c;
   $self->brik_help_run_undef_arg('open', $c) or return;
   $self->brik_help_run_undef_arg('read', $k) or return;

   return $c->get($k);
}

# stats
# stats items
sub stats {
   my $self = shift;
   my ($k) = @_;

   my $c = $self->_c;
   $self->brik_help_run_undef_arg('open', $c) or return;

   return $c->stats($k);
}

#
# High level functions:
#
sub get_slabs_info {
   my $self = shift;

   my $stats = $self->stats('items') or return;

   my @keys = ();
   for my $host (keys %{$stats->{hosts}}) {
      my $items = $stats->{hosts}{$host}{items};
      my @lines = split(/\r\n/, $items);

      # Example: 'STAT items:3:number 628916'
      for my $line (@lines) {
         my ($slab, $count) = $line =~ m{^STAT\s+items:(\d+):number\s+(\d+)};
         next unless (defined($slab) && defined($count));
         push @keys, [ $slab, $count ];
      }
   }

   return \@keys;
}

1;

__END__