Here is a code which just implements an interactive TCL session with command prompt MyShell >.
puts -nonewline stdout "MyShell > "
flush stdout
catch { eval [gets stdin] } got
if { $got ne "" } {
puts stderr $got
}
This code prompts MyShell > at the terminal and waits for the enter button to be hit; while it is not hit the code does nothing. This is what the gets command does.
What I need, is some alternative to the gets command, say coolget. The coolget command should not wait for the enter button, but register some slot to be called when it is hit, and just continue the execution. The desired code should look like this:
proc evaluate { string } \
{
catch { eval $string } got
if { $got ne "" } {
puts stderr $got
}
}
puts -nonewline stdout "MyShell > "
flush stdout
coolgets stdin evaluate; # this command should not wait for the enter button
# here goes some code which is to be executed before the enter button is hit
Here is what I needed:
proc prompt { } \
{
puts -nonewline stdout "MyShell > "
flush stdout
}
proc process { } \
{
catch { uplevel #0 [gets stdin] } got
if { $got ne "" } {
puts stderr $got
flush stderr
}
prompt
}
fileevent stdin readable process
prompt
while { true } { update; after 100 }
I think you need to look at the fileevent, fconfigure and vwait commands. Using these you can do something like the following:
proc GetData {chan} {
if {[gets $chan line] >= 0} {
puts -nonewline "Read data: "
puts $line
}
}
fconfigure stdin -blocking 0 -buffering line -translation crlf
fileevent stdin readable [list GetData stdin]
vwait x
This code registers GetData as the readable file event handler for stdin, so whenever there is data available to be read it gets called.
Tcl applies “nohang”-like functionality to the whole channel, and it's done by configuring the channel to be non-blocking. After that, any read will return only the data that is there, gets will only return complete lines that are available without waiting, and puts (on a writable channel) will arrange for its output to be sent to the OS asynchronously. This depends on the event loop being operational.
You are recommended to use non-blocking channels with a registered file event handler. You can combine that with non-blocking to implement your coolget idea:
proc coolget {channel callback} {
fileevent $channel readable [list apply {{ch cb} {
if {[gets $ch line] >= 0} {
uplevel [lappend cb $line]
} elseif {[eof $ch]} {
# Remove handler at EOF: important!
fileevent $ch readable {}
}
}} $channel $callback]
}
That will then work just fine, except that you've got to call either vwait or update to process events (unless you've got Tk in use too; Tk is special) as Tcl won't process things magically in the background; magical background processing causes more trouble than it's worth…
If you're getting deeply tangled in asynchronous event handling, consider using Tcl 8.6's coroutines to restructure the code. In particular, code like Coronet can help a lot. However, that is very strongly dependent on Tcl 8.6, as earlier Tcl implementations can't support coroutines at all; the low-level implementation had to be rewritten from simple C calls to continuations to enable those features, and that's not backport-able with reasonable effort.
Related
I am running tclsh some.tcl and it exits after it hits eof. I want it not to exit and gives control to user for interaction. Note that we can do this by invoking shell and sourcing script but that doesn't solve my problem as it cannot be used in automation.
If you can load the TclX package (old but still useful) then you can do:
package require Tclx; # Lower case at the end for historical reasons
# Your stuff here
commandloop
That's very much like how Tcl's own interactive command line works.
Otherwise, here's a scripted version that does most of what an interactive command session does:
if {![info exists tcl_prompt1]} {
set tcl_prompt1 {puts -nonewline "% ";flush stdout}
}
if {![info exists tcl_prompt2]} {
# Note that tclsh actually defaults to not printing anything for this prompt
set tcl_prompt2 {puts -nonewline "> ";flush stdout}
}
set script ""
set prompt $tcl_prompt1
while {![eof stdin]} {
eval $prompt; # Print the prompt by running its script
if {[gets stdin line] >= 0} {
append script $line "\n"; # The newline is important
if {[info complete $script]} { # Magic! Parse for syntactic completeness
if {[catch $script msg]} { # Evaluates the script and catches the result
puts stderr $msg
} elseif {$msg ne ""} { # Don't print empty results
puts stdout $msg
}
# Accumulate the next command
set script ""
set prompt $tcl_prompt1
} else {
# We have a continuation line
set prompt $tcl_prompt2
}
}
}
Getting the remaining bits right (e.g., the interaction with the event loop when the Tk package is loaded) would require quite a bit more complexity...
Hi I am using this piece of code for inserting pipe in TCL. Can anybody please let me understand when this condition [gets $pipe line] >= 0 fails.
For eg: only when [gets $pipe line] is a negative number this will fail.
In my case it is never returning a negative number and the TestEngine hangs forever
set pipeline [open "|Certify.exe filename" "r+"]
fileevent $pipeline readable [list handlePipeReadable $pipeline]
fconfigure $pipeline -blocking 0
proc handlePipeReadable {pipe} {
if {[gets $pipe line] >= 0} {
# Managed to actually read a line; stored in $line now
} elseif {[eof $pipe]} {
# Pipeline was closed; get exit code, etc.
if {[catch {close $pipe} msg opt]} {
set exitinfo [dict get $opt -errorcode]
} else {
# Successful termination
set exitinfo ""
}
# Stop the waiting in [vwait], below
set ::donepipe $pipe
} else {
puts ""
# Partial read; things will be properly buffered up for now...
}
}
vwait ::donepipe
The gets command (when given a variable to receive the line) returns a negative number when it is in a minor error condition. There are two such conditions:
When the channel has reached end-of-file. After the gets the eof command (applied to the channel) will report a true value in this case.
When the channel is blocked, i.e., when it has some bytes but not a complete line (Tcl has internal buffering to handle this; you can get the number of pending bytes with chan pending). You only see this when the channel is in non-blocking mode (because otherwise the gets will wait indefinitely). In this case, the fblocked command (applied to the channel) will return true.
Major error conditions (such as the channel being closed) result in Tcl errors.
If the other command only produces partial output or does something weird with buffering, you can get an eternally blocked pipeline. It's more likely with a bidirectional pipe, such as you're using, as the Certify command is probably waiting for you to close the other end. Can you use it read-only? There are many complexities to interacting correctly with a process bidirectionally! (For example, you probably want to make the pipe's output buffering mode be unbuffered, fconfigure $pipeline -buffering none.)
Please find the way the certify process is being triggered from the command prompt and the print statements are given just for the understanding. At the end the process hangs and the control is not transferred back to the TCL
From the documentation for gets:
If varName is specified and an empty string is returned in varName because of end-of-file or because of insufficient data in nonblocking mode, then the return count is -1.
Your script is working completely fine. checked with set pipeline [open "|du /usr" "r+"]
instead of your pipe and included puts "Line: $line" to check the result. So its clear that there is some problem in Certify command. Can you share your command, how do you use on terminal and how did you use with exec?
################### edited by Drektz
set pipeline [open "|du /usr" "r+"]
fileevent $pipeline readable [list handlePipeReadable $pipeline]
fconfigure $pipeline -blocking 0
proc handlePipeReadable {pipe} {
if {[gets $pipe line] >= 0} {
# Managed to actually read a line; stored in $line now
################### included by Drektz
puts "Line: $line"
} elseif {[eof $pipe]} {
# Pipeline was closed; get exit code, etc.
if {[catch {close $pipe} msg opt]} {
set exitinfo [dict get $opt -errorcode]
} else {
# Successful termination
set exitinfo ""
}
# Stop the waiting in [vwait], below
set ::donepipe $pipe
} else {
puts ""
# Partial read; things will be properly buffered up for now...
}
}
vwait ::donepipe
you can see it in the CMDwith& screenshot mentioned.Is there any workaround that I have to overcome the issue
Please see the issue when run with the help of exec executable args &
EDIT: Original example and alternative solution framework modified for clarity.
The line buffering behaviour might behave differently than expected in Tcl 8.6. The following code blocks without any output, unless the "chan close" line is uncommented:
set data {one two four}
set stream [open |[list cat -n] r+]
chan configure $stream -buffering line
chan puts $stream "$data\n"
chan puts $stream "\n"
chan flush $stream
#chan close $stream write
set out [chan read $stream]
puts "output: $out"
chan close $stream
So this simplistic solution does not work for interactive I/O, and this might be related to synchronization problems at both ends of the pipe.
Using a channel event structure (e.g., based on http://www.beedub.com/book/2nd/event.doc.html), seems to be preferable:
proc chanReader { pipe } {
global extState
while 1 {
set len [chan gets $pipe line]
if { $len > 0 } {
puts "<< $line."
continue
} else {
if { [chan blocked $pipe] } {
set extState 1
return
} elseif { [chan eof $pipe] } {
set extState 2
return
}
}
}
}
set data {one two foure}
set timeout 5000
#set stream [open [list | cat -n] r+]
#set stream [open [list | ispell -a] r+]
set stream [open [list | tr a-z A-Z] r+]
#set stream [open [list | fmt -] r+]
chan configure $stream -blocking 0 -buffering line
set extState 0
chan event $stream readable [list chanReader $stream]
foreach word $data {
puts "> $word\n"
chan puts $stream "$word\n"
chan flush $stream
#chan close $stream write
set aID [after $timeout {set extState 3}]
vwait extState
if { $extState == 1 } {
# Got regular output.
after cancel $aID
puts "Cancel $aID."
continue
} elseif { $extState == 2 } {
puts "External program closed."
chan close $stream
exit 2
} elseif { $extState == 3 } {
puts "Timeout."
chan close $stream
exit 3
}
}
puts "End of task."
chan close $stream
exit 0
This code fragment works with the "cat -n" and "ispell -a" external programs (commented lines), but still fails with other external programs. For instance it does not work with the "tr a-z A-Z" and "fmt" examples above.
If the line "chan close $stream write" above is uncommented, we receive output from the external program, but this terminates the interaction with it. How to reliably connect (interactively) to these external programs?
I'm guessing that the core issue here is that there's two sources of buffering going on, and Tcl only has control over one of them. But both stem from the fact that virtually all output, when not going to an “interactive” destination (i.e., a terminal), is buffered. There's basically a call in the C standard library that determines this and enables the buffering feature, and Tcl follows that rule too (despite using its entirely independent I/O library). Doing this massively speeds up non-interactive pipeline processing, but means that if you're expecting to see every byte output exactly at the point when the program thinks it is writing it, you're going to be disappointed.
Of course, programs can switch this buffering off if they want. In Tcl, this is done by fconfigure $channel -buffering none (or line for line-oriented buffering). In cat, the -n option makes it do the equivalent (calling setvbuf() in C) and ispell is probably doing the same. But most programs don't. Some instead call fflush() from time to time; that works too, but is also a minority practice. So with a bidirectional pipeline such as you're using, you can easily force the side where you feed into it from Tcl not buffer, but you can't usually get the other side to do the same.
There is a workaround: run the subprocess with Expect. That puts a fake terminal between Tcl and the subprocess (instead of a pipe) and tricks it into thinking it is talking direct to the user. But the consequence of this is that you have to substantially rewrite your Tcl program and you gain a dependency on a (very fine!) external package.
I have a variable, let's say xx, with a list of index 0 and index 1 values. I want to modify a script (not mine) which previously defines a function, pptable, i.e.,
proc pptable {l1 l2} {
foreach i1 $l1 i2 $l2 {
puts " [format %6.2f $i1]\t[format %6.2f $i2]"
}
}
so that it displays the output into two columns using
pptable [lindex $xx 1] [lindex $xx 0]
However, I want to write the output directly to a file. Could you tell me how I can send the data to a file instead to the display?
One of the neatest ways of doing this is to stack on a channel transform that redirects stdout to where you want it to go. This works even if the write to stdout happens from C code or in a different thread as it plugs into the channel machinery. The code is a little bit long (and requires Tcl 8.6) but is reliable and actually mostly very simple.
package require Tcl 8.6; # *REQUIRED* for [chan push] and [chan pop]
proc RedirectorCallback {targetHandle op args} {
# The switch/lassign pattern is simplest way of doing this in one procedure
switch $op {
initialize {
lassign $args handle mode
# Sanity check
if {$mode ne "write"} {
close $targetHandle
error "this is just a write transform"
}
# List of supported subcommands
return {initialize finalize write}
}
finalize {
lassign $args handle
# All we need to do here is close the target file handle
close $targetHandle
}
write {
lassign $args handle buffer
# Write the data to *real* destination; this does the redirect
puts -nonewline $targetHandle $buffer
# Stop the data going to *true* stdout by returning empty string
return ""
# If we returned the data instead, this would do a 'tee'
}
default {
error "unsupported subcommand"
}
}
}
# Here's a wrapper to make the transform easy to use
proc redirectStdout {file script} {
# Stack the transform onto stdout with the file handle to write to
# (which is going to be $targetHandle in [redirector])
chan push stdout [list RedirectorCallback [open $file "wb"]]
# Run the script and *definitely* pop the transform after it finishes
try {
uplevel 1 $script
} finally {
chan pop stdout
}
}
How would we actually use this? It's really very easy in practice:
# Exactly the code you started with
proc pptable {l1 l2} {
foreach i1 $l1 i2 $l2 {
puts " [format %6.2f $i1]\t[format %6.2f $i2]"
}
}
# Demonstrate that stdout is working as normal
puts "before"
# Our wrapped call that we're capturing the output from; pick your own filename!
redirectStdout "foo.txt" {
pptable {1.2 1.3 1.4} {6.9 6.8 6.7}
}
# Demonstrate that stdout is working as normal again
puts "after"
When I run that code, I get this:
bash$ tclsh8.6 stdout-redirect-example.tcl
before
after
bash$ cat foo.txt
1.20 6.90
1.30 6.80
1.40 6.70
I believe that's precisely what you are looking for.
You can do this with less code if you use Tcllib and TclOO to help deal with the machinery:
package require Tcl 8.6
package require tcl::transform::core
oo::class create WriteRedirector {
superclass tcl::transform::core
variable targetHandle
constructor {targetFile} {
set targetHandle [open $targetFile "wb"]
}
destructor {
close $targetHandle
}
method write {handle buffer} {
puts -nonewline $targetHandle $buffer
return ""
}
# This is the wrapper, as a class method
self method redirectDuring {channel targetFile script} {
chan push $channel [my new $targetFile]
try {
uplevel 1 $script
} finally {
chan pop $channel
}
}
}
Usage example:
proc pptable {l1 l2} {
foreach i1 $l1 i2 $l2 {
puts " [format %6.2f $i1]\t[format %6.2f $i2]"
}
}
puts "before"
WriteRedirector redirectDuring stdout "foo.txt" {
pptable {1.2 1.3 1.4 1.5} {6.9 6.8 6.7 6.6}
}
puts "after"
I assume you don't want or can't modify the existing script and proc pptable, correct?
If so, there are different options, depending on your exact situation:
Redirect stdout: tclsh yourscript.tcl > your.out
Redefine puts (for a clearly defined scope):
rename ::puts ::puts.orig
proc puts args {
set fh [open your.out w];
::puts.orig $fh $args;
close $fh
}
# run pptable, source the script
This theme has been covered before, e.g., tcl stop all output going to stdout channel?
Rewire Tcl's stdout channel (not necessarily recommended):
close stdout
open your.out w
# run pptable, source the script
This has also been elaborated on before, e.g. Tracing stdout and stderr in Tcl
Currently I am firing following command
set pid [exec make &]
set term_id [wait pid]
First command will execute makefile inside TCL and Second Command will wait for first command's makefile operation to complete. First command displays all logs of makefile on stdout. Is it possible to store all logs in variable or file when "&" is given in the last argument of exec using redirection or any other method?
If "&" is not given then we can take the output using,
set log [exec make]
But if "&" is given then command will return process id,
set pid [exec make &]
So is it possible stop the stdout logs and put them in variable?
If you are using Tcl 8.6, you can capture the output using:
lassign [chan pipe] reader writer
set pid [exec make >#$writer &]
close $writer
Don't forget to read from the $reader or the subprocess will stall. Be aware that when used in this way, the output will be delivered fully-buffered, though this is more important when doing interactive work. If you want the output echoed to standard out as well, you will need to make your script do that. Here's a simple reader handler.
while {[gets $reader line] >= 0} {
lappend log $line
puts $line
}
close $reader
Before Tcl 8.6, your best bet would be to create a subprocess command pipeline:
set reader [open |make]
If you need the PID, this can become a bit more complicated:
set reader [open |[list /bin/sh -c {echo $$; exec make}]]
set pid [gets $reader]
Yes, that's pretty ugly…
[EDIT]: You're using Tk, in Tcl 8.5 (so you need the open |… pipeline form from above), and so you want to keep the event loop going. That's fine. That's exactly what fileevent is for, but you have to think asynchronously.
# This code assumes that you've opened the pipeline already
fileevent $reader readable [list ReadALine $reader]
proc ReadALine {channel} {
if {[gets $channel line] >= 0} {
HandleLine $line
} else {
# No line could be read; must be at the end
close $channel
}
}
proc HandleLine {line} {
global log
lappend log $line; # Or insert it into the GUI or whatever
puts $line
}
This example does not use non-blocking I/O. That might cause an issue, but probably won't. If it does cause a problem, use this:
fconfigure $reader -blocking 0
fileevent $reader readable [list ReadALine $reader]
proc ReadALine {channel} {
if {[gets $channel line] >= 0} {
HandleLine $line
} elseif {[eof $channel]} {
close $channel
}
}
proc HandleLine {line} {
global log
lappend log $line
puts $line
}
More complex and versatile versions are possible, but they're only really necessary once you're dealing with untrusted channels (e.g., public server sockets).
If you'd been using 8.6, you could have used coroutines to make this code look more similar to the straight-line code I used earlier, but they're a feature that is strictly 8.6 (and later, once we do later versions) only as they depend on the stack-free execution engine.