Search and Split the found Text - tcl

I'm trying to find a place from the input text and set the number after the = as a variable. Unfortunately, what is wrong output
With my code, the maxresults variable returns "i" as the result. But it should be 20.
Code:
bind pub "-|-" !a pub:a
proc pub:a { nick host handle channel text } {
set maxresults ""
if {[regexp -nocase {max=} $text]} {
set maxresults0 [lindex [split $text max=] 1]
set maxresults [lindex $maxresults0 0]
putnow "PRIVMSG $channel :maxresults: $maxresults"
}
}
Input:
!a Remix find now country=german max=20 currency=euro
Output:
maxresults: i
but it should be:
maxresults: 20

You can do the whole job with regexp -
if {[regexp -nocase {max=(\d+)} $text - maxresults]} {
putnow "PRIVMSG $channel :maxresults: $maxresults"
}
See the documentation at http://www.tcl-lang.org/man/tcl8.6/TclCmd/regexp.htm

Related

how to lsearch in list always match

I want match search from a list. I have dir names example:
blabla.aa
cc.oiwerwer
asfd.Dd.asoiwer
and I want to check if it is in the list (upper case should be ignored).
bind pub "-|-" !tt tt
proc tt {nick host handle channel arg} {
set name [lindex [split $arg] 0]
set groups {aa BB Cc DD Ee Ff gg hh}
if {[lsearch -inline $groups $name] != -1} {
putnow "PRIVMSG $channel :match name $name"
}
}
No matter what I write, it always says match...
Regards
If I understood correctly, you want to know if any element of the list groups matches the dir name examples. If that's so, then you should use a loop with string match:
bind pub "-|-" !tt tt
proc tt {nick host handle channel arg} {
set name [lindex [split $arg] 0]
set groups {aa BB Cc DD Ee Ff gg hh}
foreach group $groups {
if {[string match -nocase *$group* $name]} {
putnow "PRIVMSG $channel :$name matched $group"
break
}
}
}
codepad test
You specified the "-inline" parameter to lsearch. It returns the match or empty string. So, it is always doesn't equal to -1. Try to remove the "-inline" parameter. Also, probably you want to use the "-exact" parameter.
Reference: https://www.tcl.tk/man/tcl8.6/TclCmd/lsearch.htm
If you can arrange for your list of things to be all in one case (e.g., lower case) then you can use [string tolower] and the in operator to do the search. This is simpler than lsearch as it produces a clean binary result:
proc tt {nick host handle channel arg} {
set name [lindex [split $arg] 0]
set groups {aa bb cc dd ee ff gg hh}
if {[string tolower $name] in $groups} {
putnow "PRIVMSG $channel :match name $name"
}
}
Your question is a bit unclear, but piecing together some clues, you might want:
set channels {
blabla.aa
cc.oiwerwer
asfd.Dd.asoiwer
}
set groups {aa BB Cc DD Ee Ff gg hh}
foreach group $groups {
set idx [lsearch -nocase $channels "*$group*"]
if {$idx != -1} {
puts "$group -> [lindex $channels $idx]"
}
}
which outputs
aa -> blabla.aa
Cc -> cc.oiwerwer
DD -> asfd.Dd.asoiwer
Or, much more terse is:
lsearch -inline -all -nocase -regexp $channels [join $groups |]
blabla.aa cc.oiwerwer asfd.Dd.asoiwer

Regexp to save pattern match into variable

