how can set from qry .chanset ?
bind msg - .flag msg:flag
proc msg:flag {nick uhost handle text} {
if {$text == ""} {
putnow "PRIVMSG $nick :.flag #channel on/off"
return 0
}
set chan [lindex [split $text] 0]
set button [lindex [split $text] 1]
set flag [lindex [split $text] 2]
if { [string match -nocase "on" "$button"] } {
chanset $chan +$flag
}
if { [string match -nocase "off" "$button"] } {
chanset $chan -$flag
}
putserv "PRIVMSG $nick :Change Flag Successful."
}
error msg on partyline :
[18:12:50] Tcl error: invalid command name "chanset"
Related
I'm following the example from here
https://wiki.tcl-lang.org/page/Execute+in+Parallel+and+Wait
But when I run a simple code like this I get an error: child process exited abnormally and the error is "Error: Could not find or load main class
Caused by: java.lang.ClassNotFoundException:"
for {set i 0} {$i < 5} {incr i} {
set script {
puts hello
}
set chan [open |[list [info nameofexecutable] <<$script 2>#stderr]]
dict set res $chan command $script
fconfigure $chan -blocking 0
lappend background $chan
}
while 1 {
foreach chan $background {
if {[eof $chan]} {
fconfigure $chan -blocking 1
if {[set idx [lsearch -exact $background $chan]] >= 0} {
set background [lreplace $background $idx $idx]
}
catch [close $chan] cres copts
dict set res $chan result $cres
dict set res $chan options $copts
} else {
puts -nonewline [read $chan]
}
}
if {[llength $background] == 0} {
break
}
after 100
}
return $res
}
}
I get a similar message when trying to run parallel processes in a slightly different way by running this execute statement in a forloop
exec [info nameofexecutable] $variable_of_path_to_script << [list proc_name $param1 $param2] 2>#stderr
I am taking arguments from command line and passing all those arguments to another program (with expect spawn). I want to parse all options and omit some of them (or do something else). To do that I am doing this:
set arguments [lrange $argv 0 end]
#Check for -lp option. Set the program path
for {set var 0} {$var<$argc} {incr var} {
if {[lindex $arguments $var] == "-lp" || [lindex $arguments $var] == "--launcher-path"} {
if {[lindex $arguments [expr {$var+1}]] != ""} {
set program [lindex $arguments [expr {$var+1}]]
#unset [lindex $arguments $var]
} else {
puts "E: Argument missing for option: [lindex $arguments $var]"
exit 1
}
}
}
But I can't figure out how to unset those args that I used. For example, I need to unset [lindex $arguments [expr {$var+1}]] and [lindex $arguments $var].
This is how I am running the $program:
if {[catch {spawn $program --text {*}$arguments}]} {
puts "E: Launcher not found: $program"
exit 1
}
If your arguments are all key-value, then you can iterate over the arguments in pairs with foreach and build up a new list containing just the arguments you're interested in.
set newarguments [list]
foreach {arg value} $arguments {
switch -exact -- $arg {
"-lp" -
"--launcher-path" {
set program $value
}
default {
lappend newarguments $arg $value
}
}
}
If you have mixed flag and key-value options, then you will need to iterate using an index, similar to your code, but building up the new list of arguments will be roughly the same.
You could also check into the tcllib cmdline package, although that does not handle long options.
This is how I have done it:
set arguments [lreplace $arguments [expr {$var+1}] [expr {$var+1}]]
set arguments [lreplace $arguments $var $var]
As glenn-jackman pointed out, the above can be shortened to:
set arguments [lreplace $arguments $var [expr {$var+1}]]
I am new in scripting in TCL, I want to parse a txt file to create a list of patterns based on 2 strings as input.
My file looks like:
keyw1: data1
keyw1: data2
keyw1: Arg1
:
:
keyword: Pattern2Extract
{
some_lines
keyw1: Arg1
keyw2: patternP1
{
some_lines
}
keyw2: Arg2
{
some_lines
}
keyw2: patternP2
{
some_lines
}
.
.
some_others blocks of declaration between braces {}
.
.
}
keyword: Pattern2Extract
{
some_lines
keyw1: Arg1
keyw2: Arg2
{
some_lines
}
keyw2: patternP1
{
some_lines
}
keyw2: patternP2
{
some_lines
}
.
.
some_others blocks of declaration between braces {}
.
.
}
So, I would like to output 2 list of 'Pattern2Extract'
list1: if Arg1 is found in structure grouped between curly braces {}
list2: if arg1 and arg2 are both in structure grouped between curly braces {}
I have tried lsearch and lindex and it's working for list1 but I don't know how to do it for list2.
Here is my script:
proc inst_nm {inpFile outFile} {
set chanId [open $inpFile r]
set data [list]
while {[gets $chanId line] != -1} {
lappend data $line
}
close $chanId
foreach dt $data {
set MasDat [lindex $dt 0]
set pinDat [lindex $dt 1]
}
set intId [open "./filetoparse.txt" r]
set instDat [list]
while {[gets $intId line] != -1} {
lappend instDat $line
}
close $intId
set writeId [open $outFile a]
set MasterList [lreplace [lsearch -all $instDat *$MasDat*] 0 0]
foreach elem $MasterList {
set cellLn [lindex [split [lindex $instDat $elem ] ":"] 1]
set instName [lindex [split [lindex $instDat [expr $elem -5]] ":"] 1]
set PinLn [lindex [split [lindex $instDat [expr $elem +1]] ":"] 1]
foreach ele $PinLn {
if {"$ele"=="$pinDat" } {
puts $writeId "$instName $pinDat $cellLn"
} else {
puts $writeId "$instName $ele $cellLn"
}
}
}
close $writeId
}
inst_nm [lindex $::argv 0] [lindex $::argv 1]
Currently, inpFile may have many lines like $MastDat $pinDat and I need to collect instDat corresponding to each pair ($MastDat,$pinDat).
in file_to_parse by construction, we know that instName come in fifth line before $MastDat. However, we don't know the position of line conatining $pinDat declaration and this pattern could be present or not into instance section:
keyword: Pattern2Extract { some_lines keyw1: Arg1 keyw2: patternP1 { some_lines } keyw2: Arg2 { some_lines } keyw2: patternP2 { some_lines } . . some_others blocks of declaration between braces {} . . }
so, in list2 we should get all insName in where $pinDat is found
Thank you for your help
It helps to break out the code into another proc. In Tcl the proc must be declared ahead of when you call it. The data file didn't reflect your parser and also the MasterList might be removing the found item your looking for. Below is your parser broken up with example files that reflect what it's doing.
#!/usr/bin/tclsh
proc findPin {MasDat pinDat instDat} {
# set MasterList to the list of indexes found for *$MastDat*
set MasterList [lsearch -glob -all $instDat *$MasDat*]
set found [list]
# for each index number in MasterList
foreach elem $MasterList {
# n-5 (key: value(instName))
# n-4
# n-3
# n-2
# n-1
# n (key: value(cellLn)
# n+1 (key: value(PinLn)
set cellLn [lindex [split [lindex $instDat $elem ] ":"] 1]
set instName [lindex [split [lindex $instDat [expr $elem -5]] ":"] 1]
set PinLn [lindex [split [lindex $instDat [expr $elem +1]] ":"] 1]
foreach ele $PinLn {
if {"$ele"=="$pinDat" } {
lappend found "$instName $pinDat $cellLn"
}
}
}
return $found
}
proc inst_nm {inpFile outFile} {
# geta all lines in filestoparse.txt
set intId [open "./filetoparse.txt" r]
set instDat [list]
while {[gets $intId line] != -1} {
lappend instDat $line
}
close $intId
set writeId [open $outFile a]
# Search each line in inpFile
set chanId [open $inpFile r]
while {[gets $chanId line] != -1} {
set MasDat [lindex $line 0]
set pinDat [lindex $line 1]
foreach {item} [findPin $MasDat $pinDat $instDat] {
puts $writeId $item
}
}
close $chanId
close $writeId
}
inst_nm [lindex $::argv 0] [lindex $::argv 1]
filetoparse.txt
INST_NAME:MyInst
unknown-1
unknown-2
unknown-3
unknown-4
CELL_LN:MyCellLn
PIN_LN:pin1 pin2 pin3 pin4 pin5
unknown...
INST_NAME:TestInst
unknown-1
unknown-2
unknown-3
unknown-4
CELL_LN:TestCell
PIN_LN:test1 test2 test3
inputfile.txt
MyCellLn pin4
MyCellLn pin25
TestCell test1
TestCell test10
MyCellLn pin3
Output:
% ./keylist.tcl inputfile.txt keylist_found.txt
% cat keylist_found.txt
MyInst pin4 MyCellLn
TestInst test1 TestCell
MyInst pin3 MyCellLn
Actually, I'm interested just by printing '$instName' for each pair line from inpFile '$cellLn $pinDat'
filetoparse.txt:
INST_NAME:Inst1
{
4 unknown lines
CELL_LN: Cell1
other unkown lines
PIN_LN:pin1
unkown
PIN_LN:pin5
unknown...
}
INST_NAME:Inst2
{
4 unknown lines
CELL_LN: Cell1
other unkown lines
PIN_LN:pin3
unkown
PIN_LN:pin5
unknown...
}
INST_NAME:Inst3
{
4 unknown lines
CELL_LN: Cell2
other unkown lines
PIN_LN:pin2
unkown
PIN_LN:pin4
unknown...
}
INST_NAME:Inst4
{
4 unknown lines
CELL_LN: Cell2
other unkown lines
PIN_LN:pin5
unkown
PIN_LN:pin2
unknown...
}
inpFile.txt
cell1 pin1
cell2 pin2
So, I want in OutputFile have something like:
- for cell1 pin1:
list1: {Inst1 Inst2}
list2: {Inst1}
- for cell2 pin2:
list1: {Inst3 Inst4}
list2: {Inst3 Inst4}
Thank you for your help,
In TCL Scripting:
I have a file in that i know how to search a string but how to get the line number when string is found.please answer me if it is possible
or
set fd [open test.txt r]
while {![eof $fd]} {
set buffer [read $fd]
}
set lines [split $buffer "\n"]
if {[regexp "S1 Application Protocol" $lines]} {
puts "string found"
} else {puts "not found"}
#puts $lines
#set i 0
#while {[regexp -start 0 "S1 Application Protocol" $line``s]==0} {incr i
#puts $i
#}
#puts [llength $lines]
#puts [lsearch -exact $buffer S1]
#puts [lrange $lines 261 320]
in the above program i am getting the output as string found .if i will give the string other than in this file i am getting string not found.
The concept of 'a line' is just a convention that we layer on top of the stream of data that we get from a file. So if you want to work with line numbers then you have to calculate them yourself. The gets command documnetion contains the following example:
set chan [open "some.file.txt"]
set lineNumber 0
while {[gets $chan line] >= 0} {
puts "[incr lineNumber]: $line"
}
close $chan
So you just need to replace the puts statement with your code to find the pattern of text you want to find and when you find it the value of $line gives you the line number.
To copy text that lies between two other lines I'd use something like the following
set chan [open "some.file.txt"]
set out [open "output.file.txt" "w"]
set lineNumber 0
# Read until we find the start pattern
while {[gets $chan line] >= 0} {
incr lineNumber
if { [string match "startpattern" $line]} {
# Now read until we find the stop pattern
while {[gets $chan line] >= 0} {
incr lineNumber
if { [string match "stoppattern" $line] } {
close $out
break
} else {
puts $out $line
}
}
}
}
close $chan
The easiest way is to use the fileutil::grep command:
package require fileutil
# Search for ipsum from test.txt
foreach match [fileutil::grep "ipsum" test.txt] {
# Each match is file:line:text
set match [split $match ":"]
set lineNumber [lindex $match 1]
set lineText [lindex $match 2]
# do something with lineNumber and lineText
puts "$lineNumber - $lineText"
}
Update
I realized that if the line contains colon, then lineText is truncated at the third colon. So, instead of:
set lineText [lindex $match 2]
we need:
set lineText [join [lrange $match 2 end] ":"]
I'm looking for some Tcl code that would duplicate what puts command sends to stdout to some log file. Yes, there is a possibility to change all calls to puts to some custom function. But I would like to make it as transparent as possible.
I have this trial code, but it doesn't really work that well:
set pass_log_output "0"
rename puts _puts
proc puts { args } {
global pass_log_output
if {[info exists pass_log_output]} {
# There can be several cases:
# -nonewline parameter, stdout specified or not
set stdout_dest [ lsearch $args stdout ]
set nonewline [ lsearch $args -nonewline ]
if { $stdout_dest != -1 } {
log_low_level "" [lindex $args [expr $stdout_dest + 1]] ""
} elseif { $nonewline != -1 && [ llength $args ] > 1} {
log_low_level "" [lindex $args [expr $nonewline + 1]] ""
} else {
log_low_level "" [lindex $args 0] ""
}
}
if { [ catch { eval _puts $args } err ] } {
return -code error $err
}
}
log_low_level function just stores the passed string in a file.
So far I'm getting this error:
Tcl Interpreter Error: too many nested evaluations (infinite loop?)
Does log_low_level use puts? That could be your infinite loop.
If so, try changing it to use _puts.
Thanks for the points. I just want to post the final working code for reference. It even takes care of the storing lines with -nonewline flag properly.
set pass_log_output "0"
set last_call_nonewline 0
rename puts _orig_puts
proc puts { args } {
global pass_log_output
global g_log_file
global last_call_nonewline
if {[info exists pass_log_output]} {
# Check if the logging was initialized
if {![info exists g_log_file]} {
_orig_puts "Log file wasn't initialized!"
return
}
# There can be several cases:
# -nonewline parameter, stdout specified or not
set stdout_dest [ lsearch $args stdout ]
set nonewline [ lsearch $args -nonewline ]
if {[ llength $args ] > 3} {
return -code error "wrong # args: should be puts ?-nonewline? ?channelId? string"
} elseif { $stdout_dest != -1 } {
set message [lindex $args end]
} elseif { $nonewline != -1 && [ llength $args ] == 2} {
set message [lindex $args [expr $nonewline + 1]]
} elseif {[ llength $args ] == 1} {
set message [lindex $args 0]
}
# Store the message in the file, if needed.
# Take into account if the last call was with -nonewline
if {[info exists message]} {
if {$last_call_nonewline == 0} {
_orig_puts -nonewline $g_log_file [clock format [clock seconds] -format "%T - "]
}
if {$nonewline != -1} {
set last_call_nonewline 1
_orig_puts -nonewline $g_log_file "$message"
} else {
set last_call_nonewline 0
_orig_puts $g_log_file "$message"
}
flush $g_log_file
}
}
if { [ catch { eval _orig_puts $args } err ] } {
return -code error $err
}
}
Since puts has very few options, it may be easier to consider the number of args given. Also, you should contain all uses of the original _puts to your new puts proc -- this new puts should be transparent even to your code.
I assume you only want to log stuff you're writing to stdout
rename puts _orig_puts
proc puts {args} {
switch -exact [llength $args] {
3 {
# both -newline and a channelId are given
set do_log [expr {[lindex $args 1] eq "stdout"}]
}
2 {
# only log if not writing to stdout
set chan [lindex $args 0]
set do_log [expr {$chan eq "-nonewline" || $chan eq "stdout"}]
}
1 {
set do_log true
}
default {
error {wrong # args: should be "puts ?-nonewline? ?channelId? string"}
}
}
if {$do_log} {
set chan [open $::mylogfile a]
_orig_puts $chan [lindex $args end]
close $chan
}
_orig_puts {*}$args
}