add Proc, Proc.run() and Proc.shell

This deprecates pipe(), and Proc::Status.
rakudo · Jun 14, 2015 · 9267294 · 9267294
1 parent 2161b14
commit 9267294
Show file tree

Hide file tree

Showing 8 changed files with 184 additions and 72 deletions.
diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm
@@ -1,6 +1,27 @@
 my class IO::Path { ... }
 my class IO::Special { ... }
 
+# Will be removed together with pipe() and open(:p).
+my class Proc::Status {
+    has $.exitcode = -1;  # distinguish uninitialized from 0 status
+    has $.pid;
+    has $.signal;
+
+    method exit {
+        DEPRECATED('Proc::Status.exitcode', |<2015.03 2015.09>);
+        $!exitcode;
+    }
+
+    proto method status(|) { * }
+    multi method status($new_status) {
+        $!exitcode = $new_status +> 8;
+        $!signal   = $new_status +& 0xFF;
+    }
+    multi method status(Proc::Status:D:)  { ($!exitcode +< 8) +| $!signal }
+    multi method Numeric(Proc::Status:D:) { $!exitcode }
+    multi method Bool(Proc::Status:D:)    { $!exitcode == 0 }
+}
+
 my class IO::Handle does IO {
     has $.path;
     has $!PIO;
@@ -10,6 +31,7 @@ my class IO::Handle does IO {
     has int $!pipe;
 
     method pipe(IO::Handle:D: |c) {
+        DEPRECATED('shell() or run() with :in, :out or :err', |<2015.07 2015.09>);
         self.open(:p, |c);
     }
 
@@ -54,7 +76,7 @@ my class IO::Handle does IO {
         $r = $w = True if $rw;
 
         if $p {
-            DEPRECATED('pipe($path,...)',|<2015.06 2015.09>,:what(':p for pipe'));
+            DEPRECATED('shell(...)/run(...) with :in, :out or :err', |<2015.07 2015.09>, :what(':p for pipe'));
             $!pipe = 1;
 
             $!PIO := nqp::syncpipe();

diff --git a/src/core/IO/Pipe.pm b/src/core/IO/Pipe.pm
@@ -1,3 +1,11 @@
-# placeholder file to facilitate switching between nom and newio branches
+my class IO::Pipe is IO::Handle {
+    has $.proc;
+    method close(IO::Pipe:D:) {
+        my $PIO := nqp::getattr(nqp::decont(self), IO::Handle, '$!PIO');
+        $!proc.status( nqp::closefh_i($PIO) ) if nqp::defined($PIO);
+        nqp::bindattr(nqp::decont(self), IO::Handle, '$!PIO', Mu);
+        $!proc;
+    }
+}
 
 # vim: ft=perl6 expandtab sw=4
diff --git a/src/core/OS.pm b/src/core/OS.pm
@@ -2,28 +2,4 @@ sub gethostname( --> Str){
     nqp::p6box_s(nqp::gethostname());
 }
 
-my class Proc::Status {
-    has $.exitcode = -1;  # distinguish uninitialized from 0 status
-    has $.pid;
-    has $.signal;
-
-    #~ method exitcode() { $!exitcode   }
-    #~ method pid()      { $!pid    }
-    #~ method signal()   { $!signal }
-
-    method exit {
-        DEPRECATED('Proc::Status.exitcode', |<2015.03 2015.09>);
-        $!exitcode;
-    }
-
-    proto method status(|) { * }
-    multi method status($new_status) {
-        $!exitcode = $new_status +> 8;
-        $!signal   = $new_status +& 0xFF;
-    }
-    multi method status(Proc::Status:D:)  { ($!exitcode +< 8) +| $!signal }
-    multi method Numeric(Proc::Status:D:) { $!exitcode }
-    multi method Bool(Proc::Status:D:)    { $!exitcode == 0 }
-}
-
 # vim: ft=perl6 expandtab sw=4
diff --git a/src/core/Proc.pm b/src/core/Proc.pm
@@ -0,0 +1,149 @@
+my class Proc {
+    has IO::Pipe $.in;
+    has IO::Pipe $.out;
+    has IO::Pipe $.err;
+    has $.exitcode = -1;  # distinguish uninitialized from 0 status
+    has $.pid;
+    has $.signal;
+
+    has $!in_fh;
+    has $!out_fh;
+    has $!err_fh;
+    has int $!flags;
+
+    submethod BUILD(:$in = '-', :$out = '-', :$err = '-',
+                    Bool :$bin, Bool :$chomp = True, Bool :$merge,
+                    Str:D :$enc = 'utf8', Str:D :$nl = "\n") {
+        if nqp::istype($in, IO::Handle) && $in.DEFINITE {
+            $!in_fh := nqp::getattr(nqp::decont($in), IO::Handle, '$!PIO');
+            $!flags += nqp::const::PIPE_INHERIT_IN;
+        }
+        elsif $in === True {
+            $!in     = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$nl);
+            $!in_fh := nqp::syncpipe();
+            $!flags += nqp::const::PIPE_CAPTURE_IN;
+            nqp::setinputlinesep($!in_fh, nqp::unbox_s($nl));
+            nqp::setencoding($!in_fh, NORMALIZE_ENCODING($enc)) unless $bin;
+            nqp::bindattr(nqp::decont($!in), IO::Handle, '$!PIO', $!in_fh);
+        }
+        elsif nqp::istype($in, Str) && $in eq '-' {
+            $!in_fh := nqp::null();
+            $!flags += nqp::const::PIPE_INHERIT_IN;
+        }
+        else {
+            $!in_fh := nqp::null();
+            $!flags += nqp::const::PIPE_IGNORE_IN;
+        }
+
+        if $out === True || $merge {
+            $!out     = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$nl);
+            $!out_fh := nqp::syncpipe();
+            $!flags  += nqp::const::PIPE_CAPTURE_OUT;
+            nqp::setinputlinesep($!out_fh, nqp::unbox_s($nl));
+            nqp::setencoding($!out_fh, NORMALIZE_ENCODING($enc)) unless $bin;
+            nqp::bindattr(nqp::decont($!out), IO::Handle, '$!PIO', $!out_fh);
+        }
+        elsif nqp::istype($out, IO::Handle) && $out.DEFINITE {
+            $!out_fh := nqp::getattr(nqp::decont($out), IO::Handle, '$!PIO');
+            $!flags  += nqp::const::PIPE_INHERIT_OUT;
+        }
+        elsif nqp::istype($out, Str) && $out eq '-' {
+            $!out_fh := nqp::null();
+            $!flags  += nqp::const::PIPE_INHERIT_OUT;
+        }
+        else {
+            $!out_fh := nqp::null();
+            $!flags  += nqp::const::PIPE_IGNORE_OUT;
+        }
+
+        if $merge {
+            $!err    := $!out;
+            $!err_fh := $!out_fh;
+            $!flags  += nqp::const::PIPE_INHERIT_ERR;
+        }
+        elsif nqp::istype($err, IO::Handle) && $err.DEFINITE {
+            $!err_fh := nqp::getattr(nqp::decont($err), IO::Handle, '$!PIO');
+            $!flags  += nqp::const::PIPE_INHERIT_ERR;
+        }
+        elsif nqp::istype($err, Str) && $err eq '-' {
+            $!err_fh := nqp::null();
+            $!flags  += nqp::const::PIPE_INHERIT_ERR;
+        }
+        elsif $err === True {
+            $!err     = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$nl);
+            $!err_fh := nqp::syncpipe();
+            $!flags  += nqp::const::PIPE_CAPTURE_ERR;
+            nqp::setinputlinesep($!err_fh, nqp::unbox_s($nl));
+            nqp::setencoding($!err_fh, NORMALIZE_ENCODING($enc)) unless $bin;
+            nqp::bindattr(nqp::decont($!err), IO::Handle, '$!PIO', $!err_fh);
+        }
+        else {
+            $!err_fh := nqp::null();
+            $!flags  += nqp::const::PIPE_IGNORE_ERR;
+        }
+    }
+
+    method spawn(*@args ($, *@)) {
+        self.status(nqp::p6box_i(nqp::spawn(
+            CLONE-LIST-DECONTAINERIZED(@args),
+            nqp::unbox_s($*CWD.Str),
+            CLONE-HASH-DECONTAINERIZED(%*ENV),
+            $!in_fh, $!out_fh, $!err_fh,
+            $!flags
+        )));
+        self.Bool
+    }
+
+    method shell($cmd) {
+        self.status(nqp::p6box_i(nqp::shell(
+            nqp::unbox_s($cmd),
+            nqp::unbox_s($*CWD.Str),
+            CLONE-HASH-DECONTAINERIZED(%*ENV),
+            $!in_fh, $!out_fh, $!err_fh,
+            $!flags
+        )));
+        self.Bool
+    }
+
+    proto method status(|) { * }
+    multi method status($new_status) {
+        $!exitcode = $new_status +> 8;
+        $!signal   = $new_status +& 0xFF;
+    }
+    multi method status(Proc:D:)  { ($!exitcode +< 8) +| $!signal }
+    multi method Numeric(Proc:D:) { $!exitcode }
+    multi method Bool(Proc:D:)    { $!exitcode == 0 }
+}
+
+sub run(*@args ($, *@), :$in = '-', :$out = '-', :$err = '-',
+        Bool :$bin, Bool :$chomp = True, Bool :$merge,
+        Str:D :$enc = 'utf8', Str:D :$nl = "\n") {
+    my $proc = Proc.new(:$in, :$out, :$err, :$bin, :$chomp, :$merge, :$enc, :$nl);
+    try $proc.spawn(@args);
+    $proc
+}
+
+sub shell($cmd, :$in = '-', :$out = '-', :$err = '-',
+        Bool :$bin, Bool :$chomp = True, Bool :$merge,
+        Str:D :$enc = 'utf8', Str:D :$nl = "\n") {
+    my $proc = Proc.new(:$in, :$out, :$err, :$bin, :$chomp, :$merge, :$enc, :$nl);
+    try $proc.shell($cmd);
+    $proc
+}
+
+sub QX($cmd) {
+    my Mu $pio := nqp::syncpipe();
+    my $status := nqp::shell(
+        nqp::unbox_s($cmd),
+        nqp::unbox_s($*CWD.Str),
+        CLONE-HASH-DECONTAINERIZED(%*ENV),
+        nqp::null(), $pio, nqp::null(),
+        nqp::const::PIPE_INHERIT_IN + nqp::const::PIPE_CAPTURE_OUT + nqp::const::PIPE_INHERIT_ERR
+    );
+    fail "Unable to execute '$cmd'" if $status;
+    my $result = nqp::p6box_s(nqp::readallfh($pio));
+    nqp::closefh($pio);
+    $result;
+}
+
+# vim: ft=perl6 expandtab sw=4
diff --git a/src/core/Proc/Async.pm b/src/core/Proc/Async.pm
@@ -173,7 +173,7 @@ my class Proc::Async {
 
         my Mu $callbacks := nqp::hash();
         nqp::bindkey($callbacks, 'done', -> Mu \status {
-            $!exit_promise.keep(Proc::Status.new(:exitcode(status)))
+            $!exit_promise.keep(Proc.new(:exitcode(status)))
         });
         nqp::bindkey($callbacks, 'error', -> Mu \err {
             $!exit_promise.break(X::OS.new(os-error => err));

diff --git a/src/core/control.pm b/src/core/control.pm
@@ -212,54 +212,9 @@ sub THE_END {
     while @END.shift -> $end { $end() };
 }
 
-my class Proc::Status { ... }
-
-sub run(*@args ($, *@)) {
-    my $status = Proc::Status.new( :exitcode(255) );
-    try {
-        $status.status(nqp::p6box_i(nqp::spawn(
-          CLONE-LIST-DECONTAINERIZED(@args),
-          $*CWD.Str,
-          CLONE-HASH-DECONTAINERIZED(%*ENV),
-          nqp::null, nqp::null, nqp::null,
-          nqp::const::PIPE_INHERIT_IN + nqp::const::PIPE_INHERIT_OUT + nqp::const::PIPE_INHERIT_ERR
-        )));
-    }
-    $status
-}
-
-sub shell($cmd) {
-    my $status = Proc::Status.new( :exitcode(255) );
-    try {
-        $status.status(nqp::p6box_i(nqp::shell(
-          $cmd,
-          $*CWD.Str,
-          CLONE-HASH-DECONTAINERIZED(%*ENV),
-          nqp::null, nqp::null, nqp::null,
-          nqp::const::PIPE_INHERIT_IN + nqp::const::PIPE_INHERIT_OUT + nqp::const::PIPE_INHERIT_ERR
-        )));
-    }
-    $status
-}
-
 constant Inf = nqp::p6box_n(nqp::inf());
 constant NaN = nqp::p6box_n(nqp::nan());
 
-sub QX($cmd) {
-    my Mu $pio := nqp::syncpipe();
-    my $pid    := nqp::openpipe(
-        nqp::unbox_s($cmd),
-        nqp::unbox_s($*CWD.Str),
-        CLONE-HASH-DECONTAINERIZED(%*ENV),
-        nqp::null(), $pio, nqp::null(),
-        nqp::const::PIPE_INHERIT_IN + nqp::const::PIPE_CAPTURE_OUT + nqp::const::PIPE_INHERIT_ERR
-    );
-    fail "Unable to execute '$cmd'" unless $pio;
-    my $result = nqp::p6box_s(nqp::readallfh($pio));
-    nqp::closefh($pio);
-    $result;
-}
-
 sub EXHAUST(|) {
     X::ControlFlow::Return.new.throw();
 }

diff --git a/tools/build/Makefile-JVM.in b/tools/build/Makefile-JVM.in
@@ -187,6 +187,7 @@ J_CORE_SOURCES = \
   src/core/IO/Socket.pm \
   src/core/IO/Socket/Async.pm \
   src/core/IO/Socket/INET.pm \
+  src/core/Proc.pm \
   src/core/Systemic.pm \
   src/core/VM.pm \
   src/core/Distro.pm \

diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources
@@ -134,6 +134,7 @@ src/core/asyncops.pm
 src/core/IO/Socket.pm
 src/core/IO/Socket/INET.pm
 src/core/IO/Socket/Async.pm
+src/core/Proc.pm
 src/core/Proc/Async.pm
 src/core/signals.pm
 src/core/Systemic.pm