File: interactivity.t

package info (click to toggle)
libcli-framework-perl 0.05-1
  • links: PTS, VCS
  • area: main
  • in suites: buster, jessie, jessie-kfreebsd, stretch
  • size: 460 kB
  • ctags: 282
  • sloc: perl: 2,168; sql: 18; sh: 3; makefile: 2
file content (112 lines) | stat: -rw-r--r-- 3,527 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
use strict;
use warnings;

use lib 'lib';
use lib 't/lib';

use File::Spec;

use Test::More;

# These tests require DBI and DBD::SQLite (My::Journal dependencies)...
my $prereqs_installed = eval 'use DBI; use DBD::SQLite';
if( $@ ) { plan skip_all => 'DBI and DBD::SQLite are required for tests that use demo app My::Journal' }
else { plan 'no_plan' }
use_ok( 'My::Journal' );

#~~~~~~
# Prepare null device for supressing output...
open ( my $devnull, '>', File::Spec->devnull() );

my $app = My::Journal->new();

# Build fake interactive request sequence...
my @application_quit_signals = $app->quit_signals();
my $canned_request = [
    [ 'list' ],
    [ 'publish' ],
    [ 'help', 'entry' ],
    [ 'entry', 'foo' ],
    [ 'tree' ],
    [ 'bogus' ],
    [ 'menu' ],
    [ 'dump' ],

    # (2nd-to-last canned request will be the last command run):
    [ 'entry' ],
    # (last canned request should be a 'quit signal')
    [ $application_quit_signals[0] ]
];
# Replace normal procedure to interactively read requests with a dummy
# version that uses our fake request sequence...
{
    no strict 'refs'; no warnings;
    *{My::Journal::read_cmd} = \&get_canned_request;
}
#~~~~~~

ok( ! $app->get_interactivity_mode(), 'just after construction, application is non-interactive' );
ok( $app->set_interactivity_mode(1), 'interactivity mode set' );
ok( $app->get_interactivity_mode(), 'after turning ON interactivity mode, application state is interactive' );

my @valid_commands = keys %{ $app->command_map_hashref() };
my @noninteractive_commands = $app->noninteractive_commands();

# We expect the interactive commands to be those which are valid but NOT non-interactive...
my @expected_interactive;
for my $valid (@valid_commands) {
    push(@expected_interactive, $valid) unless grep { $valid eq $_ } $app->noninteractive_commands();
}
@expected_interactive = sort @expected_interactive;
my @got_interactive = sort $app->get_interactive_commands();

is_deeply( \@got_interactive, \@expected_interactive,
    'in interactive mode, non-interactive commands are not included in the set of commands returned by get_interactive_commands()' );

# Send output to null device...
select $devnull;

ok( $app->run_interactive( initialize => 1 ), 'run_interactive()' );
is( $app->get_current_command(), $canned_request->[-2]->[0], 'interactive session ended with expected command' );

# Make sure that non-interactive commands get forwarded to 'help' in
# interactive mode:
$canned_request = [
    [ 'console' ],
    [ $application_quit_signals[0] ]
];
ok( $app->run_interactive( initialize => 1 ), 'run_interactive()' );
is( $app->get_current_command(), 'help', "attempt to run non-interactive command in interactive session forwards to 'help' command" );

# Make sure that requests for usage info for non-interactive commands get
# forwarded to 'help' in interactive mode:
$canned_request = [
    [ 'help console' ],
    [ $application_quit_signals[0] ]
];
ok( $app->run_interactive( initialize => 1 ), 'run_interactive()' );
is( $app->get_current_command(), 'help', "attempt to show usage info for non-interactive command in interactive session forwards to 'help' command" );

#~~~~~~
close $devnull;
#~~~~~~

# Command request reader that iterates over our fake request sequences:
{
    my $i = 0;
    sub get_canned_request {
        my $j = $i++ % @$canned_request;
        @ARGV = @{ $canned_request->[$j] };
        return 1;
    }
}

__END__

=pod

=head1 PURPOSE

To verify basic CLIF features related to interactivity.

=cut