example-script

# -*- mode: cperl -*-

# To run this in Test::TUI's source tree, do this:
#
#  % perl -Iperl ./example-script
#
# You can also let Perl's `prove' harness run the script and see how that would
# look like:
#
#  % prove -Iperl ./example-script
#
# Or for more verbosity:
#
#  % prove -Iperl -v ./example-script

# This is an example script to demonstrate the usage of Test::TUI and some of
# its auxiliary modules. To do that, this script implements a test run through
# `aumix', a terminal-user-interface audio mixer.
#
# `aumix' works like this: It provides textual volume sliders that look like
# this:
#
#    ++++++++++++++++++O++++++
#
# The `O' represents the slider position, the pluses represent the length over
# which that slider may be pushed. To manipiulate the slider's position, you
# have several options:
#
#  a) Press a digit key, such as `5', which will move the slider to the 50%
#     mark. Similarly, `2' moves it to 20%.
#
#  b) Press `+' or `-' to move the slider right or left by exactly one
#     character-cell.
#
#  c) Press the Left or Right arrow keys, which works like `-' and `+'.
#
# There are more things you could do, but this is a nice set, that allows us to
# demonstrate quite a few of Test::TUIs features.
#
# This script tests the following:
#
#  - Does `5' move the slider to 50%?
#  - Move the slider around using +/-; see if the position changes correctly.
#  - Do the same for arrow keys instead of +/-.
#  - Tell the program to exit, by sending a `q' character to it.
#  - Check is the program actually exits and if the return code is 0 (success).

# This is a normal Perl script, so use strict.
use strict;
use warnings;

# Let's ask the POSIX module what this system thinks an application should
# return if it wants to signal successful termination:
use POSIX qw{ EXIT_SUCCESS };

# The main module...
use Test::TUI;

# ...and an auxiliary module for inpecting the user interface of the
# application under test; this is useful for writing custom conditions.
use Test::TUI::Inspect qw{ terminal_plain_line };

# Also, another auxiliary module, that implements helpers for dealing with the
# underlying terminal (namely a `vt102' as implemented by Term::VT102).
use Test::TUI::VT102 qw{ key };

my ($fifty_percent_slider);

# Set some options for Test::TUI. This makes the execution very noisy and a tad
# slower than it is normally, so you can follow what is going on.
testtuiset { trace => 1,
             debug => 1,
             dump => 1,
             write_wait => 2000 };

# Test::TUI uses Data::Dumper for some of its informational and debugging
# output. Subroutines are usually represented by dummy-code. Setting the
# following variable forces Data::Dumper to turn code-refs back into Perl code,
# which is rather enlightening in some cases. See Data::Dumper's reference
# documentation as well as B::Deparse for details on that feature.
$Data::Dumper::Deparse = 1;

# First, define the application that we want to test. Note, that the following
# are equal:
#
#   application_under_test("foobar", "-bar", "-baz");
#
#   application_under_test qw{ foobar -bar -baz };
#
# The command is NOT passed through a shell but called directly.
application_under_test qw{ aumix };

# Define some helper functions and costum conditions...
sub extract_main_slider_80x24 {
    # In 80x24 terminals, the main-slider will be here:
    return terminal_plain_line(1, 13, 13+25);
}

sub check_fifty_percent {
    $fifty_percent_slider = extract_main_slider_80x24();
    my @result = split /O/, $fifty_percent_slider;
    if ($#result != 1) {
        print "# Slider does not contain exactly one `O'!\n";
        return 0;
    }
    my ($l0, $l1) = map { length $_ } @result;

    unless (abs($l1 - $l0) < 2) {
        print "# Slider not in the middle ($fifty_percent_slider)\n";
        return 0;
    }
    return 1;
}

