view release on metacpan or  search on metacpan

lib/App/Memcached/Tool/CLI.pm  view on Meta::CPAN

package App::Memcached::Tool::CLI;

use strict;
use warnings;
use 5.008_001;

use Getopt::Long qw(:config posix_default no_ignore_case no_ignore_case_always);
use List::Util qw(first);

use App::Memcached::Tool;
use App::Memcached::Tool::Constants ':all';
use App::Memcached::Tool::DataSource;
use App::Memcached::Tool::Util ':all';

use version; our $VERSION = 'v0.9.4';

sub new {
    my $class  = shift;
    my %params = @_;
    $params{ds}
        = App::Memcached::Tool::DataSource->connect(
            $params{addr}, timeout => $params{timeout}
        );

    bless \%params, $class;
}

sub parse_args {
    my $class = shift;

    my %params; # will be passed to new()
    if (defined $ARGV[0] and looks_like_addr($ARGV[0])) {
        $params{addr} = shift @ARGV;
    }
    if (defined $ARGV[0] and first { $_ eq $ARGV[0] } MODES()) {
        $params{mode} = shift @ARGV;
    }

    GetOptions(
        \my %opts, 'addr|a=s', 'mode|m=s', 'timeout|t=i',
        'debug|d', 'help|h', 'man',
    ) or return +{};
    warn "Unevaluated args remain: @ARGV" if (@ARGV);

    if (defined $opts{man}) {
        $params{mode} = 'man';
    }
    if (defined $opts{help}) {
        $params{mode} = 'help';
    }
    if (defined $opts{debug}) {
        $App::Memcached::Tool::DEBUG = 1;
    }

    %params = (
        addr    => create_addr($params{addr} || $opts{addr}),
        mode    => $params{mode} || $opts{mode} || DEFAULT_MODE(),
        timeout => $opts{timeout},
        debug   => $opts{debug},
    );
    unless (first { $_ eq $params{mode} } MODES()) {
        warn "Invalid mode! $params{mode}";
        delete $params{mode};
    }

    return \%params;
}

sub run {
    my $self = shift;
    debug "[start] $self->{mode} $self->{addr}";
    my $method = $self->{mode};
    my $ret    = $self->$method;
    $self->{ds}->disconnect;
    unless ($ret) {
        warn "Command '$self->{mode}' seems failed. Set '--debug' option if you want to see debug logs.";
        exit 1;
    }
    debug "[end] $self->{mode} $self->{addr}";
}

sub display {
    my $self = shift;

    my %stats;
    my $max = 1;

    my $resp_items = $self->{ds}->query('stats items');
    for my $line (@$resp_items) {
        if ($line =~ m/^STAT items:(\d+):(\w+) (\d+)/) {
            $stats{$1}{$2} = $3;
        }