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.
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 have a case when the Tcl script runs a process, which does fork(), leaves the forked process to run, and then the main process exits. You can try it out simply by running any program that forks to background, for example gvim, provided that it is configured to run in background after execution: set res [exec gvim].
The main process theoretically exits immediately, the child process runs in background, but somehow the main process hangs up, doesn't exit, stays in zombie state (reports as <defunct> in ps output).
In my case the process I'm starting prints something, I want that something and I want that the process exit and I state it done. The problem is that if I spawn the process using open "|gvim" r, then I cannot also recognize the moment when the process has finished. The fd returned by [open] never reports [eof], even when the program turns into zombie. When I try to [read], just to read everything that the process might print, it hangs up completely.
What is more interesting, is that occasionally both the main process and the forked process print something and when I'm trying to read it using [gets], I get both. If I close the descriptor too early, then [close] throws an exception due to broken pipe. Probably that's why [read] never ends.
I need some method to recognize the moment when the main process exits, while this process could have spawned another child process, but this child process may be completely detached and I'm not interested what it does. I want something that the main process prints before exitting and the script should continue its work while the process running in background is also running and I'm not interested what happens to it.
I have a control over the sources of the process I'm starting. Yes, I did signal(SIGCLD, SIG_IGN) before fork() - didn't help.
Tcl clears up zombies from background process calls the next time it calls exec. Since a zombie really doesn't use much resources (just an entry in the process table; there's nothing else there really) there isn't a particular hurry to clean them up.
The problem you were having with the pipeline was that you'd not put it in non-blocking mode. To detect exit of a pipeline, you're best off using a fileevent which will fire when either there's a byte (or more) to read from the pipe or when the other end of the pipe is closed. To distinguish these cases, you have to actually try to read, and that can block if you over-read and you're not in non-blocking mode. However, Tcl makes working with non-blocking mode easy.
set pipeline [open |… "r"]
fileevent $pipeline readable [list handlePipeReadable $pipeline]
fconfigure $pipeline -blocking false
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 $pipeline
} else {
# Partial read; things will be properly buffered up for now...
}
}
vwait ::donepipe
Be aware that using gvim in a pipeline is… rather more complex than usual, as it is an application that users interact with.
You might find it easier to run a simple exec in a separate thread, provided your version of Tcl is thread-enabled and the Thread package is installed. (That ought to be the case if you're using 8.6, but I don't know if that's true.)
package require Thread
set runner [thread::create {
proc run {caller targetVariable args} {
set res [catch {
exec {*}$args
} msg opt]
set callback [list set $targetVariable [list $res $msg $opt]]
thread::send -async $caller $callback
}
thread::wait
}]
proc runInBackground {completionVariable args} {
global runner
thread::send -async $runner [list run [thread::id] $completionVariable {*}$args]
}
runInBackground resultsVar gvim …
# You can do other things at this point
# Wait until the variable is set (by callback); alternatively, use a variable trace
vwait resultsVar
# Process the results to extract the sense
lassign $resultsVar res msg opt
puts "code: $res"
puts "output: $msg"
puts "status dictionary: $opt"
For all that, for an editor like gvim I'd actually expect it to be run in the foreground (which doesn't require anything like as much complexity) since only one of them can really interact with a particular terminal at once.
Your daemon can also call setsid() and setpgrp() to start a new session and to detach from the process group. But these don't help with your problem either.
You will have to do some process management:
#!/usr/bin/tclsh
proc waitpid {pid} {
set rc [catch {exec -- kill -0 $pid}]
while { $rc == 0 } {
set ::waitflag 0
after 100 [list set ::waitflag 1]
vwait ::waitflag
set rc [catch {exec -- kill -0 $pid}]
}
}
set pid [exec ./t1 &]
waitpid $pid
puts "exit tcl"
exit
Edit: Another unreasonable answer
If the forked child process closes the open channels, Tcl will not wait on it.
Test program:
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <signal.h>
int
main (int argc, char *argv [])
{
int pid;
FILE *o;
signal (SIGCHLD, SIG_IGN);
pid = fork ();
if (pid == 0) {
/* should also call setsid() and setpgrp() to daemonize */
printf ("child\n");
fclose (stdout);
fclose (stderr);
sleep (10);
o = fopen ("/dev/tty", "w");
fprintf (o, "child exit\n");
fclose (o);
} else {
printf ("parent\n");
sleep (2);
}
printf ("t1 exit %d\n", pid);
return 0;
}
Test Tcl program:
#!/usr/bin/tclsh
puts [exec ./t1]
puts "exit tcl"
At first you say:
I need some method to recognize the moment when the main process exits, while this process could have spawned another child process, but this child process may be completely detached and I'm not interested what it does.
later on you say:
If the forked child process closes the open channels, Tcl will not wait on it.
these are two contradictory statements. One one hand you are only interested in the parent process and on the other whether or not the child has finished even thought you also state you aren't interested in child processes that have detached. Last I heard forking and closing the childs copies of the parents stdin,stdout and stderr is detaching (i.e.daemonizing the child process ). I wrote this quick program to run the above included simple c program and as expected tcl knows nothing of the child process. I called the compiled version of the program /tmp/compile/chuck. I did not have gvim so I used emacs but as emacs does not generate text I wrap the exec in its own tcl script and exec that. In both cases, the parent process is waited for and eof is detected. When the parent exits the Runner::getData runs and the clean up is evaluated.
#!/bin/sh
exec /opt/usr8.6.3/bin/tclsh8.6 "$0" ${1+"$#"}
namespace eval Runner {
variable close
variable watch
variable lastpid ""
array set close {}
array set watch {}
proc run { program { message "" } } {
variable watch
variable close
variable lastpid
if { $message ne "" } {
set fname "/tmp/[lindex $program 0 ]-[pid].tcl"
set out [ open $fname "w" ]
puts $out "#![info nameofexecutable]"
puts $out " catch { exec $program } err "
puts $out "puts \"\$err\n$message\""
close $out
file attributes $fname -permissions 00777
set fd [ open "|$fname " "r" ]
set close([pid $fd]) "file delete -force $fname "
} else {
set fd [ open "|$program" "r" ]
set close([pid $fd]) "puts \"cleanup\""
}
fconfigure $fd -blocking 0 -buffering none
fileevent $fd readable [ list Runner::getData [ pid $fd ] $fd ]
}
proc getData { pid chan } {
variable watch
variable close
variable lastpid
set data [read $chan]
append watch($pid) "$data"
if {[eof $chan]} {
catch { close $chan }
eval $close($pid) ; # cleanup
set lastpid $pid
}
}
}
Runner::run /tmp/compile/chuck ""
Runner::run emacs " Emacs complete"
while { 1 } {
vwait Runner::lastpid
set p $Runner::lastpid
catch { exec ps -ef | grep chuck } output
puts "program with pid $p just ended"
puts "$Runner::watch($p)"
puts " processes that match chuck "
puts "$output"
}
Output :
note I exited out of emacs after the child reported that it was exiting.
[user1#linuxrocks workspace]$ ./test.tcl
cleanup
program with pid 27667 just ended
child
parent
t1 exit 27670
processes that match chuck avahi 936 1 0 2016 ?
00:04:35 avahi-daemon: running [linuxrocks.local] admin 27992 1 0
19:37 pts/0 00:00:00 /tmp/compile/chuck admin 28006 27988 0
19:37 pts/0 00:00:00 grep chuck
child exit
program with pid 27669 just ended
Emacs complete
Ok, I found the solution after a long discussion here:
https://groups.google.com/forum/#!topic/comp.lang.tcl/rtaTOC95NJ0
The below script demonstrates how this problem can be solved:
#!/usr/bin/tclsh
lassign [chan pipe] input output
chan configure $input -blocking no -buffering line ;# just for a case :)
puts "Running $argv..."
set ret [exec {*}$argv 2>#stderr >#$output]
puts "Waiting for finished process..."
set line [gets $input]
puts "FIRST LINE: $line"
puts "DONE. PROCESSES:"
puts [exec ps -ef | grep [lindex $argv 0]]
puts "EXITING."
The only problem that remains is that there's still no possibility to know that the process has exited, however the next [exec] (in this particular case probably the [exec ps...] command did this) cleans up the zombie (No universal method for that - the best you can do on POSIX systems is [exec /bin/true]). In my case it was enough that I get one line that the parent process had to print, after which I can simply "let it go".
Still, it would be nice if [exec] can return me somehow the PID of the first process and there's a standard [wait] command that can block until the process exits or check its running state (this command is currently available in TclX).
Note that [chan pipe] is available only in Tcl 8.6, you can use [pipe] from TclX alternatively.
The script have sourced N number of files..,
source file 1
source file 2
.
.
source file N
when particular procedure A called ., Its actually present in most of the sourced files., anyway the last sourced file containing that proc A will do the function.,
how to find which file containing the proc is used when i call the proc ?
Any code i can use to achieve it ?
The simplest way (assuming Tcl 8.5 or 8.6) is to use an execution trace to call info frame to get the details of the call stack.
trace add execution A enter callingA
proc callingA args {
set ctxt [info frame -1]
if {[dict exists $ctxt file] && [dict exists $ctxt proc]} {
puts "Called [lindex $args 0 0] from [dict get $ctxt proc] in [dict get $ctxt file]"
} elseif {[dict exists $ctxt proc]} {
puts "Called [lindex $args 0 0] from [dict get $ctxt proc] (unknown location)"
} else {
# Fallback
puts "Called [lindex $args 0 0] from within [file normalize [info script]]"
}
}
There's quite a bit of other information in the dictionary returned by info frame.
For Tcl 8.4
In Tcl 8.4, you don't have info frame and Tcl doesn't remember where procedures are defined by default. You still have execution traces though (they were a new feature of Tcl 8.4) so that's OK then. (We have to be a bit careful with info script as that's only valid during the source and not after it finishes; procedures tend to be called later.)
To get where every procedure is defined, you have to intercept proc itself, and to do so early in your script execution! (Procedures defined before you set up the interceptor aren't noticed; Tcl's semantics are purely operational.) Fortunately, you can use an execution trace for this.
proc procCalled {cmd code args} {
if {$code==0} {
global procInFile
set procName [uplevel 1 [list namespace which [lindex $cmd 1]]]
set procInFile($procName) [file normalize [info script]]
}
}
# We use a leave trace for maximum correctness
trace add execution proc leave procCalled
Then, you use another execution trace on the command that you want to know the callers of to look up what that command is called, and hence where it was defined.
proc callingA args {
# Wrap in a catch so a lookup failure doesn't cause problems
if {[catch {
set caller [lindex [info level -1] 0]
global procInFile
set file $procInFile($caller)
puts "Calling [lindex $args 0 0] from $caller in $file"
}]} {
# Not called from procedure!
puts "Calling [lindex $args 0 0] from within [file normalize [info script]]"
}
}
trace add execution A enter callingA
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
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
}