File Coverage

blib/lib/Memcached/Client/Request.pm

Criterion	Covered	Total	%
statement	100	263	38.0
branch	0	66	0.0
condition	0	13	0.0
subroutine	42	65	64.6
pod	3	3	100.0
total	145	410	35.3

package Memcached::Client::Request;
BEGIN {
  $Memcached::Client::Request::VERSION = '2.01';
}
# ABSTRACT: Base class for Memcached::Client request drivers

use strict;
use warnings;
use AnyEvent qw{};
use Memcached::Client::Log qw{DEBUG LOG};


sub generate {
    my ($class, $command) = @_;

    $class->log ("Class is %s, Command is %s", $class, $command) if DEBUG;
    return sub {
        my ($client, @args) = @_;

        my $request = bless {command => $command}, $class;
        $class->log ("Request is %s", $request) if DEBUG;

        $class->log ("Checking for condvar/callback") if DEBUG;
        if (ref $args[-1] eq 'AnyEvent::CondVar' or ref $args[-1] eq 'CODE') {
            $class->log ("Found condvar/callback") if DEBUG;
            $request->{cb} = pop @args;
        } else {
            $class->log ("Making own condvar") if DEBUG;
            $request->{cb} = AE::cv;
            $request->{wait} = 1;
        }

        $class->log ("Processing arguments: %s", \@args) if DEBUG;
        my @requests = $request->process (@args);
        if (@requests) {
            $class->log ("Submitting request(s)") if DEBUG;
            $client->__submit (@requests);
        } else {
            $request->result;
        }

        $class->log ("Checking whether to wait") if DEBUG;
        $request->{cb}->recv if ($request->{wait});
    }
}


sub log {
    my ($self, $format, @args) = @_;
    my $prefix = ref $self || $self;
    $prefix =~ s,Memcached::Client::Request::,Request/,;
    LOG ("$prefix> " . $format, @args);
}


sub result {
    my ($self, @values) = @_;
    $self->log ("$self received result %s", \@values) if DEBUG;
    if (scalar @values) {
        $self->log ("We have a result") if DEBUG;
    } elsif (defined $self->{result}) {
        $self->log ("We have a stored result") if DEBUG;
        push @values, $self->{result};
    } elsif (exists $self->{default}) {
        $self->log ("We have a default") if DEBUG;
        push @values, $self->{default};
    } else {
        $self->log ("We have nothing to return") if DEBUG;
    }
    unshift @values, $self->{key} if ($self->{sendkey});
    $self->{cb}->(@values);
}

package Memcached::Client::Request::Add;
BEGIN {
  $Memcached::Client::Request::Add::VERSION = '2.01';
}
# ABSTRACT: Driver for Memcached::Client add-style requests

use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Request};


sub process {
    my ($self, $key, $value, $expiration) = @_;
    $self->{default} = 0;
    return () unless (defined $key and defined $value);
    $self->{expiration} = int ($expiration || 0);
    $self->{key} = $key;
    $self->{type} = "__add";
    $self->{value} = $value;
    return $self;
}

*Memcached::Client::add = Memcached::Client::Request::Add->generate ("add");
*Memcached::Client::append = Memcached::Client::Request::Add->generate ("append");
*Memcached::Client::prepend = Memcached::Client::Request::Add->generate ("prepend");
*Memcached::Client::replace = Memcached::Client::Request::Add->generate ("replace");
*Memcached::Client::set = Memcached::Client::Request::Add->generate ("set");

package Memcached::Client::Request::AddMulti;
BEGIN {
  $Memcached::Client::Request::AddMulti::VERSION = '2.01';
}
# ABSTRACT: Driver for multiple Memcached::Client add-style requests

use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Request};


sub process {
    my ($self, @requests) = @_;
    $self->{result} = {};
    return () unless @requests;
    $self->{partial} = 0;
    return grep {$_} map {
        my $request = bless {command => $self->{command}, sendkey => 1}, "Memcached::Client::Request::Add";
        $request->{cb} = sub {
            my ($key, $value) = @_;
            $self->log ("Noting that we received %s for %s", $value, $key) if DEBUG;
            $self->{result}->{$key} = $value if (defined $value);
            $self->result unless (--$self->{partial});
            $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
        };
        if ($request->process (@{$_})) {
            $self->{partial}++;
            $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
            $request;
        }
    } @requests;
}

