view release on metacpan or  search on metacpan

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

my %COMMAND2ALIASES = (
    help         => ['\h'],
    version      => ['\v'],
    quit         => [qw(\q exit)],
    display      => [qw(\d)],
    stats        => [qw(\s)],
    settings     => [qw(\c config)],
    cachedump    => [qw(\cd)],
    detaildump   => [qw(\dd)],
    detail       => [],
    dump_all     => [],
    restore_dump => [],
    randomset    => [qw(sample)],
    get          => [],
    gets         => [],
    set          => [],
    add          => [],
    replace      => [],
    append       => [],
    prepend      => [],
    cas          => [],
    incr         => [],
    decr         => [],
    touch        => [],
    delete       => [],
    flush_all    => [qw(flush)],
    call         => [],
);
my %COMMAND_OF;
while (my ($cmd, $aliases) = each %COMMAND2ALIASES) {
    $COMMAND_OF{$cmd} = $cmd;
    $COMMAND_OF{$_}   = $cmd for @$aliases;
}

my $DEFAULT_CACHEDUMP_SIZE = 20;

sub new {
    my $class  = shift;
    my %params = @_;

    eval {
        $params{ds}
            = App::Memcached::CLI::DataSource->connect(
                $params{addr}, timeout => $params{timeout}
            );
    };
    if ($@) {
        warn "Can't connect to Memcached server! Addr=$params{addr}";
        debug "ERROR: " . $@;
        return;
    }

    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;
    }
    GetOptions(
        \my %opts, 'addr|a=s', 'timeout|t=i',
        'debug|d', 'help|h', 'man',
    ) or return +{};

    if (defined $opts{debug}) {
        $App::Memcached::CLI::DEBUG = 1;
    }

    %params = (%opts, %params);
    $params{addr} = create_addr($params{addr});

    return \%params;
}

sub run {
    my $self = shift;
    if (@ARGV) {
        $self->run_batch;
    } else {
        $self->run_interactive;
    }
}

sub run_batch {
    my $self = shift;
    debug "Run batch mode with @ARGV" if (@ARGV);
    my ($_command, @args) = @ARGV;
    my $command = $COMMAND_OF{$_command};
    unless ($command) {
        print "Unknown command - $_command\n";
        return;
    } elsif ($command eq 'quit') {
        print "Nothing to do with $_command\n";
        return;
    }

    my $ret = $self->$command(@args);
    unless ($ret) {
        print qq[Command seems failed. Run \`$PROGRAM help\` or \`$PROGRAM help $command\` for usage.\n];
    }
}

sub run_interactive {
    my $self = shift;
    debug "Start interactive mode. $self->{addr}";
    my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT));
    unless ($isa_tty) {
        croak "TTY Not Found! Quit.";
    }
    my $exit_loop = 0;
    local $SIG{INT} = local $SIG{QUIT} = sub {
        $exit_loop = 1;
        warn "Caught INT or QUIT. Exiting...";
    };

    $self->{term} = Term::ReadLine->new($PROGRAM);
    print "Type '\\h' or 'help' to show help.\n\n";