How is a channel's output-buffer content deleted without writing it to the channel? - tcl

I don't know much about PHP or Tcl; but I am trying to learn both concurrently.
In PHP, I read that every script should start with ob_start and, therefore, have been using the following.
ob_start(NULL, 0, PHP_OUTPUT_HANDLER_STDFLAGS);
echo header('Content-Length: '.ob_get_length());
ob_end_flush();
ob_end_clean();
In Tcl channels, I see that the options of -buffering full and -buffersize take care of ob_start() and chan flush is analogous to ob_end_flush() and chan pending output returns the number of bytes written to the output buffer but not yet written out.
I've been looking at my two texts on Tcl and the Tcl manual web page for channels and I can't find a method of just clearing the channel output buffer without writing it.
If data is being written to a channel set to -buffering full and an error is caught/trapped is it possible to empty the buffer and not write it to the channel?
It though perhaps that could use chan seek to set the position back to start similar to setting a pointer back to the beginning of a segment of RAM but the pipe example doesn't appear to create a channel that supports seeking.
lassign [chan pipe] rchan wchan
chan configure $rchan -buffering line -blocking 0 -translation crlf
chan configure $wchan -buffering full -blocking 0 -translation crlf
chan puts $wchan "This is the full messsage which shall attempt to truncate."
chan puts stdout "wchan pending: [chan pending output $wchan]"
chan puts stdout "wchan tell: [chan tell $wchan]"
# => -1 Thus, channel does not support seeking.
#chan seek $wchan 5 start
# => Errors invalid seek
chan flush $wchan
chan puts stdout [chan gets $rchan]
Thank you.

Sounds like you want to only output text written to a channel if no error happens in the middle of writing?
One way is to use a variable channel from tcllib; everything written to the channel is stored in a variable, which can then be written out to the real target on successful completion of whatever you're trying to do.
Example:
#!/usr/bin/env tclsh
package require tcl::chan::variable
proc main {} {
variable output
set output ""
set outputchan [::tcl::chan::variable output]
try {
puts $outputchan "Some text"
error "This is an error"
# Won't get written if an error is raised
chan flush $outputchan
puts -nonewline $output
} on error {errMsg errOptions} {
# Report error if you want
} finally {
chan close $outputchan
}
}
main

I don't think Tcl provides the functionality you are looking for. It's assumed that if you send something to a channel then it should always be written out.

Related

Redirecting output of tcl proc to file and output (like tee) Part 2

I am using tee from https://wiki.tcl-lang.org/page/Tee to redirect file output from my procedures. I need to redirect both stdout and stderr to the file.
Using the input from Redirecting output of tcl proc to file and output (like tee) I arrived at doing the following:
set LogFile [open ${LogFileName} w]
tee channel stderr $LogFile
tee channel stdout $LogFile
set BuildErrorCode [catch {LocalBuild $BuildName $Path_Or_File} BuildErrMsg]
set BuildErrorInfo $::errorInfo
# Restore stdout and stderr
chan pop stdout
chan pop stderr
# Handle errors from Build ...
I am testing this on three different EDA tools and I have three different issues.
When I run from tclsh (on MSYS2 running on Windows 10) and run either the open source simulator GHDL, ModelSim, or QuestaSim, all the even characters are the NUL character.
If I run ModelSim or QuestaSim from the GUI, I miss the output of each command. Shouldn't that be going to either stdout or stderr?
In Riviera-PRO, I am getting extraneous characters that were previously printed. They are generally the second half of a word.
Am I doing something wrong? I tested out the above code using:
set LogFile [open test_tee.log w]
tee channel stderr $LogFile
tee channel stdout $LogFile
puts "Hello, World!"
puts stderr "Error Channel"
puts stdout "Output Channel"
chan pop stdout
chan pop stderr
And this works well.
I am hoping to find something that works in the general case for all tools rather than having to write a different handler for each tool.
============ Update =============
For #1 above, with #Shawn's suggestion, I tried the following and it did not work.
set LogFile [open ${LogFileName} w]
chan configure $LogFile -encoding ascii
. . .
I also tried the following and it did not work.
set LogFile [open ${LogFileName} w]
fconfigure $LogFile -encoding ascii
. . .
Then I tried updating the write in tee to the following and it did not work:
proc tee::write {fd handle buffer} {
puts -nonewline $fd [encoding convertto ascii $buffer]
return $buffer
}
Any other hints solutions appreciated
============ Update2 =============
I have successfully removed the nul characters by doing the following, except now I have an extra newline. Still not a solution.
proc tee::write {fd handle buffer} {
puts -nonewline $fd [regsub -all \x00 $buffer ""]
return $buffer
}
The extra NUL bytes are probably because the stdout ahd steer channels are being written in UTF-16 (the main use for that encoding is the console on Windows). The tee interceptors you are using come after the data being written is encoded. There's a few ways to fix it, but the easiest is to open the file with the right encoding when reading it.
The output of the commands is not necessarily written to those channels. Code written in C or C++ is entirely free to write directly, and Tcl code cannot see that; it's all happening behind our back. Command results can be intercepted using execution traces, but that cannot see anything that the commands internally print that aren't routed via the Tcl library somehow. (There are a few more options on Unix due to the different ways that the OS handles I/O.)
Don't know what's happening with the extra characters. I can tell you that you are getting what goes through the channel, but there are too many tricks (especially in interactive use!) for a useful guess on that front.

