package Test::Util; use Test::Util::Base -Base; use Carp qw( confess ); use IPC::Run3; #use Data::Dumper::Simple; our @EXPORT = qw( test_shell_command run_shell split_arg join_list process_pre process_post process_found process_not_found ); sub process_pre ($) { my $block = shift; my $code = $block->pre; return if not $code; { package main; eval $code; } confess "error in `pre' section: $@" if $@; } sub process_post ($) { my $block = shift; my $code = $block->post; return if not $code; { package main; eval $code; } confess "error in `post' section: $@" if $@; } sub process_found ($) { my $block = shift; my $buf = $block->found; return if not $buf; my @files = split /\s+/s, $buf; for my $file (@files) { Test::More::ok( (-f $file), "File $file should be found - ".$block->name ); } } sub process_not_found ($) { my $block = shift; my $buf = $block->not_found; return if not $buf; my @files = split /\s+/s, $buf; for my $file (@files) { Test::More::ok( !(-f $file), "File $file should NOT be found - ".$block->name ); } } sub compare ($$$) { my ($got, $expected, $desc) = @_; return if not defined $expected; if ($desc =~ /\w+_like/) { Test::More::like($got, qr/^$expected$/ms, $desc); } else { Test::More::is($got, $expected, $desc); } } sub join_list (@) { my @args = @_; for (@args) { if (ref $_ eq 'ARRAY') { $_ = join('', @$_); } } return wantarray ? @args : $args[0]; } sub test_shell_command ($$@) { my $block = shift; my $cmd = shift; my %filters = @_; return if not defined $cmd; my ($stdout, $stderr); run3($cmd, \undef, \$stdout, \$stderr); my $errcode = $?; $errcode >>= 8; my $success = ($errcode == 0); my $errcode2 = $block->error_code; if ($errcode2 and $errcode2 =~ /\d+/) { $errcode2 = $&; } my $success2 = $block->success; if ($success2 and $success2 =~ /\w+/) { $success2 = lc($&); } my $name = $block->name; while (my ($key, $val) = each %filters) { #warn "$key $val"; if ($key eq 'stdout') { $stdout = $val->($stdout); } elsif ($key eq 'stderr') { $stderr = $val->($stderr); } } #warn "!!!~~~~ $stdout"; #warn "!!!~~~~ ", $block->stdout; #use Test::Differences; #eq_or_diff $stdout, $block->stdout; compare $stdout, $block->stdout, "stdout - $name"; compare $stdout, $block->stdout_like, "stdout_like - $name"; compare $stderr, $block->stderr, "stderr - $name"; compare $stderr, $block->stderr_like, "stderr_like - $name"; compare $errcode, $errcode2, "error_code - $name"; compare ( $success ? 'true' : 'false', $success2, "success - $name", ); if (not defined $block->stderr() and not defined $block->stderr_like() and $stderr) { warn $stderr; } } # returns ($error_code, $stdout, $stderr) sub run_shell (@) { my ($cmd, $verbose) = @_; #$IPC::Cmd::USE_IPC_RUN = 1; #confess Dumper($cmd); my ($stdout, $stderr); run3($cmd, \undef, \$stdout, \$stderr); my $errcode = $?; #warn "HERE!"; #warn "^^^ Output: $res[2][0]"; return ($errcode, $stdout, $stderr); } 1;