This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
I think we have a winner. do_pipe hasn't been called since 4.036.
[perl5.git] / mathoms.c
index 8a42e63..3c92a42 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -652,6 +652,52 @@ Perl_do_exec(pTHX_ const char *cmd)
 }
 #endif
 
+#ifdef HAS_PIPE
+void
+Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv)
+{
+    register IO *rstio;
+    register IO *wstio;
+    int fd[2];
+
+    if (!rgv)
+       goto badexit;
+    if (!wgv)
+       goto badexit;
+
+    rstio = GvIOn(rgv);
+    wstio = GvIOn(wgv);
+
+    if (IoIFP(rstio))
+       do_close(rgv,FALSE);
+    if (IoIFP(wstio))
+       do_close(wgv,FALSE);
+
+    if (PerlProc_pipe(fd) < 0)
+       goto badexit;
+    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE);
+    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE);
+    IoOFP(rstio) = IoIFP(rstio);
+    IoIFP(wstio) = IoOFP(wstio);
+    IoTYPE(rstio) = IoTYPE_RDONLY;
+    IoTYPE(wstio) = IoTYPE_WRONLY;
+    if (!IoIFP(rstio) || !IoOFP(wstio)) {
+       if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
+       else PerlLIO_close(fd[0]);
+       if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
+       else PerlLIO_close(fd[1]);
+       goto badexit;
+    }
+
+    sv_setsv(sv,&PL_sv_yes);
+    return;
+
+badexit:
+    sv_setsv(sv,&PL_sv_undef);
+    return;
+}
+#endif
+
 /*
  * Local variables:
  * c-indentation-style: bsd