Using Spawn-Expect mechanism in TCL-8.5

set pipeline [open "|Certify.exe args" "r"]
fconfigure $pipeline -blocking false
fconfigure $pipeline -buffering none
fileevent $pipeline readable [list handlePipeReadable $pipeline]
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
I have tried using pipe in TCL code. But for some reason, I want to convert this to Spawn- Expect mechanism. But I am grappling with it and facing issues when doing so. Can anyone please help me out??
Expect makes the pattern of usage very different and it uses a different way of interacting with the wrapped program that's much more like how interactive usage works (which stops a whole class of buffering-related bugs, which I suspect may be what you're hitting). Because of that, converting things over is not a drop-in change. Here's the basic pattern of use in a simple case:
package require Expect
# Note: different words become different arguments here
spawn Certify.exe args
expect "some sort of prompt string"
send "your input\r"; # \r is *CARRIAGE RETURN*
expect "something else"
send "something else\r"
expect eof
close
The real complexity comes when you can set up timeouts, wait for multiple things at once, wait for patterns as well as literal strings, etc. But doing the same from ordinary Tcl (even ignoring the buffering problems) is much more work. It's also almost always more work in virtually every other language.
Note that Expect doesn't do GUI automation. Just command-line programs. GUI automation is a much more complex topic.
It's not possible to give generic descriptions of what might be done as it depends so much on what the Certify.exe program actually does, and how you work with it interactively.

how to read the binary section of script currently being evaluated?

How do I read the section after end-of-stream (^Z) in a Tcl-script being sourced?
So far I got info script returning the filename of the currently sourced script which I could open just like any file and put the read position to after end-of-stream by just parsing the file.
In theory the content of the file could change between the invocation of source and subsequent info script and open, possibly causing temporal inconsistency between read script and binary data.
Is there a magic command for this that I've missed? Or do we rely on users/administrators making sure such inconsistencies can't happen?
Suggestion
Provide for your custom source that extracts the trailer in the same I/O step as sourcing the contained script. For example:
interp hide {} source source
proc ::source {fp} {
set size [file size $fp]
set chan [open $fp r]
info script $fp
try {
chan configure $chan -eofchar {\u001a {}}
set script [read $chan]
uplevel 1 [list eval $script]
set scriptOffset [chan tell $chan]
if {$scriptOffset < $size} {
chan seek $chan 1 current; # move cursor beyond eof
chan configure $chan -translation binary
set trailer [read $chan]
# do whatever you want to do with the trailer
}
} finally {
close $chan
}
}
Some remarks
The trick is to employ the same machinery as Tcl's source does internally: configure -eofchar.
Once it has been determined, that there is a trailer (i.e., content beyond the eof char), seek is used to position the cursor at the script's offset.
A second read will then get you the trailer.
From this point onwards, you must be careful to maintain the trailer value in its shape as byte array.
Disclaimer: Tcl wizards like Donal might have better ways of doing so. Also, single-file distribution mechanisms like starkits might have helpers for dealing with script trailers.

