view release on metacpan or  search on metacpan

bin/dochazka-cli  view on Meta::CPAN

            print "Username: ";
            chomp( $user = <STDIN> );
        }
    }
    print "Authenticating to server at $server as user $user\n";
    if ( ! $password ) {
        ReadMode ('noecho');
        print "Password: ";
        chomp( $password = <STDIN> );
        ReadMode ('restore');
        print "\n";
    }
    my $status = authenticate_to_server( user => $user, password => $password );
    if ( $status->not_ok ) {

        # Handle two classic scenarios:
        # 1. server not running
        if ( $status->payload =~ m/Connection refused/ ) {
            print "Server refused connection - is it running?\n";
            exit;
        }
        # 2. authentication failed
        if ( $status->text =~ m/Authentication failed/ ) {
            print "Authentication failed.\n";
            exit;
        }
        # 3. authentication failed
        if ( $status->text =~ m/Internal auth failed/ ) {
            print "Authentication failed.\n";
            exit;
        }

        # some other scenario?
        print $status->code . ' (' . $status->level . ') ' . $status->text . "\n";
        print "Response: " . Dumper( $status->payload ) . "\n";
        exit;
    } else {
        print "Server is alive\n";
    }
}


# paraphrased from https://metacpan.org/source/HAYASHI/Term-ReadLine-Gnu-1.26/eg/fileman
sub initialize_readline {
    my $term = new Term::ReadLine 'dochazka-cli';
    $term->Attribs->{completion_function} = \&dochazka_cli_completion;
    return $term;
}

my $term = initialize_readline() if $interactive;

my $readline = $interactive 
    ? sub { $term->readline( get_prompt() ) } 
    : sub {
        my $line = <STDIN>;
        return unless defined($line);
        print get_prompt() . $line;
        return $line;
    };

binmode STDOUT, ":utf8";

my $cmd;
COMMAND: while ( defined ( $cmd = $readline->() ) ) {

    my $rv = process_command( $cmd );

    # The return value SHOULD be a status object, but tolerate the eventuality
    # that it might be just a plain string

    if ( ref( $rv ) eq 'App::CELL::Status' ) {
        if ( delete $rv->{'rest_test'} ) {
            print "HTTP status: " . ( delete $rv->{'http_status'} || '<NONE>' ) . "\n";
            print "Non-suppressed headers: " . Dumper( $rv->{'headers'} ) if $rv->{'headers'};
            delete $rv->{'headers'};
            my $expurgated_rv = $rv->expurgate;
            #print Dumper( $expurgated_rv );
            print "Response:\n" . $JSON->encode( $expurgated_rv ) . "\n";
            next COMMAND;
        }
        if ( $rv->level eq 'ERR' and $rv->code eq 'DOCHAZKA_CLI_PARSE_ERROR' ) {
            print "Command not recognized (parse error)\n";
            next COMMAND;
        }
        if ( $rv->code eq 'REST_ERROR' ) {
            print "*** REST ERROR ***\n";
            print $rv->payload, "\n";
            next COMMAND;
        }
        if ( $rv->ok ) {
            my $pl = $rv->payload;
            if ( defined( $pl ) and ref( $pl ) eq '' ) {
                print "$pl\n";
            } else {
                if ( $rv->text ) {
                    print $rv->text, "\n";
                    print "Payload: " . Dumper( $pl ) . "\n" if defined $pl;
                } else {
                    print Dumper( $rv ), "\n";
                }
            }
        } else {
            print "*** Anomaly detected ***\n";
            if ( my $status = $rv->{'http_status'} ) {
                print "Status:      $status\n";
            }
            print "Explanation: " . $rv->text . " (" . $rv->level . ")\n";
            print "\n";
        }
        last COMMAND if $rv->level eq 'OK' and $rv->code eq 'DOCHAZKA_CLI_EXIT';
    } elsif ( ref( $rv ) eq '' ) {
        print $rv, "\n";
    }
}