Write a procedures in TCL with dynamic variable - tcl

I am new to TCL and was trying to write a TCL procedure which take dynamic value.
Like I want to pass n number of interface and vlan pair to the proc.
proc proc_data {device, intf_in, intf_out, args} {
foreach vlan $args {
set inter_vlan [$device exec "show interface $intf_in $vlan"]
set inter_vlan [$device exec "show interface $intf_out $vlan"]
....
}
}
Is there any way I can pass :
{ device [interface vlan] <<<<< dynamic no of pair

It depends on how you want to map the arguments, but the key commands are likely to be foreach and lassign.
The foreach command can consume several values each time through the loop. Here's a simple example:
proc foreachmultidemo {args} {
foreach {a b} $args {
puts "a=$a, b=$b, a+b=[expr {$a+$b}]"
}
}
foreachmultidemo 1 2 3 4 5 6
You can also iterate over two lists at once (and yes, this mixes with the multi-variable form if you want):
proc foreachdoubledemo {list1 list2} {
foreach a $list1 b $list2 {
puts "a=$a, b=$b, a+b=[expr {$a+$b}]"
}
}
foreachdoubledemo {1 2 3} {4 5 6}
The lassign command can take a list and split it into variables. Here's a simple example:
proc lassigndemo {mylist} {
foreach pair $mylist {
lassign $pair a b
puts "a=$a, b=$b, a+b=[expr {$a+$b}]"
}
}
lassigndemo {{1 2} {3 4} {5 6}}
I'm not quite sure how to make these do what you're after, but it is bound to be one or the other, possibly in a mix.

Thanks #Donal Fellows
Posting the code I was looking for:
proc data_proc {device intr vlan} {
puts "Logged in device is: $device"
foreach a $intr {
set interface [$device "show interface $a"
foreach b $vlan {
set inter_vlan [$device "show interface $a vlan $b"
}
}
}
data_proc device {interface1 interface2 ...} {vlan1 vlan2 ...}

the answer you have posted is not very efficient. The logic you have used will check all the interfaces one by one and check all the vlans for each interface.
What if you need to check a particular vlan set instead of all the vlans for a few interfaces?

Related

Namespaces and procedures and scope inside namespaces

I'm trying to make a "safe" method of generating request ids for web sockets (just a desktop app not a real server) and want each socket to have its own id generator. All I'm doing is generating ids and recycling them after the request completes, such that the id doesn't grow unlimited throughout a user's session. I used an example concerning closures for a counter in JavaScript from David Flanagan's book and all seems to work well in Tcl but I'd greatly appreciate any advice on how to do this correctly and how I can test that these variables cannot be altered by the main program apart from calling one of the procedures within the namespaces. For example, is it possible to modify the gap list under the WEBS::$sock from the global namespace with [meant without] calling one of the procedures? Thank you.
Also, is there any difference between declaring namespace eval WEBS {} outside proc. ReqIdGenerator and using namespace eval WEBS::$sock inside the procedure? I can see that the results are the same for my little tests but wondered if there was any differences otherwise.
As an aside, in JS using the push and pop methods of arrays, it seems easier to recycle ids on a last-in-first-out basis; but using Tcl lists, it seems easier to use a first-in-first-out basis because using lassign with one variable assigns index 0 to the variable and returns the remaining elements as a new list. The equivalent of array.pop() seems to require more steps. Is that a correct observation? Thank you.
WARNING:
There is an error in this code in that the namespace references $sock and it works only because it is a global variable. If it were not global, the code would throw and error. The best I could find thus far is in this question.
proc ReqIdGenerator {sock} {
namespace eval WEBS {
namespace eval $sock {
variable max 0
variable gap {}
variable open {}
variable sock $sock
proc getId {} {
variable max
variable gap
variable open
if { [llength $gap] > 0 } {
set gap [lassign $gap id]
lappend open $id
return $id
} else {
lappend open [set id [incr max]]
return $id
}
chan puts stdout "Error in getId"
return -1
}
proc delId {id} {
variable max
variable gap
variable open
if { [set i [lsearch $open $id]] == -1 } {
return 1
} elseif { [llength $open] == 1 } {
reset
} else {
lappend gap [lindex $open $i]
set open [lreplace $open $i $i]
}
return 0
}
proc reset {} {
variable max 0
variable gap {}
variable open {}
}
proc getState {{prop "all"}} {
variable max
variable gap
variable open
variable sock
if { $prop eq "all" } {
return [list $max $gap $open]
} elseif { $prop eq "text" } {
return "State of socket $sock: max: $max; gap: $gap; open: $open"
} else {
return [set $prop]
}
}
}
}
}
set sock 123
ReqIdGenerator $sock
set sock 456
ReqIdGenerator $sock
# Add ids 1 through 10 to both sockets
for {set i 0} {$i<10} {incr i} {
WEBS::123::getId
WEBS::${sock}::getId
}
# Delete even ids from socket 456
for {set i 2 } {$i<11} {incr i 2} {
WEBS::${sock}::delId $i
}
# Delete odd ids from socket 123
for {set i 1 } {$i<10} {incr i 2} {
WEBS::123::delId $i
}
chan puts stdout [WEBS::123::getState text]
# => State of socket 123: max: 10; gap: 1 3 5 7 9; open: 2 4 6 8 10
chan puts stdout [WEBS::456::getState text]
# => State of socket 456: max: 10; gap: 2 4 6 8 10; open: 1 3 5 7 9
Lots of questions to unpack here.
how I can test that these variables cannot be altered by the main program apart from calling one of the procedures within the namespaces
You can't. There are no access controls within an interpreter. You can have multiple interpreters and there are strong access controls between them, but that's pretty heavyweight. However, it's conventional to not go rummaging around in a namespace that you don't own to peek at things you've not formally been told about on the grounds that they're liable to be changed at any moment without any sort of notification to you (usually not at runtime, but no guarantees!).
A phrase I've seen used in the community is "If you break it, you get to keep all the pieces".
For example, is it possible to modify the gap list under the WEBS::$sock from the global namespace with calling one of the procedures?
I'm sure it is. Finding it might be tricky, but once you have the name you can change it.
is there any difference between declaring namespace eval WEBS {} outside proc. ReqIdGenerator and using namespace eval WEBS::$sock inside the procedure?
There, assuming you handle the possible differences in name resolution scope of the name of the namespace itself. (That doesn't matter for fully qualified names — names beginning with :: — but relative names might resolve differently.)
The equivalent of array.pop() seems to require more steps. Is that a correct observation?
Yes. 8.7 adds lpop to address this weakness.
Your code appears to be reinventing objects. Use TclOO (or one of the other major object systems such as [incr Tcl] or XOTcl) for that; it's better at the job.
oo::class create ReqIdGenerator {
variable max gap open sock
constructor {sock} {
set max 0
set gap {}
set open {}
set [my varname sock] $sock; # messy because formal parameter
}
method getId {} {
if { [llength $gap] > 0 } {
set gap [lassign $gap id]
lappend open $id
return $id
} else {
lappend open [set id [incr max]]
return $id
}
chan puts stdout "Error in getId"
return -1
}
method delId {id} {
if { [set i [lsearch $open $id]] == -1 } {
return 1
} elseif { [llength $open] == 1 } {
my reset
} else {
lappend gap [lindex $open $i]
set open [lreplace $open $i $i]
}
return 0
}
method reset {} {
set max 0
set gap {}
set open {}
}
method getState {{prop "all"}} {
if { $prop eq "all" } {
return [list $max $gap $open]
} elseif { $prop eq "text" } {
return "State of socket $sock: max: $max; gap: $gap; open: $open"
} else {
return [set [my varname $prop]]
}
}
}
set sock 123
set s1 [ReqIdGenerator new $sock]
set sock 456
set s2 [ReqIdGenerator new $sock]
# Add ids 1 through 10 to both sockets
for {set i 0} {$i<10} {incr i} {
$s1 getId
$s2 getId
}
# Etc.

Is there a workaround to pass variable number of arguments without using args

Here is the code:
>cat /tmp/test_args.tcl
proc t1 {args} {
return $args
}
proc t2 {args} {
puts "t2:[llength $args]"
return
set len [llength $args]
if {$len == 1} {
proc_len_1 [lindex $args 0]
} elseif {$len == 2} {
proc_len_2 [lindex $args 0] [lindex $args 1]
} else {
proc_len_x $args
}
}
set tup3 [t1 1 2 3 4 5 6]
puts "before calling t2:[llength $tup3]"
t2 $tup3
t2 100
t2 100 200
Here is the output:
>tclsh /tmp/test_args.tcl
before calling t2:6
t2:1
t2:1
t2:2
I am using TCL 8.6.
You can see that before calling t2, $tup3 is a list, but proc t2 receives $tup3 as one single value, so instead of a list of values, proc t2 receives a list of list of values.
But the intention of proc t2, as see in the code after "return", is to deal with various number of arguments and based on the number of arguments it does different things. Now, calling t2 with a list variable and with a literal are treated same. This is the problem.
The only solution I can think of is, change
t2 $tup3
to
t2 {*}$tup3
But I have a restriction: $tup3 needs to stay same when it is passed to different proc. E.g. I can have such proc which also expects $tup3:
proc t3 {arg1} {
}
t3 $tup3
So ideally if somehow I can make it that "args" does not wrap values into a list, then my problem is solved. Well, I know this is how TCL works.
Maybe I already answered my own question, or I do not know what the I am looking for. If you see indeed there is a solution, please let me know.
Thanks.
If you want to pass a list around, simply accept it as an argument:
proc a { mylist } {
b $mylist
}
proc b { mylist } {
foreach {k} $mylist {
puts $k
}
}
set tup3 [t1 1 2 3 4 5 6]
a $tup3
Edit:
For a variable number of arguments, using command line processing is easiest.
proc a { args } {
array set arguments $args
if { [info exists arguments(-tup3)] } {
puts "tup3: $arguments(-tup3)"
}
if { [info exists arguments(-tup1)] } {
puts "tup1: $arguments(-tup1)"
}
parray arguments
}
set tup3 [list 1 2 3 4 5 6]
a -tup1 test1 -tup3 $tup3 -tup2 test2
Tcl, by design, makes it very difficult for a procedure (or C-defined command) to examine the syntax of how it was called. It's totally deliberate that it is that way, as it makes it massively easier to compose commands arbitrarily. Commands that need to care especially about the syntax of how they're called are recommended to perform an extra step to process their argument, with appropriate calls to do things in the environment of the caller (trivial in C, slightly trickier in Tcl procedures because of the extra stack frame).
proc example inputString {
# Parse the string and work out what we want to do
if {[regexp {^\$(\w+)$} $inputString -> varName]} {
upvar 1 $varName value
} else {
set value $inputString
}
# Do something with the result
puts "my input string was '$inputString'"
puts "my value is '$value'"
catch {
puts "its length is [llength $value]"
}
}
example {foo bar boo}
set x 123
example {$x}
This prints:
my input string was 'foo bar boo'
my value is 'foo bar boo'
its length is 3
my input string was '$x'
my value is '123'
its length is 1
You can get the calling syntax inside your procedure, but this is highly unrecommended except for debugging as it tends to produce information that is usually annoying to process. Here's how you get it:
proc example inputString {
puts "I was called as: [dict get [info frame -1] cmd]"
}
# To show why this can be awkward, be aware that you get to see *all* the details...
example {foo bar boo}
example "quick brown fox"
example [expr {1 + sqrt(rand())}]
set x 123
example $x
Which prints:
I was called as: example {foo bar boo}
I was called as: example "quick brown fox"
I was called as: example [expr {1 + sqrt(rand())}]
I was called as: example $x
The first approach above, passing in a literal that you parse yourself (with appropriate help from Tcl as required) is considered to be good Tcl style. Embedding a language inside Tcl (which can be Tcl itself, or some other language; people have shown this working with embedded C and Fortran, and there's no reason to expect any other language to be a big problem, though getting useful evaluation semantics can sometimes be… tricky) is absolutely fine.

How to reference a variable within a proc in another proc

I have a proc that evaluates an expr and appends to a particular list locally
proc a {} {
set mylist ""
set out [expr...
lappend mylist $out
}
I want to use the "mylist" list outside of the "a" proc without declaring it as global or without returning that list from within the proc using "return mylist". How do I go about doing that. I have two use cases, Use the variable within another proc:
proc b {} {
do something with the "mylist" from proc a
}
Use case 2 :
Just use it outside the proc [Not within another proc]
The "mylist" variable only exists as long as proc a is being executed. Whenever a proc finishes, all its local variables are cleaned up.
As long as a is in progress, you can access its variables using the upvar command.
For example: if you call b from a, b can access "mylist" using:
upvar 1 mylist othervar
puts $othervar
However, it is usually better practice to pass the variable (or at least its name) between procs, or make it a global or namespace variable.
Reference: https://www.tcl-lang.org/man/tcl/TclCmd/upvar.htm
Sample code snippet:
proc foo {ref_var} {
upvar $ref_var local_var
# do some operatins
lappend local_var 20
}
proc bar {} {
set a [list 10]
puts "Before: $a"
foo a
puts "After: $a"
}
# nested proc
bar
# without proc
set c [list 30]
puts "Initial: $c"
foo c
puts "Final: $c"
Output:
Before: 10
After: 10 20
Initial: 30
Final: 30 20

Set 2 default variables in a tcl procedure

When defining a procedure in tcl like the one below, How can I call the proc defining just a and c? Is there any way to do this?
proc test1 { a {b 2} {c 3} } {
puts "$a $b $c"
}
Here's one technique, a bit messier that what you're hoping for but not too messy:
proc test1 { args } {
# set the default values
array set values {b 2 c 3}
# todo: validate that $args is a list with an even number of items
# now merge in the args
array set values $args
# and do stuff with the values ...
parray values
}
test1 a 10 c 14
You sometimes see applications use this technique where the array keys have a leading dash, to look like options:
proc test1 args {
array set values {-b 2 -c 3}
array set values $args
parray values
}
test1 -a 10 -c 14
Thanks Glenn and Peter, I joined your posts and I got
proc test1 { a args } {
array set valores [list a $a -b 2 -c 3]
array set valores $args
puts "$valores(a) $valores(-b) $valores(-c)"
}
which solved what I wanted.
So now I can call
> proc 12 -c 8
> 12 2 8

TCL procedure call with optional parameters

There is a TCL script which has multiple procedure definitions with similar name func in different namespaces. Procedures look like this:
proc func {a} {
puts $a
}
All that kind of procedures have only one argument a . All that kind of procedures are called from one single line in whole script:
func $a
I need to create another procedure definition also with similar name func in other namespace. But that procedure will have two parameters. That procedure is also need to be called from the same line that other procedures with same name. Procedure looks like this:
proc func {a b} {
puts $a
puts $b
}
I need now to modify the line that calls all that procedures func $a so, that it can call all procedures with one parameter and new procedure which has two parameters. But procedures definitions with one parameter must not be changed. What line that calls all these procedures func $a should look like?
If you want an optional parameter, and you know what the optional value should be if not supplied, you do this:
proc func {a {b "the default"}} {
puts "a is $a"
puts "b is $b"
}
If you need to compute the default value at runtime, the simplest technique is a magic sentinel value that is very unlikely to occur in real input. Such as two ASCII NUL characters (== Unicode U+000000):
proc func {a {b "\u0000\u0000"}} {
if {$b eq "\u0000\u0000"} {
set b "default:$a"
}
puts "a is $a"
puts "b is $b"
}
Otherwise, you can use the magic args value to get the complete list of arguments and do all the work “by hand”:
proc func {a args} {
if {[llength $args] == 0} {
set b "the default..."
} elseif {[llength $args] == 1} {
set b [lindex $args 0]
} else {
error "bad number of arguments!"
}
puts "a is $a"
puts "b is $b"
}
If you're doing that, the info level introspector can help, but things can get complicated…
To call one of two implementations of a command depending on the number of arguments is rather unusual in Tcl code. You can do it providing neither implementation of the command is in the global namespace and you are not wanting the switching behaviour when calling from the namespaces containing the implementations in question.
What you do is you create a procedure in the global namespace (which every other namespace will look for commands in if not present locally) which then chains explicitly to the desired implementation. The main thing you need to enable this is some way of working out which implementation you want in a particular case (such as looking at the length of the argument list).
For Tcl 8.6, you can use tailcall for the chaining for maximum efficiency:
proc ::func args {
if {[llength $args] == 1} {
tailcall ::impl1::func {*}$args
} else {
tailcall ::impl2::func {*}$args
}
}
In Tcl 8.5 you'd write this instead (which is an optimised case in the interpreter):
proc ::func args {
if {[llength $args] == 1} {
return [uplevel 1 [list ::impl1::func {*}$args]]
} else {
return [uplevel 1 [list ::impl2::func {*}$args]]
}
}
In older Tcl versions, you'd use something like this (which is slower):
proc ::func args {
if {[llength $args] == 1} {
return [uplevel 1 ::impl1::func $args]
} else {
return [uplevel 1 ::impl2::func $args]
}
}
None of this is perfect at handling getting the right sort of error messages when you call with entirely the wrong number of arguments, especially if neither implementation formally has optional arguments. Determining that automatically is probably wholly impractical! You end up having to write extra boilerplate code (which is pretty obvious and works in all versions of Tcl in a straight-forward way):
proc ::func args {
if {[llength $args] == 1} {
tailcall ::impl1::func {*}$args
} elseif {[llength $args] == 2} {
tailcall ::impl2::func {*}$args
} else {
# Using the -errorcode is optional really
return -code error -errorcode {TCL WRONGARGS} \
"wrong # args: should be \"func a ?b?\""
}
}
I found the solution from that answer: https://stackoverflow.com/a/22933188/1601703 . We can get the number of argument that procedure accepts and make coresponding if statments that will use corresponding procedure call:
set num [llength [info args func]]
if {$num == 1} {
func $a
} elseif {$num == 2} {
func $a $b
}