use 5.014;
use warnings;
use re '/ms';
-use IPC::Run 'run';
use Test::More;
{ # silence fail diagnostics because of single caller
sub Test::Builder::_ok_debug {}
}
+eval q(use IPC::Run 'run');
+plan skip_all => "IPC::Run required to test commands" if $@;
+
my %CMDARGS = (
- ping => '-c 1',
+ ping => '-c 1 ',
'cat \Khttpd/' => '/var/log/apache2/',
+ ' \K\*(?=\h*\|)' => 'sample/media/*.*',
+ find => 'sample/media -name \*.\* ',
);
my $filename = 'barcat';
local $/ = "\n\n";
while (readline $input) {
+SKIP: {
# find scriptlets in the appropriate section
/^=head1 EXAMPLES/ ... /^=head1/ or next;
/^\h/ or next; # indented code snippet
my $ref = "$filename line $.";
# store curl downloads
- s{\bcurl (\S*)(?<param>[^|]*)}{
- my $url = $1;
- my @params = split ' ', $+{param};
+ $cmd =~ s{\bcurl (\S*)([^|]*)}{
+ my ($url, $params) = ($1, $2);
+ my $cache = 'sample/data/';
+ -w $cache or skip($url, 2);
my $ext = (
$cmd =~ /\bxml/ ? 'xml' :
$cmd =~ / jq / ? 'json' :
);
my ($domain, $path) = $url =~ m{//([^/]+) .*/ ([^/]*) \z}x;
$path =~ s/\.$ext\z//;
- my $cache = join '.', $path =~ tr/./_/r, $domain, $ext;
- $cache = "sample/data/$cache";
+ $cache .= join '.', $path =~ tr/./_/r, $domain, $ext;
+ my $cached = -e $cache;
SKIP: {
- -e $cache and skip($url, 1);
- ok(defined runres(['curl', '-sS', $url, '-o', $cache, @params]), $url)
- or diag("download at $ref: $@");
+ # download to file
+ skip($url, 1) if $cached;
+ $cached = defined runres("curl -sSf $url$params -o $cache");
+ ok($cached, $url) or diag("download at $ref: $@");
}
+ $cached or skip($url, 1);
"cat $cache"
}e;
# prepare shell command to execute
while (my ($subcmd, $args) = each %CMDARGS) {
- $subcmd .= " \\K", $args .= ' ' unless $subcmd =~ m/\\K/;
- $cmd =~ s/\b$subcmd/$args/;
+ $subcmd .= " \\K" unless $subcmd =~ m/\\K/;
+ $cmd =~ s/$subcmd/$args/;
+ }
+
+ for my $param ($cmd =~ m{^[(\h]* (\w\S*)}gx) {
+ $param eq 'cat' or
+ runres(['which', $param])
+ or diag("dependency $param missing at $ref\n$cmd"), skip($name, 1);
}
# run and report unexpected results
if (open my $record, '>', "sample/out/t$numprefix-$name.txt") {
print {$record} $output;
}
-}
+}}
sub runres {
my ($cmd) = @_;