Execute.pm (2516B)
1 package Test::Execute; 2 3 use 5.16.0; 4 use strict; 5 use warnings FATAL => 'all'; 6 7 use Test::More; 8 use Capture::Tiny qw/ capture_merged /; 9 use Exporter 'import'; 10 use Carp 'croak'; 11 use Scalar::Util 'reftype'; 12 13 our $VERSION = '0.001'; 14 15 our @EXPORT = qw( 16 run 17 script 18 $path 19 ); 20 21 our $path = ""; 22 23 sub run { 24 my %args = ( 25 exit => 0, 26 cmd => [], 27 input => undef, 28 test => 1, 29 expected => undef, 30 name => undef, 31 @_ 32 ); 33 34 my @cmd = @{ $args{cmd} }; 35 return undef unless @cmd; # no command to run 36 37 my ($exit, $input, $test, $expected, $name, $note) = 38 @args{qw/ exit input test expected name note /}; 39 40 my ($output, $return) = capture_merged { 41 my $ret; 42 if (defined $input) { 43 my $pid = open (my $fh, '|-', @cmd); 44 last unless $pid; 45 print { $fh } $input or last; 46 close $fh; 47 $ret = $? >> 8; 48 } else { 49 $ret = system(@cmd) && $? >> 8; 50 } 51 }; 52 53 if ($note) { 54 note sprintf "Exit value: %s", $return // '<undef>'; 55 note "Output: $output"; 56 } 57 58 if (not $test) { 59 if (defined $expected and ref $expected eq 'Regexp') { 60 return $output =~ $expected; 61 } elsif (defined $expected and ref $expected eq 'CODE') { 62 local $_ = $output; 63 return $expected->($output); 64 } 65 return $return; 66 } 67 68 $name //= "Testing run of @cmd"; 69 local $Test::Builder::Level = $Test::Builder::Level + 2; 70 subtest $name => sub { 71 plan tests => 2; 72 73 # 1: Test output 74 if (not defined $expected) { 75 SKIP: { skip "Expected output undefined", 1 } 76 } elsif (ref $expected eq 'Regexp') { 77 like ($output, $expected, "$name - output"); 78 } elsif (ref $expected eq 'CODE') { 79 local $_ = $output; 80 ok ($expected->($output), "$name - output") or note "Output: $output"; 81 } else { 82 is ($output, $expected, "$name - output"); 83 } 84 85 # 2: Test exit value 86 if (not defined $exit) { 87 SKIP: { skip "Expected exit value undefined", 1 } 88 } else { 89 is ($return, $exit, "$name - exit value"); 90 } 91 }; 92 93 } 94 95 sub script { 96 my @cmd; 97 while (@_ and not defined reftype($_[0])) { 98 my $arg = shift @_; 99 push @cmd, $arg; 100 } 101 102 my %args; 103 if (@_ and reftype($_[0]) eq 'HASH') { %args = %{ $_[0] }; } 104 elsif (@_) { croak "Unknown argument passed: $_[0]"; } 105 if (exists $args{cmd} and @cmd) { croak "More than one command passed"; } 106 if (exists $args{cmd}) { @cmd = @{ $args{cmd} }; } 107 108 my $cmd = shift @cmd; 109 if (not defined $cmd) { croak "No command passed"; } 110 $args{name} //= "Testing script run of $cmd @cmd"; 111 my @lib = map { "-I$_" } @INC; 112 @cmd = ($^X, @lib, "$path$cmd", @cmd); 113 114 $args{cmd} = \@cmd; 115 return run(%args); 116 } 117 118 1;