1package Test::Util; 2 3use Test::Util::Base -Base; 4use Carp qw( confess ); 5use IPC::Run3; 6#use Data::Dumper::Simple; 7 8our @EXPORT = qw( 9 test_shell_command run_shell 10 split_arg join_list 11 process_pre process_post 12 process_found process_not_found 13); 14 15sub process_pre ($) { 16 my $block = shift; 17 my $code = $block->pre; 18 return if not $code; 19 { 20 package main; 21 eval $code; 22 } 23 confess "error in `pre' section: $@" if $@; 24} 25 26sub process_post ($) { 27 my $block = shift; 28 my $code = $block->post; 29 return if not $code; 30 { 31 package main; 32 eval $code; 33 } 34 confess "error in `post' section: $@" if $@; 35} 36 37sub process_found ($) { 38 my $block = shift; 39 my $buf = $block->found; 40 return if not $buf; 41 my @files = split /\s+/s, $buf; 42 for my $file (@files) { 43 Test::More::ok( 44 (-f $file), 45 "File $file should be found - ".$block->name 46 ); 47 } 48} 49 50sub process_not_found ($) { 51 my $block = shift; 52 my $buf = $block->not_found; 53 return if not $buf; 54 my @files = split /\s+/s, $buf; 55 for my $file (@files) { 56 Test::More::ok( 57 !(-f $file), 58 "File $file should NOT be found - ".$block->name 59 ); 60 } 61} 62 63sub compare ($$$) { 64 my ($got, $expected, $desc) = @_; 65 return if not defined $expected; 66 if ($desc =~ /\w+_like/) { 67 Test::More::like($got, qr/^$expected$/ms, $desc); 68 } else { 69 Test::More::is($got, $expected, $desc); 70 } 71} 72 73sub join_list (@) { 74 my @args = @_; 75 for (@args) { 76 if (ref $_ eq 'ARRAY') { 77 $_ = join('', @$_); 78 } 79 } 80 return wantarray ? @args : $args[0]; 81} 82 83sub test_shell_command ($$@) { 84 my $block = shift; 85 my $cmd = shift; 86 my %filters = @_; 87 return if not defined $cmd; 88 89 my ($stdout, $stderr); 90 run3($cmd, \undef, \$stdout, \$stderr); 91 my $errcode = $?; 92 $errcode >>= 8; 93 my $success = ($errcode == 0); 94 95 my $errcode2 = $block->error_code; 96 if ($errcode2 and $errcode2 =~ /\d+/) { 97 $errcode2 = $&; 98 } 99 100 my $success2 = $block->success; 101 if ($success2 and $success2 =~ /\w+/) { 102 $success2 = lc($&); 103 } 104 105 my $name = $block->name; 106 107 while (my ($key, $val) = each %filters) { 108 #warn "$key $val"; 109 if ($key eq 'stdout') { 110 $stdout = $val->($stdout); 111 } elsif ($key eq 'stderr') { 112 $stderr = $val->($stderr); 113 } 114 } 115 116 #warn "!!!~~~~ $stdout"; 117 #warn "!!!~~~~ ", $block->stdout; 118 #use Test::Differences; 119 #eq_or_diff $stdout, $block->stdout; 120 compare $stdout, $block->stdout, "stdout - $name"; 121 compare $stdout, $block->stdout_like, "stdout_like - $name"; 122 compare $stderr, $block->stderr, "stderr - $name"; 123 compare $stderr, $block->stderr_like, "stderr_like - $name"; 124 compare $errcode, $errcode2, "error_code - $name"; 125 compare ( 126 $success ? 'true' : 'false', 127 $success2, 128 "success - $name", 129 ); 130 if (not defined $block->stderr() and 131 not defined $block->stderr_like() and 132 $stderr) { 133 warn $stderr; 134 } 135} 136 137# returns ($error_code, $stdout, $stderr) 138sub run_shell (@) { 139 my ($cmd, $verbose) = @_; 140 #$IPC::Cmd::USE_IPC_RUN = 1; 141 142 #confess Dumper($cmd); 143 my ($stdout, $stderr); 144 run3($cmd, \undef, \$stdout, \$stderr); 145 my $errcode = $?; 146 147 #warn "HERE!"; 148 #warn "^^^ Output: $res[2][0]"; 149 return ($errcode, $stdout, $stderr); 150} 151 1521; 153