what is wrong with below code
if {[regexp "pattern" $line]} {
set match [lindex $line 1]
} else {
set match 0 }
i am trying to search a pattern (along with other patterns) in a large file which is repeated multiple times, once pattern matches i am storing into a variable 'match' else i need to print the same variable as 0, problem is that once pattern matches there is only one value printing continuously
for ex:
line1 v
line2 5
pattern 10
i am getting output as 0 and if else statement is not there output is 0, i tried using lsearch also but output is the same
updating the question:
File has following content -:
Line1: Start cmd here
Line2: Start list here
Line3: End list here
.
.
.
few lines
.
.
.
Line1: Regular cmd here
Line2: Regular list here
pattern: 10
Line3: End file here
set x {}
set y {}
set z {}
set f1 [open file r]
while {![eof $f1} {
gets $f1 f
if {[regexp "Line1:" $f]} {
set x [lindex $f 1]
}
if {[regexp "Line3:" $f]} {
set y [lindex $f 2]
}
if {[regexp "pattern:" $f]} {
set z [lindex $f 1]
} else {
set z 0
}
puts "$x $y $z"
}
close $f1
output should be:
Start list 0
Regular file 10
Did you check out the regexp options -all and, possibly, -inline?
set matches [regexp -all -inline $yourRegEx $line]
Update
As Donal pointed out, you need to treat the output of regexp -all -inline as a list:
set matches [regexp -all -inline $yourRegEx $line]
if {![llength $matches]} {
set matches 0
}
There is nothing obviously wrong with the code
if {[regexp "pattern" $line]} {
set match [lindex $line 1]
} else {
set match 0
}
and if the contents of line are {pattern 10} it does indeed set match to 10.
But there might be problems in the surrounding code, like the variable line not getting updated with new values for each line.
To read and search every line in a file ("myfile.txt" for this example):
set f [open myfile.txt]
while {[gets $f line] >= 0} {
if {[regexp "pattern" $line]} {
set match [lindex $line 1]
} else {
set match 0
}
if {$match != 0} {
break
}
}
close $f
In this code, once a match has been found, no more lines are read from the file. If one wants to find matches from several lines, each match can be added to a list.
Also, if "pattern" contains regex metacharacters, regexp pattern pattern will fail, like in
% set pattern abc
abc
% regexp $pattern $pattern
1
% set pattern ab*c
ab*c
% regexp $pattern $pattern
0

Redirecting the "parray" output to a file in tcl

I have an array in tcl.
For example:
set a(1) "First element"
set a(2) "second element"
parray a
parray a displays output as
a(1) = "First element"
a(2) = "second element"
Is it possible to redirect the parray output to a file?
The parray command can't be redirected. It's a simple-minded procedure that is too stupid to be redirected. But it's source code isn't very long; in fact, it's short enough that I'll just paste it here (it's under the Tcl license):
proc parray {a {pattern *}} {
upvar 1 $a array
if {![array exists array]} {
return -code error "\"$a\" isn't an array"
}
set maxl 0
set names [lsort [array names array $pattern]]
foreach name $names {
if {[string length $name] > $maxl} {
set maxl [string length $name]
}
}
set maxl [expr {$maxl + [string length $a] + 2}]
foreach name $names {
set nameString [format %s(%s) $a $name]
puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
}
}
Redirecting it (hint: change the stdout for something obtained from open … a, and don't forget to close it afterwards) should be a simple exercise.
This builds on the answers by Dinesh and Donal Fellows: You could adapt the code of parray automatically, like this:
auto_load parray
proc printArray {a {pattern *} {channel stdout}} \
[string map {stdout $channel} [info body parray]]
This gives you a new proc printArray with an optional channel argument.

Tcl: how to print one set

My file to be parsed is like this
Name : John
Pin : 5400
Age : 40
Place: Korea
Amount : 4000
Name : Peter
Pin : 6700
Age : 10
Place : Japan
Amount : 3600
My tcl code is
set start "Name"
set pn "Pin"
set ag "Age"
set ag_cutoff 15
set amnt "Amount"
foreach line [split $content "\n"] {
if {[regexp $start $line]} {
set count 1
set l1 $line
}
if {[regexp $pn $line] && $count ==1} {
set pin_val [lindex $line 2]
set l2 $line
}
if {[regexp $ag $line] && $count ==1} {
set ag [lindex $line 2]
if { $ag > $ag_cutoff} {
set rep_taken 1
set l3 $line
}
if {[regexp $amnt $line] && $count ==1 && $rep_taken == 1} {
set age_val [lindex $line 2]
puts $op1 "$ag $age_val "
puts $op2 "$l1\n$l2\n$l3\n"
}
This code is fine for plots.
However, I also want to o/p a file with complete set where $ag>$ag_cutoff.
Now with puts $op3 "$l1\n$l2\n$l3\n" ---> Able to print to a file. But how to print line Place which is not evaluated. Any better way to accomplish this.
Name : John
Pin : 5400
Age : 40
Place : Korea
Amount : 4000
It would be a lot simpler to let the parsing loop just create a dictionary (this replaces your code above):
set data {}
set count 0
foreach line [split $content \n] {
if {[lindex $line 0] eq "Name"} {
incr count
}
dict set data $count [lindex $line 0] [lindex $line 2]
}
This will blow up if the first line doesn't start with "Name", or if there is a missing blank between a colon and a word, and also if a value consists of several words. All of these are easy to fix.
Here, for instance, is an expanded version that takes care of the last two problems, should they occur:
set data {}
set count 0
foreach line [split $content \n] {
set keyword [string trimright [lindex $line 0] :]
set value [string trimleft [lrange $line 1 end] {: }]
if {$keyword eq "Name"} {
incr count
}
dict set data $count $keyword $value
}
When all records are stored, one can output selected records using dictionary iteration:
set ag_cutoff 15
dict for {count record} $data {
if {[dict get $record Age] > $ag_cutoff} {
dict for {k v} $record {
puts "$k : $v"
}
}
}
This also means that you can keep adding fields to the records, and the code will still work without change.
Precautions
If the data in content has empty lines at the beginning or end, or between some lines, these methods won't work. A simple way to guard against empty or blank lines at the beginning or the end is to replace
foreach line [split $content \n] {
with
foreach line [split [string trim $content] \n] {
If empty / blank lines may occur within the data, one can use this to skip them:
foreach line [split $content \n] {
if {[string is space $line]} continue
If one is 100% sure that all data is in proper list form, it is possible (but a bit code-smelly) to use list commands like lindex on it directly. If one is less sure, or if one wants to be more correct, one should convert each line to a list before working on it:
foreach line [split $content \n] {
set line [split $line]
Documentation: dict, foreach, if, incr, lindex, lrange, puts, set, split, string

TCL Program that Compare String

I'm trying to create a program that the First and last characters are compared, Second and second to the last are compared, Third and third to the last are compared, and so on, and if any of these characters match, the two will be converted to the uppercase of that character.
Example:
Please enter a text: Hello Philippines
finals: HEllo PhIlippinEs
I can't create any piece of code, I'm stuck with
puts "Please enter text:"
set myText [gets stdin]
string index $myText 4
Can someone help me please?
This procedure will also capitalize the first i in Phillipines because it's equidistant from the start and the end of the string.
proc compare_chars {str} {
set letters [split $str ""]
for {set i [expr {[llength $letters] / 2}]} {$i >= 0} {incr i -1} {
set a [lindex $letters $i]
set b [lindex $letters end-$i]
if {$a eq $b} {
lset letters $i [set L [string toupper $a]]
lset letters end-$i $L
}
}
join $letters ""
}
puts [compare_chars "Hello Phillipines"]
# outputs => HEllo PhIllipinEs
The simplest way to code this is to use foreach over the split-up characters. (It's formally not the most efficient, but it's very easy to code correctly.)
puts "Please enter text:"
set myText [gets stdin]
set chars [split $myText ""]
set idx 0
foreach a $chars b [lreverse $chars] {
if {[string equals -nocase $a $b]} {
lset chars $idx [string toupper $a]
}
incr idx
}
set output [join $chars ""]
puts $output
Note that the foreach is iterating over a copy of the list; there are no problems with concurrent modification. In fact, the only vaguely-tricky part from a coding perspective is actually that we need to keep track of the index to modify, in the idx variable above.
With Tcl 8.6 you could write:
set chars [split $myText ""]
set output [join [lmap a $chars b [lreverse $chars] {
expr {[string equals -nocase $a $b] ? [string toupper $a] : $a}
}] ""]
That does depend on having the new lmap command though.
If you're really stuck with 8.3 (it's unsupported and has been so for years, so you should be prioritizing upgrading to something more recent) then try this:
set chars [split $myText ""]
set idx [llength $chars]
set output {}
foreach ch $chars {
if {[string equals -nocase $ch [lindex $chars [incr idx -1]]]} {
append output [string toupper $ch]
} else {
append output [string tolower $ch]
}
}
All the features this uses were present in 8.3 (though some were considerably slower than in later versions).