7 { # silence fail diagnostics because of single caller
8 no warnings 'redefine';
9 sub Test::Builder::_ok_debug {}
15 'cat \Klog/' => '/var/log/apache2/',
18 my $filename = 'barcat';
19 open my $input, '<', $filename
20 or die "Cannot read documentation from $filename script\n";
23 while (readline $input) {
24 # find code snippets in the appropriate section
25 /^=head1 EXAMPLES/ ... /^=head1/ or next;
29 # compose an identifier from significant parts
31 s/^\h+//; # indentation
32 s/\\\n\s*//g; # line continuations
33 s/^[(\h]+//; # subshell
34 s/^echo\ .*?\|\s*//; # preceding input
35 s/\|.*//; # subsequent pipes
36 s/^cat\ //; # local file
37 s/^curl\ // and do { # remote url
38 s/\ -.+//g; # download options
39 s{//[^/\s]+/\K\S*(?=/)}{}; # subdirectories
40 s{^https?://}{}; # http protocol
44 # prepare shell command to execute
46 while (my ($subcmd, $args) = each %CMDARGS) {
47 $subcmd .= " \\K", $args .= ' ' unless $subcmd =~ m/\\K/;
48 $cmd =~ s/\b$subcmd/$args/;
50 $cmd =~ s/'/'\\''/g, $cmd = " bash -c 'set -o pipefail\n$cmd'";
52 # run and report unexpected results
54 my $output = qx($cmd);
55 $? == 0 or die "error status ", $? >> 8, "\n";
56 length $output or die "empty output\n";
58 }, $name) or diag("Failed command\n$cmd\nfrom $filename line $.: $@");