view release on metacpan or  search on metacpan

lib/Ubic/Service/Memcached.pm  view on Meta::CPAN

package Ubic::Service::Memcached;
BEGIN {
  $Ubic::Service::Memcached::VERSION = '2.02';
}

use strict;
use warnings;

# ABSTRACT: memcached as ubic service


use parent qw(Ubic::Service::Skeleton);
use Ubic::Daemon qw(:all);
use Ubic::Result qw(result);
use Cache::Memcached;
use Carp;

use Params::Validate qw(:all);

use Morpheus '/module/Ubic/Service/Memcached' => [
    'pid_dir' => '?$PID_DIR',
];

sub new {
    my $class = shift;
    my $params = validate(@_, {
        port => { type => SCALAR, regex => qr/^\d+$/ },
        pidfile => { type => SCALAR, optional => 1 },
        maxsize => { type => SCALAR, regex => qr/^\d+$/, default => 640 },
        verbose => { type => SCALAR, optional => 1 },
        max_connections => { type => SCALAR, optional => 1 },
        logfile => { type => SCALAR, optional => 1 },
        ubic_log => { type => SCALAR, optional => 1 },
        user => { type => SCALAR, default => 'root' },
        group => { type => SCALAR, optional => 1},
        other_argv => { type => SCALAR, optional => 1 },
    });
    if (not defined $params->{pidfile}) {
        unless (defined $PID_DIR) {
            croak "pidfile parameter not defined, define it or set /module/Ubic/Service/Memcached/pid_dir configuration option";
        }
        $params->{pidfile} = "$PID_DIR/$params->{port}.pid";
    }
    return bless $params => $class;
}

sub start_impl {
    my $self = shift;

    my $params = [];

    push @$params, "-u $self->{user}" if $self->{user} eq 'root';
    push @$params, "-p $self->{port}";
    push @$params, "-m $self->{maxsize}";
    push @$params, "-c $self->{max_connections}" if defined $self->{max_connections};

    my $verbose = $self->{verbose};
    if (defined $verbose) {
        if ($verbose == 1) {
            push @$params, "-v";
        } elsif ($verbose > 1) {
            push @$params, "-vv";
        }
    }

    push @$params, $self->{other_argv} if defined $self->{other_argv};

    my $params_str = join " ", @$params;

    start_daemon({
        bin => "/usr/bin/memcached $params_str",
        pidfile => $self->{pidfile},
        ($self->{logfile} ?
            (
            stdout => $self->{logfile},
            stderr => $self->{logfile},
            ) : ()
        ),
        ($self->{ubic_log} ? (ubic_log => $self->{ubic_log}) : ()),
    });
    return result('starting');
}

sub stop_impl {
    my $self = shift;
    stop_daemon($self->{pidfile});
}

sub timeout_options {
    { start => { step => 0.1, trials => 10 } };
}

sub _is_available {
    my $self = shift;

    # using undocumented function here; Cache::Memcached caches unavailable hosts,
    # so without this call restart fails (at least on debian etch)
    Cache::Memcached->forget_dead_hosts();

    # TODO - this can fail if memcached binds only to specific interface
    my $client = Cache::Memcached->new({ servers => ["127.0.0.1:$self->{port}"] });
    my $key = 'Ubic::Service::Memcached-testkey';
    $client->set($key, 1);
    my $value = $client->get($key);