1. my class Proc {
  2. has IO::Pipe $.in;
  3. has IO::Pipe $.out;
  4. has IO::Pipe $.err;
  5. has $.exitcode = -1; # distinguish uninitialized from 0 status
  6. has $.signal;
  7. has @.command;
  8. has $!in_fh;
  9. has $!out_fh;
  10. has $!err_fh;
  11. has int $!flags;
  12. submethod BUILD(:$in = '-', :$out = '-', :$err = '-', :$exitcode,
  13. Bool :$bin, Bool :$chomp = True, Bool :$merge, :$command,
  14. Str :$enc, Str:D :$nl = "\n", :$signal --> Nil) {
  15. if $merge {
  16. die "Executing programs with :merge is known to be broken\n"
  17. ~ "Please see https://rt.perl.org//Public/Bug/Display.html?id=128594 for the bug report.\n";
  18. }
  19. @!command = |$command if $command;
  20. if nqp::istype($in, IO::Handle) && $in.DEFINITE {
  21. $!in_fh := nqp::getattr(nqp::decont($in), IO::Handle, '$!PIO');
  22. $!flags += nqp::const::PIPE_INHERIT_IN;
  23. }
  24. elsif $in === True {
  25. $!in_fh := nqp::syncpipe();
  26. $!flags += nqp::const::PIPE_CAPTURE_IN;
  27. $!in = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$enc, :$bin,
  28. nl-out => $nl, :PIO($!in_fh));
  29. }
  30. elsif nqp::istype($in, Str) && $in eq '-' {
  31. $!in_fh := nqp::null();
  32. $!flags += nqp::const::PIPE_INHERIT_IN;
  33. }
  34. else {
  35. $!in_fh := nqp::null();
  36. $!flags += nqp::const::PIPE_IGNORE_IN;
  37. }
  38. if $out === True || $merge {
  39. $!out_fh := nqp::syncpipe();
  40. $!flags += nqp::const::PIPE_CAPTURE_OUT;
  41. $!out = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$enc, :$bin,
  42. nl-in => $nl, :PIO($!out_fh));
  43. }
  44. elsif nqp::istype($out, IO::Handle) && $out.DEFINITE {
  45. $!out_fh := nqp::getattr(nqp::decont($out), IO::Handle, '$!PIO');
  46. $!flags += nqp::const::PIPE_INHERIT_OUT;
  47. }
  48. elsif nqp::istype($out, Str) && $out eq '-' {
  49. $!out_fh := nqp::null();
  50. $!flags += nqp::const::PIPE_INHERIT_OUT;
  51. }
  52. else {
  53. $!out_fh := nqp::null();
  54. $!flags += nqp::const::PIPE_IGNORE_OUT;
  55. }
  56. if $merge {
  57. $!err := $!out;
  58. $!err_fh := $!out_fh;
  59. $!flags += nqp::const::PIPE_INHERIT_ERR;
  60. }
  61. elsif nqp::istype($err, IO::Handle) && $err.DEFINITE {
  62. $!err_fh := nqp::getattr(nqp::decont($err), IO::Handle, '$!PIO');
  63. $!flags += nqp::const::PIPE_INHERIT_ERR;
  64. }
  65. elsif nqp::istype($err, Str) && $err eq '-' {
  66. $!err_fh := nqp::null();
  67. $!flags += nqp::const::PIPE_INHERIT_ERR;
  68. }
  69. elsif $err === True {
  70. $!err_fh := nqp::syncpipe();
  71. $!flags += nqp::const::PIPE_CAPTURE_ERR;
  72. $!err = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$enc, :$bin,
  73. nl-in => $nl, :PIO($!err_fh));
  74. }
  75. else {
  76. $!err_fh := nqp::null();
  77. $!flags += nqp::const::PIPE_IGNORE_ERR;
  78. }
  79. if nqp::istype($exitcode, Int) && $exitcode.DEFINITE {
  80. $!exitcode = $exitcode;
  81. }
  82. if nqp::istype($signal, Int) && $signal.DEFINITE {
  83. $!signal = $signal;
  84. }
  85. }
  86. method spawn(*@args ($, *@), :$cwd = $*CWD, :$env) {
  87. @!command = @args;
  88. my %env := $env ?? $env.hash !! %*ENV;
  89. self.status(nqp::p6box_i(nqp::spawn(
  90. CLONE-LIST-DECONTAINERIZED(@args),
  91. nqp::unbox_s($cwd.Str),
  92. CLONE-HASH-DECONTAINERIZED(%env),
  93. $!in_fh, $!out_fh, $!err_fh,
  94. $!flags
  95. )));
  96. self.Bool
  97. }
  98. method shell($cmd, :$cwd = $*CWD, :$env) {
  99. @!command = $cmd;
  100. my %env := $env ?? $env.hash !! %*ENV;
  101. self.status(nqp::p6box_i(nqp::shell(
  102. nqp::unbox_s($cmd),
  103. nqp::unbox_s($cwd.Str),
  104. CLONE-HASH-DECONTAINERIZED(%env),
  105. $!in_fh, $!out_fh, $!err_fh,
  106. $!flags
  107. )));
  108. self.Bool
  109. }
  110. proto method status(|) { * }
  111. multi method status($new_status) {
  112. $!exitcode = $new_status +> 8;
  113. $!signal = $new_status +& 0xFF;
  114. }
  115. multi method status(Proc:D:) { ($!exitcode +< 8) +| $!signal }
  116. multi method Numeric(Proc:D:) { $!exitcode }
  117. multi method Bool(Proc:D:) { $!exitcode == 0 }
  118. method sink(--> Nil) {
  119. X::Proc::Unsuccessful.new(:proc(self)).throw unless self;
  120. }
  121. }
  122. sub run(*@args ($, *@), :$in = '-', :$out = '-', :$err = '-',
  123. Bool :$bin, Bool :$chomp = True, Bool :$merge,
  124. Str :$enc, Str:D :$nl = "\n", :$cwd = $*CWD, :$env) {
  125. my $proc = Proc.new(:$in, :$out, :$err, :$bin, :$chomp, :$merge, :$enc, :$nl);
  126. $proc.spawn(@args, :$cwd, :$env);
  127. $proc
  128. }
  129. sub shell($cmd, :$in = '-', :$out = '-', :$err = '-',
  130. Bool :$bin, Bool :$chomp = True, Bool :$merge,
  131. Str :$enc, Str:D :$nl = "\n", :$cwd = $*CWD, :$env) {
  132. my $proc = Proc.new(:$in, :$out, :$err, :$bin, :$chomp, :$merge, :$enc, :$nl);
  133. $proc.shell($cmd, :$cwd, :$env);
  134. $proc
  135. }
  136. sub QX($cmd, :$cwd = $*CWD, :$env) {
  137. my %env := $env ?? $env.hash !! %*ENV;
  138. my Mu $pio := nqp::syncpipe();
  139. my $status := nqp::shell(
  140. nqp::unbox_s($cmd),
  141. nqp::unbox_s($cwd.Str),
  142. CLONE-HASH-DECONTAINERIZED(%env),
  143. nqp::null(), $pio, nqp::null(),
  144. nqp::const::PIPE_INHERIT_IN + nqp::const::PIPE_CAPTURE_OUT + nqp::const::PIPE_INHERIT_ERR
  145. );
  146. my $result;
  147. try {
  148. $result = nqp::p6box_s(nqp::readallfh($pio));
  149. $status := nqp::closefh_i($pio);
  150. }
  151. $result.DEFINITE
  152. ?? $result
  153. !! Failure.new("Unable to read from '$cmd'")
  154. }