Implement open "|..."

Uses a Tcl wrapper, popen, from tclcompat

Signed-off-by: Steve Bennett <steveb@workware.net.au>

4 files changed, 72 insertions, 19 deletions

diff --git a/examples/popen.tcl b/examples/popen.tcl
new file mode 100644
index 0000000..8a6b6e3
--- /dev/null
+++ b/examples/popen.tcl
@@ -0,0 +1,19 @@
+# Internally, open "|..." calls out to popen from tclcompat.tcl
+#
+# This code is compatible with Tcl
+
+# Write to a pipe
+set f [open |[list cat | sed -e "s/line/This is line/" >temp.out] w]
+foreach n {1 2 3 4 5} {
+	puts $f "line $n"
+}
+close $f
+puts "Created temp.out"
+
+# Read from a pipe
+set f [open "|cat temp.out"]
+while {[gets $f buf] >= 0} {
+	puts $buf
+}
+close $f
+file delete temp.out
diff --git a/jim-aio.c b/jim-aio.c
index 4cb06ea..f4bd0e3 100644
--- a/jim-aio.c
+++ b/jim-aio.c
@@ -514,15 +514,11 @@ static int aio_cmd_accept(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
     socklen_t addrlen = sizeof(sa);
     AioFile *af;
     char buf[AIO_CMD_LEN];
-    long fileId;
 
     sock = accept(serv_af->fd, &sa.sa, &addrlen);
     if (sock < 0)
         return JIM_ERR;
 
-    /* Get the next file id */
-    fileId = Jim_GetId(interp);
-
     /* Create the file command */
     af = Jim_Alloc(sizeof(*af));
     af->fd = sock;
@@ -537,7 +533,7 @@ static int aio_cmd_accept(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
     af->wEvent = NULL;
     af->eEvent = NULL;
     af->addr_family = serv_af->addr_family;
-    sprintf(buf, "aio.sockstream%ld", fileId);
+    sprintf(buf, "aio.sockstream%ld", Jim_GetId(interp));
     Jim_CreateCommand(interp, buf, JimAioSubCmdProc, af, JimAioDelProc);
     Jim_SetResultString(interp, buf, -1);
     return JIM_OK;
@@ -817,7 +813,6 @@ static int JimAioOpenCommand(Jim_Interp *interp, int argc,
     FILE *fp;
     AioFile *af;
     char buf[AIO_CMD_LEN];
-    long fileId;
     int OpenFlags = 0;
     const char *cmdname;
 
@@ -839,19 +834,28 @@ static int JimAioOpenCommand(Jim_Interp *interp, int argc,
         fp = stderr;
     }
     else {
-        const char *mode = "r";
+        const char *mode = (argc == 3) ? Jim_GetString(argv[2], NULL) : "r";
+        const char *filename = Jim_GetString(argv[1], NULL);
+
+#ifdef jim_ext_tclcompat
+        /* If the filename starts with '|', use popen instead */
+        if (*filename == '|') {
+            Jim_Obj *evalObj[3];
+
+            evalObj[0] = Jim_NewStringObj(interp, "popen", -1);
+            evalObj[1] = Jim_NewStringObj(interp, filename + 1, -1);
+            evalObj[2] = Jim_NewStringObj(interp, mode, -1);
 
-        if (argc == 3) {
-            mode = Jim_GetString(argv[2], NULL);
+            return Jim_EvalObjVector(interp, 3, evalObj);
         }
-        fp = fopen(Jim_GetString(argv[1], NULL), mode);
+#endif
+        fp = fopen(filename, mode);
         if (fp == NULL) {
             JimAioSetError(interp, argv[1]);
             return JIM_ERR;
         }
         /* Get the next file id */
-        fileId = Jim_GetId(interp);
-        sprintf(buf, "aio.handle%ld", fileId);
+        sprintf(buf, "aio.handle%ld", Jim_GetId(interp));
         cmdname = buf;
     }
 
@@ -887,7 +891,6 @@ static int JimAioOpenCommand(Jim_Interp *interp, int argc,
 static int JimMakeChannel(Jim_Interp *interp, Jim_Obj *filename, const char *hdlfmt, int fd, int family,
     const char *mode)
 {
-    long fileId;
     AioFile *af;
     char buf[AIO_CMD_LEN];
 
@@ -899,9 +902,6 @@ static int JimMakeChannel(Jim_Interp *interp, Jim_Obj *filename, const char *hdl
         return JIM_ERR;
     }
 
-    /* Get the next file id */
-    fileId = Jim_GetId(interp);
-
     /* Create the file command */
     af = Jim_Alloc(sizeof(*af));
     af->fp = fp;
@@ -916,7 +916,7 @@ static int JimMakeChannel(Jim_Interp *interp, Jim_Obj *filename, const char *hdl
     af->wEvent = NULL;
     af->eEvent = NULL;
     af->addr_family = family;
-    sprintf(buf, hdlfmt, fileId);
+    snprintf(buf, sizeof(buf), hdlfmt, Jim_GetId(interp));
     Jim_CreateCommand(interp, buf, JimAioSubCmdProc, af, JimAioDelProc);
 
     Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, buf, -1));
diff --git a/jim_tcl.txt b/jim_tcl.txt
index 6b173ea..4679425 100644
--- a/jim_tcl.txt
+++ b/jim_tcl.txt
@@ -49,11 +49,10 @@ The major differences are:
 12. 'string map' (Tcl 7.x)
 13. 'subst' (Tcl 7.x)
 14. 'switch' (Tcl 7.x) (note that 'case' is provided for compatibility)
-15. Must better error reporting. 'info stacktrace' as a replacement for 'errorInfo', 'errorCode'
+15. Much better error reporting. 'info stacktrace' as a replacement for 'errorInfo', 'errorCode'
 16. Support for "static" variables in procedures
 17. Significantly faster for many scripts/operations
 18. Support for tail-call optimisation, 'tailcall'
-19. Command pipelines via open "|..." are not supported (but see 'exec' and 'socket pipe')
 20. Variable traces are not supported
 21. The history command is not supported
 
@@ -78,6 +77,7 @@ Since v0.62:
 15. Add 'string is'
 16. Event handlers works better if an error occurs. eof handler has been removed.
 17. 'exec' now sets $::errorCode, and catch sets opts(-errorcode) for exit status
+18. Command pipelines via open "|..." are now supported
 
 Since v0.61:
 
@@ -2844,6 +2844,18 @@ It may have any of the following values:
 If a file is opened for both reading and writing, then 'seek'
 must be invoked between a read and a write, or vice versa.
 
+If the first character of *fileName* is "|" then the remaining
+characters of *fileName* are treated as a list of arguments that
+describe a command pipeline to invoke, in the same style as the
+arguments for exec. In this case, the channel identifier returned
+by open may be used to write to the command's input pipe or read
+from its output pipe, depending on the value of *access*. If write-only
+access is used (e.g. *access* is 'w'), then standard output for the
+pipeline is directed to the current standard output unless overridden
+by the command. If read-only access is used (e.g. *access* is r),
+standard input for the pipeline is taken from the current standard
+input unless overridden by the command.
+
 See also 'socket'
 
 package
diff --git a/tclcompat.tcl b/tclcompat.tcl
index 4a0929b..5cf8e4c 100644
--- a/tclcompat.tcl
+++ b/tclcompat.tcl
@@ -127,6 +127,28 @@ proc {file copy} {{force {}} source target} {
 	}
 }
 
+# 'open "|..." ?mode?" will invoke this wrapper around exec/pipe
+proc popen {cmd {mode r}} {
+	lassign [socket pipe] r w
+	try {
+		if {[string match "w*" $mode]} {
+			lappend cmd <@$r &
+			exec {*}$cmd
+			$r close
+			return $w
+		} else {
+			lappend cmd >@$w &
+			exec {*}$cmd
+			$w close
+			return $r
+		}
+	} on error {error opts} {
+		$r close
+		$w close
+		error $error
+	}
+}
+
 # try/on/finally conceptually similar to Tcl 8.6
 #
 # Usage: try ?catchopts? script ?onclause ...? ?finallyclause?