How to create a thread in tcl 8.4

I am new to tcl. I want to create a thread in tcl which should keep calling itself in background.
#!/usr/bin/env tclsh
set serPort [open "/dev/ttyS0" RDWR]
fconfigure $serPort -mode 115200,n,8,1 -blocking 0
while { 1 } {
set data [gets $chan]
puts $data
}
I want to avoid using the above while loop and create a repeatable thread for the functionality inside the while loop. Basically i am connecting the COM1 of my PC to a device and getting the serial data from the device. But if there is no data on the port it still doesn't come out of loop even if i use "eof" command. That is the reason i want to create the thread.
I am planning to use Tcl_CreateThread for that but I don't understood how to use it
Don't do that. Instead, use the usual Tcl's idiom for working with non-blocking channels: set up a handler for the "channel readable" event, and enter the event loop; when the device sends data to the port you opened, the OS passes the data to your application and the callback gets called.
A minimal program to demonstrate the concept looks like this:
proc my_read_handler ch {
set data [read $ch]
if {[eof $ch]} {
close $ch
set ::forever done ;# this makes the call to `vwait` below to quit
return
}
# Otherwise process the data here ...
}
set serPort [open "/dev/ttyS0" RDWR]
fconfigure $serPort -mode 115200,n,8,1 -blocking no
fileevent $serPort readable [list my_read_handler $serPort]
vwait ::forever ;# the program enters the event loop here
Read more on this in the examples.
Several observations:
The EOF only happens when the remote side closes. If you call close on your channel, the "readable" even won't be called in this case.
If you're writing a Tk application, it will already have an event loop, so no calls to vwait are necessary (moreover, they're highly advised against, as this will re-enter the event loop): you just open your device, say, in a code which executes when the users clicks a button, set up the readable callback on the acquired channel and then just do the rest of the processing in that callback (as shown above).
Read this (and the links there) for more info on the event-oriented programming. Also search the wiki — it contains lots of examples and background knowledge.

TCL: Two way communication between threads in Windows

I need to have two way communication between threads in Tcl and all I can get is one way with parameters passing in as my only master->helper communication channel. Here is what I have:
proc ExecProgram { command } {
if { [catch {open "| $command" RDWR} fd ] } {
#
# Failed, return error indication
#
error "$fd"
}
}
To call the tclsh83, for example ExecProgram "tclsh83 testCases.tcl TestCase_01"
Within the testCases.tcl file I can use that passed in information. For example:
set myTestCase [lindex $argv 0]
Within testCases.tcl I can puts out to the pipe:
puts "$myTestCase"
flush stdout
And receive that puts within the master thread by using the process ID:
gets $app line
...within a loop.
Which is not very good. And not two-way.
Anyone know of an easy 2-way communication method for tcl in Windows between 2 threads?
Here is a small example that shows how two processes can communicate. First off the child process (save this as child.tcl):
gets stdin line
puts [string toupper $line]
and then the parent process that starts the child and comunicates with it:
set fd [open "| tclsh child.tcl" r+]
puts $fd "This is a test"
flush $fd
gets $fd line
puts $line
The parent uses the value returned by open to send and receive data to/from the child process; the r+ parameter to open opens the pipeline for both read and write.
The flush is required because of the buffering on the pipeline; it is possible to change this to line buffering using the fconfigure command.
Just one other point; looking at your code you aren't using threads here you are starting a child process. Tcl has a threading extension which does allow proper interthread communications.