*Memcached::Client::add_multi = Memcached::Client::Request::AddMulti->generate ("add");
*Memcached::Client::append_multi = Memcached::Client::Request::AddMulti->generate ("append");
*Memcached::Client::prepend_multi = Memcached::Client::Request::AddMulti->generate ("prepend");
*Memcached::Client::replace_multi = Memcached::Client::Request::AddMulti->generate ("replace");
*Memcached::Client::set_multi = Memcached::Client::Request::AddMulti->generate ("set");

package Memcached::Client::Request::Decr;
BEGIN {
  $Memcached::Client::Request::Decr::VERSION = '2.01';
}
# ABSTRACT: Driver for multiple Memcached::Client decr-style requests

use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Request};


sub process {
    my ($self, $key, $delta, $initial) = @_;
    return () unless (defined $key);
    $self->log ("arguments are %s", \@_) if DEBUG;
    $self->{data} = defined $initial ? int ($initial) : undef;
    $self->{delta} = int ($delta || 1);
    $self->{key} = $key;
    $self->{type} = "__decr";
    return $self;
}

*Memcached::Client::decr = Memcached::Client::Request::Decr->generate ("decr");
*Memcached::Client::incr = Memcached::Client::Request::Decr->generate ("incr");

package Memcached::Client::Request::DecrMulti;
BEGIN {
  $Memcached::Client::Request::DecrMulti::VERSION = '2.01';
}
# ABSTRACT: Driver for multiple Memcached::Client decr-style requests

use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Request};


sub process {
    my ($self, @requests) = @_;
    $self->{result} = {};
    return () unless (@requests);
    $self->{partial} = 0;
    return grep {defined} map {
        my $request = bless {command => $self->{command}, sendkey => 1}, "Memcached::Client::Request::Decr";
        $request->{cb} = sub {
            my ($key, $value) = @_;
            $self->log ("Noting that we received %s for %s", $value, $key) if DEBUG;
            $self->{result}->{$key} = $value if (defined $value);
            $self->result unless (--$self->{partial});
            $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
        };
        if ($request->process (ref $_ ? @{$_} : $_)) {
            $self->{partial}++;
            $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
            $request;
        }
    } @requests;
}

*Memcached::Client::decr_multi = Memcached::Client::Request::DecrMulti->generate ("decr");
*Memcached::Client::incr_multi = Memcached::Client::Request::DecrMulti->generate ("incr");

package Memcached::Client::Request::Delete;
BEGIN {
  $Memcached::Client::Request::Delete::VERSION = '2.01';
}
# ABSTRACT: Driver for Memcached::Client delete requests

use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Request};


sub process {
    my ($self, $key) = @_;
    $self->{default} = 0;
    return () unless (defined $key);
    $self->log ("arguments are %s", \@_) if DEBUG;
    $self->{key} = $key;
    $self->{type} = "__delete";
    return $self;
}

*Memcached::Client::delete = Memcached::Client::Request::Delete->generate ("delete");

package Memcached::Client::Request::DeleteMulti;
BEGIN {
  $Memcached::Client::Request::DeleteMulti::VERSION = '2.01';
}
# ABSTRACT: Driver for multiple Memcached::Client delete requests

use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Request};


sub process {
    my ($self, @keys) = @_;
    $self->{result} = {};
    return () unless (@keys);
    $self->{partial} = 0;
    return grep {$_} map {
        my $request = bless {command => $self->{command}, sendkey => 1}, "Memcached::Client::Request::Delete";
        $request->{cb} = sub {
            my ($key, $value) = @_;
            $self->log ("Noting that we received %s for %s", $value, $key) if DEBUG;
            $self->{result}->{$key} = $value if (defined $value);
            $self->result unless (--$self->{partial});
            $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
        };
        if ($request->process ($_)) {
            $self->{partial}++;
            $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
            $request;
        }
    } @keys;
}

*Memcached::Client::delete_multi = Memcached::Client::Request::DeleteMulti->generate ("delete");

package Memcached::Client::Request::Get;
BEGIN {
  $Memcached::Client::Request::Get::VERSION = '2.01';
}
# ABSTRACT: Driver for Memcached::Client get requests

