MooX-Cmd
view release on metacpan - search on metacpan
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 distributionview release on metacpan - search on metacpan
( run in 0.452 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )