File Coverage

blib/lib/Cache/Memcached/Tags.pm

Criterion	Covered	Total	%
statement	12	40	30.0
branch	0	10	0.0
condition	0	3	0.0
subroutine	4	7	57.1
pod	3	3	100.0
total	19	63	30.1

#
# Copyright (c) 2008, 2009  Eugene Bragin
#
# See COPYRIGHT section in pod text below for usage and distribution rights.
#

package Cache::Memcached::Tags;

use strict;
use warnings;

use base 'Cache::Memcached';

use vars qw($VERSION);

$VERSION = '0.02';

sub add_tags {
  my $self = shift;
  my $key  = shift;
  my @tags = @_;

  my $sock = $self->get_sock($key);
  foreach my $tag (@tags) {
    my $cmd = "tag_add $tag $self->{namespace}$key\r\n";
    my $res = $self->_write_and_read($sock, $cmd);

    die "tag_add command returned ERROR, please make sure your memcached servers support tags: http://code.google.com/p/memcached-tags/"
      if $res eq "ERROR\r\n";

    return 0 unless $res eq "TAG_STORED\r\n";
  }

  return 1;
}

*add_tag = \&add_tags;
*tag_add = \&add_tags;

sub delete_by_tags {
  my $self = shift;
  my @tags = @_;

  my $cmd = 'tags_delete '. join(' ', @tags) ."\r\n";
  my $items_deleted = 0;

  my @hosts = @{$self->{'buckets'}};
  foreach my $host (@hosts) {
      my $sock = $self->sock_to_host($host);
      my $res = $self->_write_and_read($sock, $cmd);
      warn "tag_add command returned ERROR, please make sure your memcached servers support tags: http://code.google.com/p/memcached-tags/"
        if $res eq "ERROR\r\n";

      if ($res =~ /^(\d+) ITEMS_DELETED/) {
        $items_deleted += $1;
      }
  }

  return $items_deleted;
}

*tag_delete  = \&delete_by_tags;
*tags_delete = \&delete_by_tags;

sub set {
  my $self = shift;
  my ($key, $value, $exptime, @tags) = @_;

  my $result = $self->SUPER::set($key, $value, $exptime);

  $self->add_tags($key, @tags)
    if @tags && $result;

  return $result;
}

1;
__END__