I am running a bunch of functions. Each of them outputs a lot of text to stdout which prevents me from quickly checking the results.
Is there any easy way to stop output going to the stdout channel?
Thanks
If the functions are just writing to stdout for logging purposes and you want to throw all that stuff away, and they aren't wanting to write to disk or a socket or any other kind of channel, the simplest method is this:
rename puts original_puts
proc puts args {} ;# A do-nothing procedure!
To convert back to normal operation:
rename puts {}
rename original_puts puts
Be aware that this will cause problems if the wrapped code has an error in it unless you are careful. Here's a wrapped “careful” version (for Tcl 8.5):
proc replacement_puts args {}
proc silentEval {script} {
rename puts original_puts
interp alias {} puts {} replacement_puts
catch [list uplevel 1 $script] msg opts
rename puts {}
rename original_puts puts
return -options $opts $msg
}
Then you just do this:
silentEval {
call-noisy-function-A
call-noisy-function-B
...
}
If you've got code that wants to write to files (or sockets or …) then that's possible via a more complex replacement_puts (which can always use the original_puts to do the dirty work).
If those functions are writing to stdout from the C level, you're much more stuck. You could do close stdout;open /dev/null to direct the file descriptor to a sink, but you wouldn't be able to recover from that easily. (There's a dup in the TclX package if that's necessary.) Try the simple version above if you can first.
The only good way to prevent output to stdout/stderr is to remove (in some way) the
stdout/stderr channel from the interpreter you are executing the script in, because there are many ways to write things to a channel (including, but not limited to puts, chan puts and fcopy)
I suggest creating a new safe interp and transfer the channel to this interp, call the script, and transfer the channel back. After that you might choose to delete the interp or reuse it for similar purposes.
proc silentEval {script} {
set i [interp create -safe]
interp transfer {} stdout $i
catch [list uplevel 1 $script] msg opts
interp transfer $i stdout {}
interp delete $i
dict incr $opts -level
return -options $opts $msg
}
Related
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
I'm trying to run proc with new process
I'm trying to call proc1 and proc2 from main function , but each should run separately with a new process (or subprocess) and also wait till it finish
proc main { var } {
puts "main function with var: $var"
#call proc1 with new process
exec proc1 1
#wait till proc1 finish
#call proc2 with new process
exec proc2 2
#wait till proc2 finish
puts "Finished"
}
proc proc1 { var1 } {
puts "proc1 function with var: $var1"
}
proc proc2 { var2 } {
puts "proc2 function with var: $var2"
}
I tried using exec but it did not work
I tried googling it, but did not succeed to find a solution
How can I make it run ?
Thanks a lot!
The simplest mechanism is to put the procedures in a separate file (e.g., myprocs.tcl) with the following bit of extra code at the end of the file:
# Take a command from stdin, evaluate it, and write result to stdout
puts [eval [read stdin]]
Then you call those procedures using the following helper:
proc runproc {procname args} {
exec [info nameofexecutable] myprocs.tcl << [list $procname {*}$args] 2>#stderr
}
# Demonstrating
set result [runproc proc1 1]
The above isn't the most robust mechanism however. In particular, if you have a bug in your procedures, things will go quite wonky. Here's a more robust mechanism that works very well provided you change your procedures to return their results instead of putsing them:
Callee side:
set cmd [read stdin]
catch $cmd msg opts
puts [list $msg $opts]
exit
Caller side:
proc runproc {procname args} {
set cmd [list $procname {*}$args]
set pair [exec [info nameofexecutable] myprocs.tcl << $cmd 2>#stderr]
lassign $pair msg opts
return -options $opts $msg
}
Transferring a normal stdout across at the same time, or allowing the subprocess to access the caller's stdin, requires more work again to move the command-and-control channel to be other than a standard pipe, and the above is good enough for a lot of things.
I have a Tcl utility that makes it easy to ensure a snippet of code run at the time control flow leaves the current scope (of the proc). It crashes in Tcl 8.6.6, so I'm wondering if there is a "better" way to implement the functionality in Tcl 8.6?
An example usage is:
proc test {file} {
set fh [open $file]
::Util::Defer [list close $fh]
# ... do a bunch of stuff
# and even if we hit an error
# [close $fh] will be evaluated as we return
# from the proc
}
It's worked great in Tcl 8.4, and I use it all over my code.
As I'm still coming up to speed on all the functionality available in Tcl 8.6, I'm asking how should the ::Util::Defer proc be written to best take advantage of Tcl 8.6?
Here is the 8.4 implementation:
namespace eval ::Util {}
proc ::Util::Defer_impl {cmd args} {
uplevel 1 $cmd
}
proc ::Util::Defer {cmd} {
set vname _u_defer_var
# look for a unique variable name
while {[uplevel 1 [list info vars $vname]] != ""} {
set vname ${vname}_
}
uplevel 1 [list set $vname $cmd]
# when the variable is unset, trigger a call to the command
uplevel 1 [list trace add variable $vname unset [list ::Util::Defer_impl $cmd]]
# return a chunk of code enabling the user to cancel this if desired
return [list variable $vname unset [list ::Util::Defer_impl $cmd]]
}
Edited to add:
I appreciate the answers. To be honest, I already have other syntactic sugar for a file handle, this:
proc test {file} {
set fh [::Util::LocalFileHandle $file]
# do stuff
}
I was just hoping more for a generic solution to the ::Util::Defer - because I occasionally have two or three uses (at different locations) in the same proc. Yes, I'm leaving out the error handling if the doesn't exist or isn't readable.
Note: I have reported the bug to ActiveState and filed a bug at core.tcl.tk.
Edited to add buggy code: This is the Tcl code that causes a crash for me, it is slightly pared down to the essence (as opposed to being the full-blown ::Util::Defer).
# ---------------begin script-------------------
package require Itcl
proc ::try_uplevel {} {
return [uplevel 1 [list ::info vars _u_defer_var]]
}
itcl::class ::test_class {
constructor {} {}
public proc test_via_proc {} {
::try_uplevel
}
}
::test_class::test_via_proc
# ---------------end script-------------------
The pattern you describe is a supported one; it shouldn't crash (and indeed I can't reproduce the crash with 8.6.3 or the tip of the 8.6 support branch). The only problem it has is that if you have an error during the close (or any other deferred script) it won't report it, as you can see from this snippet (% is prompt):
% apply {{} {
::Util::Defer [list error boo]
puts hi
}}
hi
%
This is part of why I went to quite a bit of effort to provide a try command in 8.6. With that, you can do this:
proc test {filename} {
set f [open $filename]
try {
# Do stuff with $f
} finally {
close $f
}
}
It also takes care of tricky things like stitching errors thrown inside the body and the finally clause together (the body exception info is in the -during option of the finally clause's error exception info) so that if both places error you can find out about both.
% catch {
try {
error a
} finally {
error b
}
} x y
1
% puts $x
b
% puts $y
-errorstack {INNER {returnImm b {}}} -errorcode NONE -errorinfo {b
while executing
"error b"} -errorline 5 -during {-code 1 -level 0 -errorstack {INNER {returnImm a {}}} -errorcode NONE -errorinfo {a
while executing
"error a"} -errorline 3} -code 1 -level 0
Personally, I'd be more inclined to write this:
proc withreadfile {varName filename body} {
upvar 1 $varName f
set f [open $filename]
try {
return [uplevel 1 $body]
} finally {
close $f
}
}
proc test {file} {
withreadfile fh $file {
# Do stuff with $fh
}
}
Your mileage may vary.
Untested code (this exact snippet, I've used this pattern many times):
proc test file {
try {
open $file
} on ok fh {
# do stuff with fh
# more stuff
} finally {
catch {close $fh}
}
}
should be about the same. Regardless of whether you handle errors with the try structure or not, (or whether you get errors or not) the code in the finally clause is run when it ends. If you want to be able to cancel the action, use a simple if inside the clause.
Edit
In case one wants to see any errors generated when the channel is closed, it's a bad idea to just wrap it in a catch, which is necessary if the file couldn't be opened and the channel-id variable wasn't created. Alternatives include:
Checking for existence: if {[info exists fh]} {close $fh}
Propagate the closing error: using the result and options variable name arguments to catch.
Over the weekend this heavyweight solution came to mind. It leverages the itcl::local functionality to achieve the same effect. It does depend on Itcl - but since the problem is an interaction with Itcl, that seems a reasonable solution, even though it is not purely Tcl.
itcl::class Defer_impl {
constructor {cmd} {} {
set _to_eval $cmd
}
destructor {
uplevel 1 $_to_eval
}
private variable _to_eval {}
}
proc ::Util::Defer {cmd} {
uplevel 1 [list itcl::local ::Defer_impl #auto $cmd]
}
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.
Is there any way to list all the procedures(proc) in a myFile.tcl using another tcl file or in the same file.
You can use [info procs] before and after sourcing the file in question and compare the results to determine which procs were added. For example:
proc diff {before after} {
set result [list]
foreach name $before {
set procs($name) 1
}
foreach name $after {
if { ![info exists procs($name)] } {
lappend result $name
}
}
return [lsort $result]
}
set __before [info procs]
source myFile.tcl
set __after [info procs]
puts "Added procs: [diff $__before $__after]"
One thing I like about this solution is that the diff procedure is really just a generic set differencing utility -- it's not specific to comparing lists of defined procedures.
The cheapest way is to just open the file and use regexp to pick out the names. It's not perfectly accurate, but it does a reasonably good job.
set f [open "sourcefile.tcl"]
set data [read $f]
close $f
foreach {dummy procName} [regexp -all -inline -line {^[\s:]*proc (\S+)} $data] {
puts "Found procedure $procName"
}
Does it deal with all cases? No. Does it deal with a useful subset? Yes. Is the subset large enough for you? Quite possibly.
Yes it is, although not that easy. The basic idea is to source the file in a modified slave interp that only executes some commands:
proc proc_handler {name arguments body} {
puts $name
}
set i [interp create -safe]
interp eval $i {proc unknown args {}}
interp alias $i proc {} proc_handler
interp invokehidden source yourfile.tcl
This approach will fail if the file requires other packages (package require will not work), relies on the result of some usually auto_load'ed commands etc..
It also does not take namespaces into account. (namespace eval ::foo {proc bar a {}} creates a proc with the name ::foo::bar
For a more complex implementation you could look into auto.tcl's auto_mkindex, which has a similar goal.
Here is a different approach:
Create a temporary namespace
Source (include) the script in question, then
Use the info procs command to get a list of procs
Delete the temporary namespace upon finish
Here is my script, *list_procs.tcl*:
#!/usr/bin/env tclsh
# Script to scan a Tcl script and list all the procs
proc listProcsFromFile {fileName} {
namespace eval TempNamespace {
source $fileName
set procsList [info procs]
}
set result $::TempNamespace::procsList
namespace delete TempNamespace
return $result
}
set fileName [lindex $::argv 0]
set procsList [listProcsFromFile $fileName]
puts "File $fileName contains the following procs: $procsList"
For example, if you have the following script, procs.tcl:
proc foo {a b c} {}
proc bar {a} {}
Then running the script will produce:
$ tclsh list_procs.tcl procs.tcl
File procs.tcl contains the following procs: foo bar