# Finally, this function generates a part of the test script. A test-script is
# just an list of things, that look a certain way; how we arrive at that list
# is entirely up to us - thus, generating it on the fly is perfectly legal.
#
# Since this example enables Test::TUI's `debug' configuration parameter above,
# you'll be able to see the entire generated test-script dumped somewhere at
# the beginning of the example's execution.
sub move_slider {
    my ($mode) = @_;
    my (@script, $up3, $down3, $up, $down);

    if ($mode eq q{arrow}) {
        $up = key(q{Right});
        $down = key(q{Left});
        if (!defined $up || !defined $down || $up eq q{} || $down eq q{}) {
            print
"# Warning: Either `Left' or `Right' was undefined in this system's `vt102'\n" .
"#          termcap entry. Skipping arrow-based slider movement test.\n";
            return @script;
        }
    } else {
        $up = q{+};
        $down = q{-};
    }
    $up3 = $up . $up . $up;
    $down3 = $down . $down . $down;

    @script = (
        # Change the slider's position a bit. "---" means, that Test::TUI
        # sends three dashes to aumix as quickly as it can. Note that multiple
        # consecutive send steps in a test script will wait `write_wait' milli-
        # seconds between writes (defaults to 100). So, the sequence below is
        # *NOT* the same as: "---+++--++"
        $down3,
        $up3,
        $down,
        $down,
        $up,
        $up,

        # We dealt as many ups as we did downs, so the slider should be in the
        # same position as it was after the `5' we send above. Use an anonymous
        # function as the custom condition to check if that's actually the
        # case.
        { title => "moving slider around using $mode keys",
          expect => sub {
              my $current_slider = extract_main_slider_80x24();
              if ($current_slider ne $fifty_percent_slider) {
                  print "# Slider didn't return to original position.\n";
                  return 0;
              }
              return 1 } },
    );
    return @script;
}

# Now define the sequence of events we'd like to replicate each time this
# script runs.
test_script [
    # The first entry in a test script has to be an entry that describes how
    # many tests you are planning to run. This is information for the TAP
    # harness so it can tell whether or not tests where skipped or not.
    #
    # If you do not know how many tests you are going to run, set this to the
    # "noplan" string. If you do, specify the according integer.
    #
    # Every `until', `expect' and `programexit' directive is a test.
    { plan => 5 },

    # Make sure `aumix' booted entirely, by checking if it has drawn a certain
    # known part of its interface already. This timeouts at the default
    # `until_timeout', which is exactly one second. `string' is actually one of
    # the builtin conditions. Another would be `regexp'. See the manual for
    # details on all of them.
    #
    # Each testing directive (that would be `until' like here, `expect' or
    # `programexit') may define a title that will turn up in the TAP output
    # while the script is running:
    #
    #    ok 1 - application starts up normally
    #
    # If you do not specify a title, the type of directive is used instead:
    #
    #    ok 1 - until
    { title => "application starts up normally",
      until => { string => "aumix",
                 line => 1,
                 length => 5 } },

    # Send a `5' to aumix. This moves the main output slider to 50%.
    "5",

    # Use a custom condition, to check whether the slider is actually in 50%
    # position. Also, save the way the slider looks, so we can check if the
    # slider returned to this position after we changed its position a bit.
    { title => "slider moves to 50% position",
      expect => \&check_fifty_percent },

    # Move the slider around with ASCII "+" and "-".
    move_slider("ascii"),

    # Move the slider around with the VT102's left and right arrows. Since
    # arrows and plus/minus should behave the same, we check for exactly the
    # same outcome. And since we don't want to repeat outselves needlessly,
    # we're implementing this part of the test-script by a function, that
    # generates these parts for us accordingly.
    move_slider("arrow"),

    # Now send a `q' to aumix, which should cause it to terminate.
    "q",

    # Wait for aumix to terminate and check if its exit-code is 0. This would
    # timeout after `exit_timeout' milliseconds (which defaults to 5000).
    { title => "application exited normally",
      programexit => EXIT_SUCCESS } ];

# Now run the script that we just defined and exit with the appropriate exit
# code (see the manual for details about those).
run_test_script;