How to write to pager subprocess in Tcl? - file-io

When trying to write to more subprocess in Tcl, a broken pipe error will occurred. It seems that more is exited abnormally. e.g.:
#!/usr/bin/env tclsh
set pager [open {| more} w]
for {set i 0} {$i < 10000} {incr i} {
puts $pager "$i foo"
}
close $pager
Can not figure out what's going wrong.
BTW, it seems OK if less is used instead of more.
Edit: Following Python version works properly:
#!/usr/bin/env python3
import os
pager = os.popen("more", "w")
for i in range(10000):
pager.write("{} foo".format(i))
pager.close()

The issue is that when you close the pipe, the more process gets a SIGPIPE signal that makes it exit, and Tcl detects that there was an exit due to a signal and produces that error.
The simplest method of dealing with it is to put a catch around the close.
#!/usr/bin/env tclsh
set pager [open {| more} w]
for {set i 0} {$i < 10000} {incr i} {
puts $pager "$i foo"
}
catch {close $pager}
Alternatively, use less instead of more; that doesn't exit in the same way at the end of the input pipe (by default).

Related

Handling huge file with tcl

can anyone tell me how I can update the following procedure to handle big files please (size <= 10 G):
proc read_text_file { file } {
set fp [open ${file} r]
set return_data ""
while { [gets $fp each_line] != -1 } {
lappend return_data ${each_line}
}
close $fp
return ${return_data}
}
my objective is to read a huge file line by line in a better runtime
Thanks
When you have a very large file, you categorically want to avoid bringing it all into memory at once. (Also, Tcl 8.* has a memory chunk allocation limit that makes bringing in 50GB of data intensely exciting. That's a long-standing API bug that's fixed in 9.0 — in alpha — but you'll have to put up with it for now.)
If you can, do a pass over the file to identify where the interesting sub-chunks of it are. For the sake of argument, let's assume that those are the lines that match a pattern; here's an example that finds where procedures are in a Tcl script (under some simple assumptions).
proc buildIndices {filename} {
set f [open $filename]
set indices {}
try {
while {![eof $f]} {
set idx [tell $f]
set line [gets $f]
if {[regexp {^proc (\w+)} $line -> name]} {
dict set indices $name $idx
}
}
return $indices
} finally {
close $f
}
}
Now you have the indices, you can then pull in a procedure from the file like this:
proc obtainProcedure {filename procName indices} {
set f [open $filename]
try {
seek $f [dict get $indices $procName]
set procedureDefinition ""
while {[gets $f line] >= 0} {
append procedureDefinition $line "\n"
if {[info complete $procedureDefinition]} {
# We're done; evaluate the script in the caller's context
tailcall eval $procedureDefinition
}
}
} finally {
close $f
}
}
You'd use that like this:
# Once (possibly even save this to its own file)
set indices [buildIndices somefile.tcl]
# Then, to use
obtainProcedure somefile.tcl foobar $indices
If you're doing this a lot, convert your code to use a database; they're a lot more efficient in the long run. The index building is equivalent to building the database and the other procedure is equivalent to doing a DB query.

Keep set -e setting inside || or &&

I have a simple script with a simple function which can lead to an error. Let's define this function, and make it broken:
brokenFunction () {
ls "non-existing-folder"
}
If we execute this function in a block detecting if it is broken, it works well:
brokenFunction || printf "It is broken\n"
prints "It is broken"
Now, let's make the function a bit more complex, by adding a correct command at the end :
#!/bin/sh
brokenFunction () {
ls "non-existing-folder"
printf "End of function\n"
}
brokenFunction || printf "It is broken\n"
This script prints :
$ ./script.sh
ls: cannot access 'non-existing-folder': No such file or directory
End of function
while I expected the function to stop before the printf statement, and the next block to display "It is broken".
And indeed, if I check the exit status code of brokenFunction, it is 0.
I tried adding set -e to the top of the script. The behavior is still the same, but the exit code of brokenFunction if called without || now becomes 2. If called with it, the status code is still 0.
Is there any way to keep the set -e setting inside a function called with ||?
EDIT: I just realized that the function in the example was useless. I encounter the same issue with a simple block and a condition.
#!/bin/sh
set -e
{
ls "non-existing-dir"
printf "End of block\n"
} || {
printf "It is broken\n"
}
prints
$ ./script.sh
ls: cannot access 'non-existing-dir': No such file or directory
End of block
As written in man bash, set -e is ignored in some contexts. A command before || or && is such a context.
trap looks like a possible solution here. A working alternative to the last script using trap would look like that:
#!/bin/sh
abort () {
printf "It is broken\n"
}
trap 'abort' ERR
(
set -e
false
printf "End of block\n"
)
trap - ERR
Some things have to be noticed here:
trap 'abort' ERR binds the abort function to any raised error ;
the broken block is executed in a sub-shell for 2 reasons. First is to keep the set -e setting inside the block and limit the border effects. Second is to exit this sub-shell on error (set -e effect), and not the whole script ;
trap - ERR at the end resets the trap binding, meaning the following part of the script is executed as before.
To test the border effects, we can add the previously non-working part :
#!/bin/sh
abort () {
printf "It is broken\n"
}
trap 'abort' ERR
(
set -e
false
printf "End of block\n"
)
trap - ERR
{
false
printf "End of second block\n"
} || {
printf "It is broken too\n"
}
prints:
It is broken
End of second block

Run TCL script in regular intervals with continuous results

I have encountered a problem in one of my TCL scripts. I need to run it in an infinite loop with a terminating condition and in every loop I need to write some output. This is the basic code that im using:
proc wr {i} {
puts -nonewline "$i"
}
proc do {roof} {
set end 0
while {$end < $roof} {
after 1000
wr $end
incr end
}
}
do 10
The expected behaviour is that every second there will be a new output until $end == $roof. But instead after running this script, the console window is busy for 10 seconds and after that time, the entire output prints out at once.
Thank you for your advice :)
The problem is that you don't flush stdout.
If you modify your script so it flushes stdout:
proc wr {i} {
puts -nonewline "$i"
flush stdout
}
proc do {roof} {
set end 0
while {$end < $roof} {
after 1000
wr $end
incr end
}
}
do 10
It will work. You can also change the buffering of the stdout channel to none, the default is line:
fconfigure stdout -buffering none
If you write more than one line, the default buffering will flush stdout when it encounters a newline, but you never write a newline.

How can I check if a GNU awk coprocess is open, or force it to open without writing to it?

I have a gawk program that uses a coprocess. However, sometimes I don't have any data to write to the coprocess, and my original script hangs while waiting for the output of the coprocess.
The code below reads from STDIN, writes each line to a "cat" program, running as a coprocess. Then it reads the coprocess output back in and writes it to STDOUT. If we change the if condition to be 1==0, nothing gets written to the coprocess, and the program hangs at the while loop.
From the manual, it seems that the coprocess and the two-way communication channels are only started the first time there is an IO operation with the |& operator. Perhaps we can start things without actually writing anything (e.g. writing an empty string)? Or is there a way to check if the coprocess ever started?
#!/usr/bin/awk -f
BEGIN {
cmd = "cat"
## print "" |& cmd
}
{
if (1 == 1) {
print |& cmd
}
}
END {
close (cmd, "to")
while ((cmd |& getline line)>0) {
print line
}
close(cmd)
}
Great question, +1 for that!
Just test the return code of the close(cmd, "to") - it will be zero if the pipe was open, -1 (or some other value) otherwise. e.g.:
if (close(cmd, "to") == 0) {
while ((cmd |& getline line)>0) {
print line
}
close(cmd)
}

sending "ping" output to a variable

I am trying to ping some ip addresses in my router. I use this code:
for {set n 0} {$n < 10} {incr n} {puts [exec "ping 199.99.$n.1]}
but this will show the output.
the issue is that I don't want to see the output. I would like to send that output into another variable and the search the content of variable with "regexp" and get the result, and do the rest of the story.
but I don't know how I can do that.
Use the set command. The puts command prints it's argument.
set pingOutput [exec ping "199.99.$n.1"]
Or append if you want all IP's results in one variable.
set allPingOutput ""
for {set n 0} {$n < 10} {incr n} {
append allPingOutput [exec ping "199.99.$n.1"]
}
Try calling the ping with the -c flag:
ping -c 1 10.0.1.1
Not sure how to do it in tcl but in php for example:
It is very important to use ping -c1 <IP address> , otherwise the script will never end as the ping process never ends :)
My code uses an array of results of every IP
for {set i 2 } {$i < 10} {incr i} {
catch {if {[regexp {bytes from} [exec ping -c1 192.168.12.$i]]} {
set flag "reachable"
} else { set flag "not reachable"}
set result(192.168.12.$i) $flag
}
}
parray result
OUTPUT :
result(192.168.12.2) = reachable
result(192.168.12.3) = reachable
result(192.168.12.5) = reachable
result(192.168.12.6) = reachable
result(192.168.12.7) = reachable
result(192.168.12.9) = reachable
Instead of storing and manipulating , I used regexp .