File Coverage

blib/lib/Clustericious/Client/Command.pm

Criterion	Covered	Total	%
statement	64	148	43.2
branch	23	86	26.7
condition	16	72	22.2
subroutine	11	16	68.7
pod	1	1	100.0
total	115	323	35.6

package Clustericious::Client::Command;

use strict;
use warnings;

# ABSTRACT: Command line type processing for clients.
our $VERSION = '0.85'; # VERSION


use File::Basename qw/basename/;
use YAML::XS qw(Load Dump LoadFile);
use Log::Log4perl qw/:easy/;
use Scalar::Util qw/blessed/;
use Data::Rmap qw/rmap_ref/;
use File::Temp;

use Clustericious::Log;
use Clustericious::Client::Meta;

sub _usage {
    my $class = shift;
    my $client = shift;
    my $msg = shift;
    my $routes = Clustericious::Client::Meta->routes(ref $client);
    my $objects = Clustericious::Client::Meta->objects(ref $client);
    print STDERR $msg,"\n" if $msg;
    print STDERR "Usage:\n";
    my $name = basename($0);
    print STDERR <
@{[ join "\n", map "       $name [opts] $_->[0] $_->[1]", @$routes ]}
EOPRINT
    print STDERR <
       $name [opts]
       $name [opts]
       $name [opts] search  [--key value]
       $name [opts] create  []
       $name [opts] update   []
       $name [opts] delete

    where "opts" are as described in Log::Log4perl::CommandLine, or
    may be "--remote " to specify a remote to use from the
    config file (see Clustericious::Client).

    and "" may be one of the following :
@{[ join "\n", map "      $_->[0] $_->[1]", @$objects ]}

EOPRINT

    exit 0;
}


our $Ssh = "ssh -o StrictHostKeyChecking=no -o BatchMode=yes -o PasswordAuthentication=no";
sub _expand_remote_glob {
    # Given a glob, e.g. omidev.gsfc.nasa.gov:/devsips/app/*/doc/Description.txt
    # Return a list of filenames with the host prepended to each one, e.g.
    #       omidev.gsfc.nasa.gov:/devsips/app/foo-1/doc/Description.txt
    #       omidev.gsfc.nasa.gov:/devsips/app/bar-2/doc/Description.txt
    my $pattern = shift;
    return ( $pattern ) unless $pattern =~ /^(\S+):(.*)$/;
    my ($host,$file) = ( $1, $2 );
    return ( $pattern ) unless $file =~ /[*?]/;
    INFO "Remote glob : $host:$file";
    my $errs =  File::Temp->new();
    my @filenames = `$Ssh $host ls $file 2>$errs`;
    LOGDIE "Error ssh $host ls $file returned (code $?)".`tail -2 $errs` if $?;
    return map "$host:$_", @filenames;
}

sub _load_yaml {
    # _load_yaml can take a local filename or a remote ssh host + filename and
    # returns parsed yaml content.
    my $filename = shift;

    unless ($filename =~ /^(\S+):(.*)$/) {
        INFO "Loading $filename";
        my $parsed = LoadFile($filename) or LOGDIE "Invalid YAML : $filename\n";
        return $parsed;
    }

    my ($host,$file) = ($1,$2);
    INFO "Loading remote file $file from $host";
    my $errs =  File::Temp->new();
    my $content = `$Ssh $host cat $file 2>$errs`;
    if ($?) {
        LOGDIE "Error (code $?) running ssh $host cat $file : ".`tail -2 $errs`;
    }
    my $parsed = Load($content) or do {
        ERROR "Invalid YAML: $filename";
        return;
    };
    return $parsed;
}

