diff options
-rw-r--r-- | examples/popen.tcl | 19 | ||||
-rw-r--r-- | jim-aio.c | 34 | ||||
-rw-r--r-- | jim_tcl.txt | 16 | ||||
-rw-r--r-- | tclcompat.tcl | 22 |
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 @@ -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? |