Example 10-3. examples/cli/cli.t

#!/usr/bin/perl -w
use strict;

use Test::More tests => 21;
use Net::Telnet;
my $port = 8000;

my $pid;
if (not @ARGV) {
    $pid = start_server();
    sleep 1;
    diag "Server started (pid: $pid)";
}

END {
    if ($pid) {
        stop_server($pid);
    }
}



my $telnet = _new('telnet');
ok(1, "opened (telnet)");


{
    my ($prematch, $match) = $telnet->waitfor('/Username:.*$/');
    like $prematch, qr/Welcome/, 'welcome printed (telnet)';
    $telnet->print('admin');
}

{
    my ($prematch, $match) = $telnet->waitfor('/Password:.*$/');
    is $prematch, '', 'empty prematch (telnet)';
    $telnet->print('nimda');
}

{
    my ($prematch, $match) = $telnet->waitfor('/\w+>/');
    is $prematch, '', 'empty prematch (telnet)';
    is $match, 'cli>', 'prompt is correct (telnet)';
}

{
    my @resp = $telnet->cmd('');
    is @resp, 1, '1 line in response to "" (telnet)';
    is $resp[0], '', 'ENTER (telnet)';
}


my $other = _new('other');
ok(1, 'opened (other)');
{
    my ($prematch, $match) = $other->waitfor('/Username:.*$/');
    like $prematch, qr/Welcome/, "welcome printed (other)";

    $other->print('admin');
}

{
    my ($prematch, $match) = $other->waitfor('/Password:.*$/');
    is $prematch, '', 'empty prematch (other)';
    $other->print('bad password');
}

#{
#    my ($prematch, $match) = $telnet->waitfor('/\w+>/');
#    is $prematch, '', 'empty prematch';
#    is $match, 'cli>', 'prompt is correct';
#} #error should not accept the password



{
    my @resp = $telnet->cmd('working?');
    is @resp, 1, "one line in response (telnet)";
    like $resp[0], qr/Invalid command: 'working\?'/, 'invalid command (telnet)';
}

{
    my @resp = $telnet->cmd('help');
    is @resp, 7, '7 lines in response to "help" (telnet)';
    like $resp[0], qr/help\s+-\s+this help/, 'invalid command (telnet)';
    # TODO: test more lines of the help?
}

TODO: {
    my @resp;
    eval {
        @resp = $telnet->cmd('?');
    };
    local $TODO = "? does not work: $@" if $@;
    is @resp, 7, '7 line in respons "?" (telnet)';
    push @resp, '' if $@; # to avoid warning on undef;
    like $resp[0], qr/help\s+-\s+this help/, 'invalid command (telnet)';
    # TODO: test more lines of the help?

    $telnet->buffer_empty;
}

{
    my @resp = $telnet->cmd('');
    is @resp, 1, '1 line in response to "" (telnet)';
    is $resp[0], '', 'ENTER (telnet)';
}



# TODO: how to catch the final Goodbye?
{
    my ($prematch, $match) = $telnet->waitfor('/.*$/');
    $telnet->print('exit');
    is($prematch, '', 'prematch is empty of "exit" (telnet)');
    is($match, '', 'match is empty "exit" (telnet)');
#    is $telnet->lastline, '';
    ok(1, 'done (telnet)');
    #my @resp = $telnet->cmd('exit');
    #is @resp, 1, "one line in respons";
    #like $resp[0], qr/Good bye/, 'Goodbye';
}    

exit;
# print enable
# waifor Password:

########################################## 

sub start_server {
    my $pid = fork();
    if (not defined $pid) {
        die "Canot fork\n";
    }

    if ($pid) { # parent
        return $pid;
    } else {    # child
        exec "$^X cli_daemon.pl --port $port --stderr"; 
    }
}
sub stop_server {
    my ($pid) = @_;
    diag "killing $pid";
    kill 3, $pid;
}


sub _new {
    my $t = Net::Telnet->new(
                        Port     => $port,
                        Prompt   => '/^.*>\s*$/m',
                        Host     => 'localhost',
                        Dump_log => "dump.log",
                        Timeout  => 1,
                    );
    return $t;
}

# TODO:
# enable mode, change password of regular user, 
# change password of enabled user 
# BUG: not cannot set password longer than 5 characters
# show config (in regular mode)
# set config (in enabled mode)