sub run {
    my $class = shift;
    my $client = shift;
    my @args = @_ ? @_ : @ARGV;
    our $TESTING;

    return $class->_usage($client) if !$args[0] || $args[0] =~ /help/;

    # Preprocessing for any common args, e.g. --remote
    my $arg;
    ARG :
    while ($arg = shift @args) {
        for ($arg) {
            /--remote/ and do {
                my $remote = shift @args;
                TRACE "Using remote $remote";
                $client->remote($remote);
                next ARG;
            };
            last ARG;
        }
    }

    my $method = $arg or $class->_usage($client);

    # Map some alternative command line forms.
    my $try_stdin;
    if ( $method eq 'create' ) {
        $method = shift @args or $class->_usage( $client, "Missing " );
        $try_stdin = 1;
    }

    if ( $method =~ /^(delete|search)$/ ) { # e.g. search -> app_search
        $method = ( shift @args ) . '_' . $method;
    }

    unless ($client->can($method)) {
        $class->_usage($client, "Unrecognized argument : $method");
        return;
    }

    my $meta = Clustericious::Client::Meta::Route->new(
        route_name   => $method,
        client_class => ref $client
    );

    if ($meta->get('args')) {
        # No heuristics for args.

        my $obj = $client->$method({ command_line => 1 }, @args);

        ERROR $client->errorstring if $client->has_error;

        # Copied from below, until that code is deprecated.
        if ( blessed($obj) && $obj->isa("Mojo::Transaction") ) {
            if ( my $res = $obj->success ) {
                print $res->code," ",$res->default_message,"\n";
            } else {
                my ( $message, $code ) = $obj->error;
                ERROR $code if $code;
                ERROR $message;
            }
        } elsif (ref $obj eq 'HASH' && keys %$obj == 1 && $obj->{text}) {
            print $obj->{text};
        } elsif ($client->tx && $client->tx->req->method eq 'POST' && $meta->get("quiet_post")) {
            my $msg = $client->res->code." ".$client->res->default_message;
            my $got = $client->res->json;
            if ($got && ref $got eq 'HASH' and keys %$got==1 && $got->{text}) {
                $msg .= " ($got->{text})";
            }
            INFO $msg;
        } else {
           print _prettyDump($obj) unless $TESTING;
        }
        return;
    }

    # Code below here should be deprecated, these are various heuristics for argument processing.

    my @extra_args = ( '/dev/null' );
    my $have_filenames;

    # Assume we have files and/or remote globs
    if ( !$meta->get('dont_read_files') && @args > 0 && ( -r $_[-1] || $_[-1] =~ /^\S+:/ ) ) {
        $have_filenames = 1;
        @extra_args = ();
        while (my $arg = pop @args) {
            if ($arg =~ /^\S+:/) {
                push @extra_args, _expand_remote_glob($arg);
            } elsif (-e $arg) {
                push @extra_args, $arg;
            } else {
                LOGDIE "Do not know how to interpret argument : $arg";
            }
        }
    } elsif ( $try_stdin && (-r STDIN) && @args==0) {
        my $content = join '', ;
        $content = Load($content);
        LOGDIE "Invalid yaml content in $method" unless $content;
        push @args, $content;
    }

    # Finally, run :
    for my $arg (@extra_args) {
        my $obj;
        if ($have_filenames) {
            $obj = $client->$method(@args, _load_yaml($arg));
        } else {
            $obj = $client->$method(@args);
        }
        ERROR $client->errorstring if $client->errorstring;
        next unless $obj;

        if ( blessed($obj) && $obj->isa("Mojo::Transaction") ) {
            if ( my $res = $obj->success ) {
                print $res->code," ",$res->default_message,"\n";
            } else {
                my ( $message, $code ) = $obj->error;
                ERROR $code if $code;
                ERROR $message;
            }
        } elsif (ref $obj eq 'HASH' && keys %$obj == 1 && $obj->{text}) {
            print $obj->{text};
        } elsif ($client->tx && $client->tx->req->method eq 'POST' && $meta->get("quiet_post")) {
            my $msg = $client->res->code." ".$client->res->default_message;
            my $got = $client->res->json;
            if ($got && ref $got eq 'HASH' and keys %$got==1 && $got->{text}) {
                $msg .= " ($got->{text})";
            }
            INFO $msg;
        } else {
           print _prettyDump($obj) unless $TESTING;
        }
    }
    return;
}

sub _prettyDump {
    my $what = shift;
    rmap_ref { $_ = $_->iso8601() if ref($_) eq 'DateTime' } $what;
    return Dump($what);
}


1;

__END__