use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Request};


sub process {
    my ($self, $key) = @_;
    return () unless (defined $key);
    $self->log ("arguments are %s", \@_) if DEBUG;
    $self->{type} = "__get";
    $self->{key} = $key;
    return $self;
}

*Memcached::Client::get = Memcached::Client::Request::Get->generate ("get");

package Memcached::Client::Request::GetMulti;
BEGIN {
  $Memcached::Client::Request::GetMulti::VERSION = '2.01';
}
# ABSTRACT: Driver for multiple Memcached::Client get requests

use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Request};


sub process {
    my ($self, @keys) = @_;
    $self->{result} = {};
    return () unless (@keys);
    $self->{partial} = 0;
    return grep {defined} map {
        my $request = bless {command => $self->{command}, sendkey => 1}, "Memcached::Client::Request::Get";
        $request->{cb} = sub {
            my ($key, $value) = @_;
            $self->log ("Noting that we received %s for %s", $value, $key) if DEBUG;
            $self->{result}->{$key} = $value if (defined $value);
            $self->result unless (--$self->{partial});
            $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
        };
        if ($request->process ($_)) {
            $self->{partial}++;
            $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
            $request;
        }
    } @keys;
}

*Memcached::Client::get_multi = Memcached::Client::Request::GetMulti->generate ("get");

package Memcached::Client::Request::Broadcast;
BEGIN {
  $Memcached::Client::Request::Broadcast::VERSION = '2.01';
}
# ABSTRACT: Class to manage Memcached::Client server requests

use Memcached::Client::Log qw{DEBUG LOG};
use base qw{Memcached::Client::Request};


sub process {
    return $_[0];
}

package Memcached::Client::Request::BroadcastMulti;
BEGIN {
  $Memcached::Client::Request::BroadcastMulti::VERSION = '2.01';
}
# ABSTRACT: Class to manage Memcached::Client broadcast requests

use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Request};


sub process {
    my ($self, @arguments) = @_;
    $self->{arguments} = \@arguments;
    $self->{result} = {};
    $self->{partial} = 0;
    $self->{type} = "__$self->{command}";
    return $self;
}


sub server {
    my ($self, $server) = @_;
    my $request = bless {command => $self->{command}, key => $server, sendkey => 1, type => $self->{type}}, "Memcached::Client::Request::Broadcast";
    $request->{cb} = sub {
        my ($key, $value) = @_;
        $self->log ("Noting that we received %s for %s", $value, $key) if DEBUG;
        $self->{result}->{$key} = $value if (defined $value);
        $self->result unless (--$self->{partial});
        $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
    };
    $self->{partial}++;
    $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
    $request;
}

*Memcached::Client::flush_all = Memcached::Client::Request::BroadcastMulti->generate ("flush_all");
*Memcached::Client::stats = Memcached::Client::Request::BroadcastMulti->generate ("stats");
*Memcached::Client::version = Memcached::Client::Request::BroadcastMulti->generate ("version");

package Memcached::Client::Request::Connect;
BEGIN {
  $Memcached::Client::Request::Connect::VERSION = '2.01';
}
# ABSTRACT: Class to manage Memcached::Client server request

use Memcached::Client::Log qw{DEBUG LOG};
use base qw{Memcached::Client::Request};


sub process {
    return $_[0];
}

package Memcached::Client::Request::ConnectMulti;
BEGIN {
  $Memcached::Client::Request::ConnectMulti::VERSION = '2.01';
}
# ABSTRACT: Class to manage Memcached::Client connection requests

use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Request};


sub process {
    return $_[0];
}


sub server {
    my ($self, $server) = @_;
    my $request = bless {command => "connect", key => $server, sendkey => 1, type => "__connect"}, "Memcached::Client::Request::Connect";
    $request->{cb} = sub {
        my ($key, $value) = @_;
        $self->log ("Noting that we received %s for %s", $value, $key) if DEBUG;
        $self->{result}->{$key} = $value if (defined $value);
        $self->result (1) unless (--$self->{partial});
        $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
    };
    $self->{partial}++;
    $self->log ("%d queries outstanding", $self->{partial}) if DEBUG;
    $request;
}

*Memcached::Client::connect = Memcached::Client::Request::ConnectMulti->generate ("connect");

1;

__END__