MooX-Cmd

 view release on metacpan or  search on metacpan

lib/MooX/Cmd/Tester.pm  view on Meta::CPAN


sub _run_with_capture
{
    my ($app, $argv) = @_;

    my ($execute_rv, $cmd, $cmd_name, $error);

    my ($stdout, $stderr, $merged, $ok) = _capture_merged
    {
        eval {
            local $TEST_IN_PROGRESS = 1;
            local @ARGV             = @$argv;

            my $tb = $CLASS->builder();

            $cmd = ref $app ? $app : $app->new_with_cmd;
            ref $app and $app = ref $app;
            my $test_ident = "$app => [ " . join(" ", @$argv) . " ]";
            ok($cmd->isa($app), "got a '$app' from new_with_cmd");
            @$argv
              and defined($cmd_name = $cmd->command_name)
              and ok((grep { index($cmd_name, $_) != -1 } @$argv), "proper cmd name from $test_ident");
            ok(scalar @{$cmd->command_chain} <= 1 + scalar @$argv, "\$#argv vs. command chain length testing $test_ident");
            @$argv and ok($cmd->command_chain_end == $cmd->command_chain->[-1], "command_chain_end ok");

            unless ($execute_rv = $cmd->execute_return)
            {
                my ($command_execute_from_new, $command_execute_method_name);
                my $cce = $cmd->can("command_chain_end");
                $cce                      and $cce                      = $cce->($cmd);
                $cce                      and $command_execute_from_new = $cce->can("command_execute_from_new");
                $command_execute_from_new and $command_execute_from_new = $command_execute_from_new->($cce);
                $command_execute_from_new or $command_execute_method_name = $cce->can('command_execute_method_name');
                $command_execute_method_name
                  and $execute_rv = [$cce->can($command_execute_method_name->($cce))->($cce)];
            }
            1;
        } or $error = 1;
        $@ and $error = $@;
    };

    return {
        app        => $app,
        cmd        => $cmd,
        stdout     => $stdout,
        stderr     => $stderr,
        output     => $merged,
        error      => $error,
        execute_rv => $execute_rv,
    };
}

{
    ## no critic qw(ProhibitMultiplePackages)
    package    # no-index
      MooX::Cmd::Tester::Result;

    sub new
    {
        my ($class, $arg) = @_;
        bless $arg => $class;
    }
}

my $res = Package::Stash->new("MooX::Cmd::Tester::Result");
for my $attr (qw(app cmd stdout stderr output error execute_rv exit_code))
{
    $res->add_symbol('&' . $attr, sub { $_[0]->{$attr} });
}

{
    ## no critic qw(ProhibitMultiplePackages)
    package    # no-index
      MooX::Cmd::Tester::Exited;

    sub throw
    {
        my ($class, $code) = @_;
        defined $code or $code = 0;
        my $self = (bless \$code => $class);
        ## no critic qw(RequireCarping)
        die $self;
    }
}

=head1 NAME

MooX::Cmd::Tester - MooX cli app commands tester

=head1 SYNOPSIS

  use MooX::Cmd::Tester;
  use Test::More;

  use MyFoo;

  # basic tests as instance check, initialization check etc. is done there
  my $rv = test_cmd( MyFoo => [ command(s) option(s) ] );

  like( $rv->stdout, qr/operation successful/, "Command performed" );
  like( $rv->stderr, qr/patient dead/, "Deal with expected command error" );

  is_deeply( $rv->execute_rv, \@expected_return_values, "got what I deserve?" );

  cmp_ok( $rv->exit_code, "==", 0, "Command successful" );

=head1 DESCRIPTION

The test coverage of most CLI apps is somewhere between poor and wretched.
With the same approach as L<App::Cmd::Tester> comes MooX::Cmd::Tester to
ease writing tests for CLI apps.

=head1 FUNCTIONS

=head2 test_cmd

  my $rv = test_cmd( MyApp => \@argv );

test_cmd invokes the app with given argv as if would be invoked from
command line and captures the output, the return values and exit code.

Some minor tests are done to prove whether class matches, execute succeeds,
command_name and command_chain are not totally scrambled.

It returns an object with following attributes/accessors:

=head3 app

Name of package of App

=head3 cmd

Name of executed (1st level) command

=head3 stdout

Content of stdout

=head3 stderr

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 0.452 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )