file1.txt
dut1Loop1Net = [::ip::contract [::ip::prefix 1.1.1.1/24]]/24
My script is
set in [open file1.txt r]
set line [gets $in]
if {[string trim [string range $line1 0 0]] != "#"} {
set devicePort [string trim [lindex $line1 0]]
set mark [expr [string first "=" $line1] + 1]
set val [string trim [string range $line1 $mark end]]
global [set t $devicePort]
set [set t $devicePort] $val
}
close $in
Problem
I am getting output as
% set dut1Loop1Net
[::ip::contract [::ip::prefix 1.1.1.1/24]]/24
Here i am getting the string without evaluating.
I am expecting the output as 1.1.1.0/24. Because TCL does not evaluate code here, it is printing like a string.
I am interesting to know how TCL stores the data and in which form it will retreive the data.
How Tcl stores values.
The short story:
Everything is a string
The long strory
Tcl stores the data in the last used datatype, calculate the string representation only when nessecary, uses copy on write, a simple refcount memory managment.
The answer how you evaluate it is with eval or subst. In your case probably subst.
Edit:
If your config file looks like this:
# This is a comment
variable = value
othervar = [doStuff]
you can use some tricks to get Tcl parsing it for you:
rename ::unknown ::_confp_unknown_orig
proc unknown args {
if {[llength $args] == 3 && [lindex $args 1] eq "="} {
# varname = value
uplevel 1 [list set [lindex $args 0] [lindex $args 2]
return [lindex $args 2]
}
# otherwise fallback to the original unknown
uplevel 1 [linsert $args 0 ::_confp_unknown_orig]
# if you are on 8.6, replace the line above with
# tailcall ::_confp_unknown_orig {*}$args
}
# Now just source the file:
source file1.txt
# cleanup - if you like
rename ::unknown {}
rename ::_confp_unknown_orig ::unknown
An other way to do that is to use a safe interp, but in this case using your main interp looks fine.
The problem is that the code you store inside val is never executed.
You access it using $val, but this way you get the code itself, and not the result of its execution.
To solve it, you must be sure [::ip::contract [::ip::prefix 1.1.1.1/24]]/24 is executed, and you can do that by replacing this line
set val [string trim [string range $line1 $mark end]]
with this one
eval "set val [string trim [string range $line1 $mark end]]"
Why? Here's my simple explaination:
The parser sees the "..." part, so it performs substitutions inside it
The first substitution is the execution of the string range $line1 $mark end command
The second substitution is the execution of the string trim ... command
So, when substitutions are complete and the eval command is ready to run, its like your line has become
eval {set val [::ip::contract [::ip::prefix 1.1.1.1/24]]/24}
Now the eval command is executed, it calls recursively the interpreter, so the string set val [::ip::contract [::ip::prefix 1.1.1.1/24]]/24 goes to another substitution phase, which finally runs what you want and puts the string 1.1.1/24 into the variable val.
I hope this helps.
Related
I have a string like this : abc0__remote_contr_major_abc__remote_hjk_klo_hcf_uio__apple_b_0_t_boo_dfs
I need to extract apple followed by everything until t_ and use that as a variable.
for example; if the string goes through the code, I am expecting apple_b_0_t as my output. I tried split and lindex but didnt work out.
set s "abc0__remote_contr_major_abc__remote_hjk_klo_hcf_uio__apple_b_0_t_boo_dfs"
set prefix [split $s "__"]
set c [lindex $prefix 4]
So ended up doing this and it worked but I am wondering if there is a easier/generic solution
set prefix [join [lrange [split $tile_dfx_fclk "__"] 12 15] _]
I'd use a regex:
set s abc0__remote_contr_major_abc__remote_hjk_klo_hcf_uio__apple_b_0_t_boo_dfS
regexp {.*__(.*t)_.*} $s _ t
puts $t ;# => apple_b_0_t
The problem with split $s "__" is that the 2nd argument to split is not a substring: it's a set of characters, so it's just the same as split $s "_"
tcllib has a textutil::split package containing a splitx proc that splits a string on a regular expression
package require textutil::split
namespace import textutil::split::splitx
set last [lindex [splitx $s "__"] end] ;# => apple_b_0_t_boo_dfS
# and then
set wanted [regsub {[^t]*$} $last ""] ;# => apple_b_0_t
Another approach is to find the last place that __ occurs in the string:
set idx [string last "__" $s] ;# => 52
# and then
set last [string range $s $idx+2 end] ;# => apple_b_0_t_boo_dfS
This could also be done:
set s "abc0__remote_contr_major_abc__remote_hjk_klo_hcf_uio__apple_b_0_t_boo_dfs"
set c [string range $s [string first "apple_" $s] [string last "t_" $s]]
puts $c
-> apple_b_0_t
I have a file like this:
set position {0.50 0.50}
set visibility false
set text {ID: {entity.id}\n Value: {entity.contour_val}}
And I want to do something similar to source, but I want to use a file handle only.
My current attempt looks like this:
proc readArray {fileHandle arrayName} {
upvar $arrayName arr
set cl 0
while {! [eof $fileHandle]} {
set cl [expr "$cl + 1"]
set line [gets $fileHandle]
if [$line eq {}] continue
puts $line
namespace eval ::__esg_priv "
uplevel 1 {*}$line
"
info vars ::__esg_priv::*
foreach varPath [info vars ::__esg_priv::*] {
set varName [string map { ::__esg_priv:: "" } $varPath]
puts "Setting arr($varName) -> [set $varPath]"
set arr($varName) [set $varPath]
}
namespace delete __esg_priv
}
puts "$cl number of lines read"
}
In place of uplevel I tried many combinations of eval and quoting.
My problem is, it either fails on the lines with lists or it does not actuall set the variables.
What is the right way to do it, if the executed commands are expected to be any valid code.
An extra question would be how to properly apply error checking, which I haven't tried yet.
After a call to
readArray [open "myFile.tcl" r] arr
I expect that
parray arr
issues something like:
arr(position) = 0.50 0.50
arr(text) = ID: {entity.id}\n Value: {entity.contour_val}
arr(visibility) = false
BTW: The last line contains internal {}, which are supposed to make it into the string variables. And there is no intent to make this a dict.
This code works, but there are still some problems with it:
proc readArray {fileHandle arrayName} {
upvar $arrayName arr
set cl 0
while {! [eof $fileHandle]} {
incr cl ;# !
set line [gets $fileHandle]
if {$line eq {}} continue ;# !
puts $line
namespace eval ::__esg_priv $line ;# !
foreach varPath [info vars ::__esg_priv::*] {
set varName [string map { ::__esg_priv:: "" } $varPath]
puts "Setting arr($varName) -> [set $varPath]"
set arr($varName) [set $varPath]
}
namespace delete __esg_priv
}
puts "$cl number of lines read"
}
I've taken out a couple of lines that didn't seem necessary, and changed some lines a bit.
You don't need set cl [expr "$cl + 1"]: incr cl will do.
if [$line eq {}] continue will fail because the [...] is a command substitution. if {$line eq {}} continue (braces instead of brackets) does what you intend.
Unless you are accessing variables in another scope, you won't need uplevel. namespace eval ::__esg_priv $line will evaluate one line in the designated namespace.
I didn't change the following, but maybe you should:
set varName [string map { ::__esg_priv:: "" } $varPath] works as intended, but set varName [namespace tail $varPath] is cleaner.
Be aware that if there exists a global variable with the same name as one of the variables in your file, no namespace variable will be created; the global variable will be updated instead.
If you intend to use the value in the text variable as a dictionary, you need to remove either the \n or the braces.
According to your question title, you want to evaluate the file line by line. If that requirement can be lifted, your code could be simplified by reading the whole script in one operation and then evaluating it with a single namespace eval.
ETA
This solution is a lot more robust in that it reads the script in a sandbox (always a good idea when writing code that will execute arbitrary external code) and redefines (within that sandbox) the set command to create members in your array instead of regular variables.
proc readArray {fileHandle arrayName} {
upvar 1 $arrayName arr
set int [interp create -safe]
$int alias set apply {{name value} {
uplevel 1 [list set arr($name) $value]
}}
$int eval [read $fileHandle]
interp delete $int
}
To make it even more safe against unexpected interaction with global variables etc, look at the interp package in the Tcllib. It lets you create an interpreter that is completely empty.
Documentation: apply, continue, eof, foreach, gets, if, incr, info, interp package, interp, list, namespace, proc, puts, set, string, uplevel, upvar, while
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 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]]
I have a file in here which has multiple set statements. However I want to extract the lines of my interest. Can the following code help
set in [open filename r]
seek $in 0 start
while{ [gets $in line ] != -1} {
regexp (line to be extracted)
}
Other solution:
Instead of using gets I prefer using read function to read the whole contents of the file and then process those line by line. So we are in complete control of operation on file by having it as list of lines
set fileName [lindex $argv 0]
catch {set fptr [open $fileName r]} ;
set contents [read -nonewline $fptr] ;#Read the file contents
close $fptr ;#Close the file since it has been read now
set splitCont [split $contents "\n"] ;#Split the files contents on new line
foreach ele $splitCont {
if {[regexp {^set +(\S+) +(.*)} $ele -> name value]} {
puts "The name \"$name\" maps to the value \"$value\""
}
}
How to run this code:
say above code is saved in test.tcl
Then
tclsh test.tcl FileName
FileName is full path of file unless the file is in the same directory where the program is.
First, you don't need to seek to the beginning straight after opening a file for reading; that's where it starts.
Second, the pattern for reading a file is this:
set f [open $filename]
while {[gets $f line] > -1} {
# Process lines
if {[regexp {^set +(\S+) +(.*)} $line -> name value]} {
puts "The name \"$name\" maps to the value \"$value\""
}
}
close $f
OK, that's a very simple RE in the middle there (and for more complicated files you'll need several) but that's the general pattern. Note that, as usual for Tcl, the space after the while command word is important, as is the space between the while expression and the while body. For specific help with what RE to use for particular types of input data, ask further questions here on Stack Overflow.
Yet another solution:
as it looks like the source is a TCL script, create a new safe interpreter using interp which only has the set command exposed (and any others you need), hide all other commands and replace unknown to just skip anything unrecognised. source the input in this interpreter
Here is yet another solution: use the file scanning feature of Tclx. Please look up Tclx for more info. I like this solution for that you can have several scanmatch blocks.
package require Tclx
# Open a file, skip error checking for simplicity
set inputFile [open sample.tcl r]
# Scan the file
set scanHandle [scancontext create]
scanmatch $scanHandle {^\s*set} {
lassign $matchInfo(line) setCmd varName varValue; # parse the line
puts "$varName = $varValue"
}
scanfile $scanHandle $inputFile
close $inputFile
Yet another solution: use the grep command from the fileutil package:
package require fileutil
puts [lindex $argv 0]
set matchedLines [fileutil::grep {^\s*set} [lindex $argv 0]]
foreach line $matchedLines {
# Each line is in format: filename:line, for example
# sample.tcl:set foo bar
set varName [lindex $line 1]
set varValue [lindex $line 2]
puts "$varName = $varValue"
}
I've read your comments so far, and if I understand you correctly your input data file has 6 (or 9, depending which comment) data fields per line, separated by spaces. You want to use a regexp to parse them into 6 (or 9) arrays or lists, one per data field.
If so, I'd try something like this (using lists):
set f [open $filename]
while {[gets $f line] > -1} {
# Process lines
if {[regexp {(\S+) (\S+) (\S+) (\S+) (\S+) (\S+)} $line -> name source drain gate bulk inst]} {
lappend nameL $name
lappend sourceL $source
lappend drainL $drain
lappend gateL $gate
lappend bulkL $bulk
lappend instL $inst
}
}
close $f
Now you should have a set of 6 lists, one per field, with one entry in the list for each item in your input file. To access the i-th name, for example, you grab $nameL[$i].
If (as I suspect) your main goal is to get the parameters of the device whose name is "foo", you'd use a structure like this:
set name "foo"
set i [lsearch $nameL $name]
if {$i != -1} {
set source $sourceL[$i]
} else {
puts "item $name not found."
set source ''
# or set to 0, or whatever "not found" marker you like
}
set File [ open $fileName r ]
while { [ gets $File line ] >= 0 } {
regex {(set) ([a-zA-Z0-0]+) (.*)} $line str1 str2 str3 str4
#str2 contains "set";
#str3 contains variable to be set;
#str4 contains the value to be set;
close $File
}