use strict; use File::Spec; use IPC::Run3 qw/run3/; use Probe::Perl; use Test::More; plan tests => 2 ; my $perl = Probe::Perl->find_perl_interpreter; my $script = File::Spec->catfile(qw/scripts foo.pl/); my ($got_stdout, $got_stderr); ok( -r $script, "foo.pl script readable" ); # run and capture output run3 "$perl $script", undef, \$got_stdout, \$got_stderr; is( $got_stdout, $expected_stdout), "foo.pl program output" ); #### use t::CLI; my $script = File::Spec->catfile( "scripts", "wikidoc" ); my $wikidoc = t::CLI->new($script); # setup $input_file and $output_file $wikidoc->runs_ok( "$input_file", "$output_file" ); $wikidoc->stdout_like( qr/Extracting Pod from \Q$input_file\E/, "'wikidoc file file' status message" ); #### package t::CLI; use strict; use warnings; use Test::Builder; use Probe::Perl; use Cwd qw( abs_path ); use IPC::Run3; use File::Basename qw( basename ); use File::Spec; #use POSIX qw( WEXITSTATUS ); my $Test = Test::Builder->new; my $pp = Probe::Perl->new; my $perl = abs_path($pp->find_perl_interpreter); my $cwd = abs_path( "." ); my $coverdb = File::Spec->catdir($cwd,"cover_db"); my $cover = index( ($ENV{HARNESS_PERL_SWITCHES} || ''), '-MDevel::Cover' ) < 0 ? '' : "-MDevel::Cover=-db,$coverdb" ; #--------------------------------------------------------------------------# # Main API #--------------------------------------------------------------------------# sub new { my ($class, $program, @default_args ) = @_; my $self = bless {}, $class; $self->program( $program ); $self->default_args( [@default_args] ); return $self; } # returns success or failure; exit_code is opposite (0 is good); actual error # message is in @$ sub run { my ($self, @args) = @_; my ($stdout, $stderr); my $stdin = $self->stdin; my @cmd = ( $perl, "-Mblib=$cwd", # must hard code this in case curdir changed ( $cover ? $cover : () ), $self->{program}, @{ $self->default_args() }, @args, ); eval { run3 \@cmd, \$stdin, \$stdout, \$stderr; $self->exit_code( $? >> 8 || 0 ); }; my $result = $@ eq q{} ? 1 : 0; $self->stdout($stdout); $self->stderr($stderr); $@ .= "(running '@cmd')"; return $result; } #--------------------------------------------------------------------------# # Accessors #--------------------------------------------------------------------------# sub program { my ($self, $filename) = @_; if (defined $filename) { die "Can't find $filename" if ! -e $filename; $self->{program} = abs_path($filename); } return basename( $self->{program} ); } BEGIN { my $evaltext = << 'CODE'; sub { $_[0]->{PROP} = $_[1] if @_ > 1; return $_[0]->{PROP}; } CODE for ( qw( exit_code stdin stdout stderr default_args)) { no strict 'refs'; (my $sub = $evaltext) =~ s/PROP/$_/g; *{__PACKAGE__ . "::$_"} = eval $sub; } } #--------------------------------------------------------------------------# # Testing functions #--------------------------------------------------------------------------# sub runs_ok { my ($self, @args) = @_; my $label = "Ran " . $self->program() . " with " . (@args && $args[0] ne q{} ? "args '@args'" : "no args" ) . " without error"; my $runs = $self->run(@args); die $@ if ! $runs; my $ok = $Test->ok( ! $self->exit_code, $label ); if ( ! $ok ) { $Test->diag( "Exit code: " . $self->exit_code . "\n"); $Test->diag( "STDERR: " . $self->stderr . "\n") if $self->stderr; $Test->diag( "STDOUT: " . $self->stdout . "\n") if $self->stdout; } return $ok; } sub dies_ok { my ($self, @args) = @_; my $label = $self->program . " with " . (@args && $args[0] ne q{} ? "args '@args'" : "no args" ) . " ended with an error"; my $runs = $self->run(@args); die $@ if ! $runs; my $ok = $Test->ok( $self->exit_code, $label ); if ( ! $ok ) { $Test->diag( "Exit code: " . $self->exit_code . "\n"); } return $ok; } sub exits_with { my ($self, $expect, @args) = @_; my $label = $self->program . " with " . (@args && $args[0] ne q{} ? "args '@args'" : "no args" ) . " ended with exit code $expect"; my $runs = $self->run(@args); die $@ if ! $runs; return $Test->is_num( $self->exit_code, $expect, $label ); } sub stdout_is { my ($self, $expect, $label) = @_; return $Test->is_eq( $self->stdout, $expect, $label ? "... $label" : "... " . $self->program . " had correct output to STDOUT" ); } sub stdout_like { my ($self, $expect, $label) = @_; return $Test->like( $self->stdout, $expect, $label ? "... $label" : "... " . $self->program . " had correct output to STDOUT" ); } sub stderr_is { my ($self, $expect, $label) = @_; return $Test->is_eq( $self->stderr, $expect, $label ? "... $label" : "... " . $self->program . " had correct output to STDERR" ); } sub stderr_like { my ($self, $expect, $label) = @_; return $Test->like( $self->stderr, $expect, $label ? "... $label" : "... " . $self->program . " had correct output to STDERR" ); } 1; #true