Skip to content

Instantly share code, notes, and snippets.

@zoffixznet

zoffixznet/p6.p6 Secret

Created June 2, 2017 01:13
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save zoffixznet/79543eee430a9833bd405c6580314796 to your computer and use it in GitHub Desktop.
use v6.d.PREVIEW;
module Proc::Q {
sub proc-q (
+@commands where .so && .all ~~ List & .so,
:@tags where .elems == @commands && .all ~~ Cool = @commands,
:@in where .elems == @commands|0 && .all ~~ Cool,
Numeric :$timeout where .DEFINITE.not | $_ > 0,
UInt:D :$batch where .so = 8,
Bool:D :$out = True,
Bool:D :$err = True,
Bool:D :$merge where .not | .so & $out & $err = False,
--> Supply:D
) is export {
supply (@commands Z @tags Z @in).batch($batch).map: -> $pack {
my @results = $pack.map: -> ($command, $tag, $in) {
start do with Proc::Async.new: |$command, :w($in.so) -> $proc {
my $out-res = ''; my $err-res = ''; my $mer-res = '';
$out and $proc.stdout.tap: $out-res ~= *;
$err and $proc.stderr.tap: $err-res ~= *;
if $merge {
$proc.stdout.tap: $mer-res ~= *;
$proc.stderr.tap: $mer-res ~= *;
}
my $prom = $proc.start;
if $in {
await $in ~~ Blob ?? $proc.write: $in !! $proc.print: $in;
$proc.close-stdin;
}
my $killed = False;
$timeout.DEFINITE and Promise.in($timeout).then: {
$prom or try {
$killed = True;
say "Killing!";
$proc.kill: SIGHUP;
Promise.in(½).then: $proc.kill: SIGTERM;
Promise.in(1).then: $proc.kill: SIGSEGV;
}
}
my $proc-obj = await $prom;
class Res {
has Str:D $.err is required;
has Str:D $.out is required;
has Str:D $.merged is required;
has Int:D $.exitcode is required;
has Str:D $.tag is required;
has Bool:D $.killed is required;
}.new: :err($err-res), :out($out-res), :merged($mer-res),
:$tag, :$killed, :exitcode($proc-obj.exitcode);
}
}
while @results {
await Promise.anyof: @results;
my @ready = @results.grep: *.so;
@results .= grep: none @ready;
emit .status ~~ Kept ?? .result !! .cause for @ready;
}
}
}
import Proc::Q;
my @commands = <foo bar ber meow moo>;
my $sup = proc-q @commands.map({(
$*EXECUTABLE, '-e',
'say "\qq[$_]" ~ $*IN.slurp; note "meows";'
~ ' sleep ' ~ ($++ > 2 ?? $++ !! 1000)
~ '; exit ' ~ $++
)}),
:tags[@commands.map: 'tag-' ~ *], :in[@commands».uc], :timeout(2.8), :merge;
my @res; react whenever $sup { @res.push: $_ }
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment