TCL Function throws an error - tcl

I have this function,
proc get_sys_status aname {
upvar $aname a
set input [exec "get system status\n" "# "]
set linelist [split $input \n]
foreach line $linelist
{
if {![regexp {([^:]+):(.*)} $line dummy key value]}
continue
switch -regexp -- $key
{
Hostname
{
set a(hostname) [string trim $value]
}
}
}
}
get_sys_status status
 
# line 17
puts "This machine is called $status(hostname)"
The general idea is that it takes the output of command “get system status” and parses the data. Once it parses this, it grabs the hostname and uses that to issue a few commands to the box. Error occurs at line 17 (the very last line):
can't read "status(hostname)": no such variable
----An error occured at line #17 of the script----
------- The end of log ----------
What is wrong with this function?

Related

Read socket is blocked

I'm writing a socket utility to communicate a client to a server. When input to the socket from the client side, the server is receiving it fine. However, when input to the socket from the server, the client can't read. When checking for fblocked $channel. It is 1. I've tried everything including adding new line, ...
Please help.
Below is my code
proc read_command { sock } {
variable self
global connected
set len [gets $sock line]
set bl [fblocked $sock]
puts "Characters Read: $len Fblocked: $bl"
if {$len < 0} {
if {$bl} {
puts "Input is blocked"
} else {
set connected 1
puts "The socket was closed - closing my end"
close $sock
}
} else {
if {!$bl} {
puts "Read $len characters: $line"
catch {uplevel #0 $line} output
puts "1==>$output<=="
puts $sock "$output"
puts $sock "\n"
flush $sock
}
}
}
proc client { host port } {
variable self
set s [socket $host $port]
set self(csock) $s
set self($s,addr) $host
set self($s,port) $port
fconfigure $s -buffering line -blocking 0
return $s
}
proc prun { sock args} {
variable self
set result [list]
set cmd $args
set cmd [regsub -all {(^\s*\{)||(\}\s*$)} $cmd ""]
set cmd [string trimleft $cmd]
set o1 [eval $cmd]
#catch {uplevel #0 $cmd} o1
puts "1_$sock ==> $o1"
lappend result $o1
#--------------
puts $sock $cmd
flush $sock
set bl [fblocked $sock]
set file [read $sock]
set bl [fblocked $sock]
puts "Fblocked: $bl"
puts "Output: $file"
puts "2_$Comm::self(csock) ==> $file ==> $bl"
lappend result $file
return $result
}
Here is how I run it.
I call server on 1 of the terminal. It will echo the ip address and the port.
Then I call client using the address and the port above to get back the client socket
Then I call prun on the client shell to get back a pair of values, one with the value of the cmd call on the client, and the other the value of the cmd call on the server. Basically I would like to get the pair of values so I can use them for correlation between the 2 set of data.
Below is the code:
1.
On server shell
$ server
2.
On client shell
$ set s [client $addr $port]
3.
Call a proc to get the value from the client shell, then send the command to the server to get the value from the server shell, and return that value back to the client.
$ set res [prun $s {set val [get_attribute [get_nets mynet] pin_capacitance_max]}]
You wrote:
puts "2_$Comm::self(csock) ==> $file ==> $bl"
and defined self with variable. Are you working with packages?. May be you forgot something related to it.
For test you can use just global but using arrays would be a little more complicated.

how to create tcl proc with hyphen flag arguments

Im searching all over the internet , i guess im searching not the right keywords
i tried most of them :)
i want to create in tcl/bash a proc with hyphen flags to get arguments with flags from the user
ex.
proc_name -color red -somethingselse black
It's very easy to do, actually. This code allows abbreviated option names, flag options (-quxwoo in the example) and the ability to stop reading options either with a -- token or with a non-option argument appearing. In the example, unknown option names raise errors. After passing the option-parsing loop, args contains the remaining command-line arguments (not including the -- token if it was used).
proc foo args {
array set options {-bargle {} -bazout vampires -quxwoo 0}
while {[llength $args]} {
switch -glob -- [lindex $args 0] {
-bar* {set args [lassign $args - options(-bargle)]}
-baz* {set args [lassign $args - options(-bazout)]}
-qux* {set options(-quxwoo) 1 ; set args [lrange $args 1 end]}
-- {set args [lrange $args 1 end] ; break}
-* {error "unknown option [lindex $args 0]"}
default break
}
}
puts "options: [array get options]"
puts "other args: $args"
}
foo -barg 94 -quxwoo -- abc def
# => options: -quxwoo 1 -bazout vampires -bargle 94
# => other args: abc def
This is how it works. First set default values for the options:
array set options {-bargle {} -bazout vampires -quxwoo 0}
Then enter a loop that processes the arguments, if there are any (left).
while {[llength $args]} {
During each iteration, look at the first element in the argument list:
switch -glob -- [lindex $args 0] {
String-match ("glob") matching is used to make it possible to have abbreviated option names.
If a value option is found, use lassign to copy the value to the corresponding member of the options array and to remove the first two elements in the argument list.
-bar* {set args [lassign $args - options(-bargle)]}
If a flag option is found, set the corresponding member of the options array to 1 and remove the first element in the argument list.
-qux* {set options(-quxwoo) 1 ; set args [lrange $args 1 end]}
If the special -- token is found, remove it from the argument list and exit the option-processing loop.
-- {set args [lrange $args 1 end] ; break}
If an option name is found that hasn't already been dealt with, raise an error.
-* {error "unknown option [lindex $args 0]"}
If the first argument doesn't match any of the above, we seem to have run out of option arguments: just exit the loop.
default break
Documentation: array, break, error, lassign, lindex, llength, proc, puts, set, switch, while
With array set, we can assign the parameters and their values into an array.
proc getInfo {args} {
# Assigning key-value pair into array
# If odd number of arguments passed, then it should throw error
if {[catch {array set aInfo $args} msg]} {
return $msg
}
parray aInfo; # Just printing for your info
}
puts [getInfo -name Dinesh -age 25 -id 974155]
will produce the following output
aInfo(-age) = 25
aInfo(-id) = 974155
aInfo(-name) = Dinesh
The usual way to handle this in Tcl is by slurping the values into an array or dictionary and then picking them out of that. It doesn't offer the greatest amount of error checking, but it's so easy to get working.
proc myExample args {
# Set the defaults
array set options {-foo 0 -bar "xyz"}
# Read in the arguments
array set options $args
# Use them
puts "the foo option is $options(-foo) and the bar option is $options(-bar)"
}
myExample -bar abc -foo [expr {1+2+3}]
# the foo option is 6 and the bar option is abc
Doing error checking takes more effort. Here's a simple version
proc myExample args {
array set options {-foo 0 -bar "xyz"}
if {[llength $args] & 1} {
return -code error "must have even number of arguments in opt/val pairs"
}
foreach {opt val} $args {
if {![info exist options($opt)]} {
return -code error "unknown option \"$opt\""
}
set options($opt) $val
}
# As before...
puts "the foo option is $options(-foo) and the bar option is $options(-bar)"
}
myExample -bar abc -foo [expr {1+2+3}]
# the foo option is 6 and the bar option is abc
# And here are the errors it spits out...
myExample -spregr sgkjfd
# unknown option "-spregr"
myExample -foo
# must have even number of arguments in opt/val pairs
#flag defaults
set level 1
set inst ""
# Parse Flags
while {[llength $args]} {
set flag [lindex $args 0]
#puts "flag: ($flag)"
switch -glob $flag {
-level {
set level [lindex $args 1]
set args [lrange $args 2 end]
puts "level:($level) args($args)"
} -inst {
set autoname 0
set inst [lindex $args 1]
set args [lrange $args 2 end]
puts "inst:($inst) args($args)"
} -h* {
#help
puts "USAGE:"
exit 1
} -* {
# unknown option
error "unknown option [lindex $args 0]"
} default break
}
}
# remaining arguments
set filename "$args"
puts "filename: $args"

Tcl: Using the unknown command to include dot notation procedures

Tcl syntax is very simple and consistant in the sense of its command / arguments structure. Sometimes I miss the dot notation of other languages like ruby. In ruby you can right something like this:
-199.abs # => 199
"ice is nice".length # => 11
"ruby is cool.".index("u") # => 1
"Nice Day Isn't It?".downcase.split("").uniq.sort.join # => " '?acdeinsty"
In Radical Language Modification and Let unknown know there are ideas of how to modify the language with the unknown command, e.g.:
proc know {cond body} {
proc unknown {args} [string map [list #c# $cond #b# $body] {
if {![catch {expr {#c#}} res] && $res} {
return [eval {#b#}]
}
}][info body unknown]
}
know {[regexp {^([a-z]+)\.([a-z]+)$} [lindex $args 0] -> from to]} {
set res {}
while {$from<=$to} {lappend res $from; incr from}
set res
}
# % puts [1..5]
# 1 2 3 4 5
How can I modify the previous code, so I can write commands with dot notation as in the Ruby example.
You can do it for specific operations, but not all, and there are some syntactic limitations. For example:
know {[regexp {^(.*)\.length$} [lindex $args 0] -> value]} {
string length $value
}
puts [abc.length]
# ---> 3
set thevar "abc def"
puts [$thevar.length]
# ---> 7
puts ["abc def".length]
# ---> extra characters after close-quote
That is, the value must still be syntactically-valid Tcl; that last example is not. You can chain the know handlers by using [$value] instead of plain $value in the handler, provided you've got a handler for the base case.
know {[regexp {^(.*)\.length$} [lindex $args 0] -> value]} {
string length [$value]
}
know {[regexp {^(.*)\.repeat\((\d+)\)$} [lindex $args 0] -> value count]} {
string repeat [$value] $count
}
# Base case for simple words
know {[regexp {^'(.*)'$} [lindex $args 0] -> value]} {
set value
}
puts ['abc\ def'.repeat(5).length]
# ---> 35
Ultimately, while you can do all sorts of stuff like this, it's not how Tcl is designed to work. It is going to be slow (the unknown calling mechanism is not an optimised path) and you're going to hit limitations. Better to learn to do things the normal way:
puts [string length [string repeat "abc def" 5]]

Unable to puts in a tcl script

I am trying to create a trace function in tcl .Function will list down all the called procs/nested calls and there arguments. Below is the script
rename proc _proc
proc proc {nm params body} {
_proc $nm $params $body
trace add execution $nm enter [list track_entry $nm $params]
trace add execution $nm leave [list track_leave $nm]
}
_proc track_entry {nm params real args} {
puts "Enter proc $nm"
foreach formal $params actual [lrange $real 1 end] {
append p " [lindex $formal 0]=$actual,"
}
puts "Parameters:$p and body"
}
_proc track_leave {nm args} {
puts "Exit proc $nm"
}
proc test1 { param1 param2 } {
puts “parameters are $param1 and $param2”
test2 value1
}
proc test2 { value} {
puts “value is $value”
}
I am getting below output
test1 arg1 arg2
Enter proc test1
Parameters: param1=arg1, param2=arg2, and body
Exit proc test1
wrong # args: should be "puts ?-nonewline? ?channelId? string"
Any clue why it is giving error in puts
Provided that what you posted is correct, the problem is you're not using the correct quoting character.
Tcl only understands two kinds of quoting:
quoting with substitutions: ""
quoting without substitutions: {}
The character “ in tcl will just be treated as any other character such as a or 5.
Note that without quoting, tcl treats the word as a string without spaces. For example, the following examples are all valid strings:
this_is_a_valid_string
"this_is_a_valid_string"
{this_is_a_valid_string}
Following this simple rule, the following are also valid strings and are all equivalent:
“hello
"“hello"
{“hello}
So when you ask tcl to execute the following:
puts “parameters are $param1 and $param2”
it treats it as:
puts {“parameters} {are} "$param1" {and} "$param2”"
passing 5 arguments to puts.
Obviously this would trigger an error since puts expects either one or two arguments.

How to run executable within the tcl?

I am trying to execute program which has some options, and take as an input txt file. So I have try this:
set myExecutable [file join $::env(path_to_the_program) bin executable_name]
if { ![file exists $myExecutable ] } {
puts "error"
}
if { ![file executable $myExecutable ] } {
puts "error"
}
set arguments [list -option1 -option2]
set status [catch { exec $myExecutable $arguments $txtFileName } output]
if { $status != 0 } {
puts "output = $output"
}
So it's print:
output = Usage: executable_name -option1 -option2 <txt_file_name>
child process exited abnormally
You didn't actually provide the arguments to you executable. Just the textFileName. Try:
set status [catch {exec $myExecutable -option1 -option2 $txtFileName} output]
or if you prefer to keep the arguments in a list:
set status [catch {exec $myExecutable {*}$arguments} output]
where the {*} syntax will cause the list to be expanded in place. In Tcl versions before this was added (8.5) you would use:
set status [catch {eval exec [list $myExecutable] $arguments} output]
where the eval command unwraps the lists so that exec sees a single set of arguments. Adding the extra [list] statement around your $myExecutable protects it's contents against being treated as a list by the interpreter pass.