TCL Expect: how to remove a trailing newline - tcl

I am executing this expect script:
#!/usr/bin/expect
#####config file content :: user1|server1
set lx [exec awk {-F|} {/server1/ {print $1}} config]
puts "Values is $lx of server1."
The output is:
Values is user1
of server1.
There is a trailing new line in $lx that i am unable to remove.
I have tried :
set x [string trimright $lx \n]
set x [string trimright $lx "\n"]
set x [string trim $lx \n]
But there is always a \n left on the end of $x. How can this newline be removed?

By default string trim will remove any whitespace-type characters from either end of the string, so you could just set x [string trim $lx].
I would be inclined to do the whole processing in Expect like this:
set x [string trim [lindex [split [read [open config]] | ] 0]]

Used :: regsub -all [\r\n] $lx "" lx to fix this.

The canonical way of fixing this is string trimright $variable "\r\n", since Expect doesn't hide the details of CR/NL processing from you (unlike normal Tcl I/O operations). This is intentional, of course — Expect is often used in situations where being able to see the real details of terminal handling is useful — but means you have to deal with it.

Related

How to match a string and print the next word afterthat?

Lets say i have the following script and have to look for .model and print the next two word before (. The following is the contents of the file that I need to read.
.model Q2N2222 NPN(Is=14.34f Xti=3 Eg=1.11 Vaf=74.03 Bf=255.9 Ne=1.307
Ise=14.34f Ikf=.2847 Xtb=1.5 Br=6.092 Nc=2 Isc=0 Ikr=0 Rc=1
+ Cjc=7.306p Mjc=.3416 Vjc=.75 Fc=.5 Cje=22.01p Mje=.377 Vje=.75
+ Tr=46.91n Tf=411.1p Itf=.6 Vtf=1.7 Xtf=3 Rb=10)
* National pid=19 case=TO18
* 88-09-07 bam creation
*$
.model Q2N3904 NPN(Is=6.734f Xti=3 Eg=1.11 Vaf=74.03 Bf=416.4 Ne=1.259
.model Q2N3906 PNP(Is=1.41f Xti=3 Eg=1.11 Vaf=18.7 Bf=180.7 Ne=1.5 Ise=0
Here is the code i have written so far. But i couldnt get any. Need the help
proc find_lib_parts {f_name} {
set value [string first ".lib" $f_name]
if {$value != -1} {
#open the file
set fid [ open $f_name "r"]
#read the fid and split it in to lines
set infos [split [read $fid] "\n"]
close $fid
set res {}
append res "MODEL FOUND:\n"
if {[llength $line] > 2 && [lindex $line 0] eq {model}} {
#lappend res [lindex $data 2] \n
lappend res [split $line "("]\n
}
if {[llength $line] > 2 && [lindex $line 0] eq {MODEL}} {
#lappend res [lindex $data 2] \n
lappend res [split $line "("]\n
}
}
return $res
In this case, a regular expression is by far the simplest way of doing such a search. Assuming the words are always on the same line, it's easy:
proc find_lib_parts {f_name} {
set fid [open $f_name]
set infos [split [read $fid] "\n"]
close $fid
set found {}
foreach line $infos {
if {[regexp {\.model\s+(\w+\s+\w+)\(} $line -> twoWords]} {
lappend found $twoWords
}
}
return $found
}
For your input data sample, that'll produce a result like this:
{Q2N2222 NPN} {Q2N3904 NPN} {Q2N3906 PNP}
If there's nothing to find, you'll get an empty list. (I assume you pass filenames correctly anyway, so I omitted that check.)
The regular expression, which should virtually always be enclosed in {braces} in Tcl, is this:
\.model\s+(\w+\s+\w+)\(
It's relatively simple. The pieces of it are:
\.model — literal “.model” (with an escape of the . because it is a RE metacharacter)
\s+ — some whitespace
( — start a capturing group (the bit we put into the twoWords variable)
\w+ — a “word”, one or more alphanumeric (or underscore) characters
\s+ — some whitespace
\w+ — a “word”, one or more alphanumeric (or underscore) characters
) — end of the capturing group
\( — literal “(”, escaped
The regexp command matches this, returning whether or not it matched (effectively boolean without the -all option, which we're not using here), and assigning the various groups to the variables named afterwards, -> for the whole matched string (yes, that's a legal variable name; I like to use it for regexp variables that dump info I don't want) and twoWords for the interesting substring.

regsub in Tcl to replace pattern with the empty string

I need some help in replacing a pattern in TCL.
set msg "<sytem>
<log>
<test>
<ggg>yyy</ggg>
</test>
</log>
</sytem>
one
two
three"
set res [regsub -all "<sytem(\>)+" $msg " " test]
puts $test
test should contain
one
two
three
I'm not quite sure what you're trying to remove here, but to strip out everything up to the last > in the string, you use this:
# Greedily matches everything up to the *last* ‘>’ and replaces it with the empty string
# No special quoting required; ‘>’ is not an RE metacharacter
set res [regsub {.*>} $msg ""]
Then you can normalize the result in various ways. This might be good enough, if what follows is some simple words:
set res [join $res "\n"]
Otherwise, you'd need to do this more complicated version:
set res [join [lmap [split [string trim $res] "\n"] x {string trim $x}] "\n"]
There are other ways of writing it too that are even trickier:
set res [regexp -inline -all -line {\S(?:.*\S)} $res]

How to remove a single letter/number

I have single letters and numbers in a variable that I would like to remove
example inputs:
USA-2019-1-aoiwer
USA-A-jowerasf
BB-a_owierlasdf-2019
flsfwer_5_2015-asfdlwer
desired outputs:
USA-2019--aoiwer
USA--jowerasf
BB-_owierlasdf-2019
flsfwer__2015-asfdlwer
my code:
bind pub "-|-" !aa proc:aa
proc proc:aa { nick host handle channel arg } {
set line [lindex $arg 0]
set line [string map {[a-z] """} $line]
set line [string map {[0-9] """} $line]
putnow "PRIVMSG $channel :$line"
}
Unfortunately that does not work and i have no other idea
Regards
string map would remove all the lowercase letters and numbers, if it worked. However, you also have unbalanced quotes, which causes a syntax error when the proc is resolving.
I would recommend using regsub. The hard part, however, would be to get a proper expression to do the task. I will suggest the following:
bind pub "-|-" !aa proc:aa
proc proc:aa { nick host handle channel arg } {
set line [lindex $arg 0]
regsub -nocase -all {([^a-z0-9]|\y)[a-z0-9]([^a-z0-9]|\y)} $line {\1\2} line
putnow "PRIVMSG $channel :$line"
}
Basically ([^a-z0-9]|\y) matches a character that is non alphanumeric, or a word boundary (which will match at the beginning of a sentence for example if it can, or at the end of a sentence), and stores it (this is the purpose of the parens).
The matched groups are stored in order starting with 1, so in the replace portion of regsub, I'm placing the parts that shouldn't be replaced back where they were.
The above should work fine.
You could technically go a little fancier with a slightly different expression:
regsub -nocase -all {([^a-z0-9]|\y)[a-z0-9](?![a-z0-9])} $line {\1} line
Which uses a negative lookahead ((?! ... )).
Anyway, if you do want to get more in depth, I recommend reading the manual on regular expression syntax

Regarding got to command in tcl

I want to print character from the next line:
say :
when this variable dum=183 exists in file , then print the very next charater from next line.
Note : I am using tcl
Thanks,
This should help you get started.
The typical idioms for working with a file one line at a time are:
1) linewise reading:
set f [open thefile.txt]
while {[gets $f line] >= 0} {
# work with the line of text in "line"
}
close $f
2) block reading with line splitting:
set f [open thefile.txt]
set text [read $f]
close $f
set lines [split [string trim $text] \n]
foreach line $lines {
# work with the line of text in "line"
}
This can be simplified by using a package:
package require fileutil
::fileutil::foreachLine line thefile.txt {
# work with the line of text in "line"
}
Another way is to search and extract using a regular expression. This is the worst method as it is inflexible and very likely to be buggy in use.
set f [open thefile.txt]
set text [read $f]
close $f
# this regular expression is an example
if {[regexp {\ydum\y[^\n]*.(.)} $text -> thecharacter]} {
# the character you wanted should be in "thecharacter"
}
Documentation:
>= (operator),
close,
fileutil (package),
foreach,
gets,
if,
open,
package,
read,
regexp,
set,
split,
string,
while,
Syntax of Tcl regular expressions

TCL String Manipulation and Extraction

I have a string xxxxxxx-s12345ab7_0_0_xx2.log and need to have an output like AB700_xx2 in TCL.
ab will be the delimiter and need to extract from ab to . (including ab) and also have to remove only the first two underscores.
Tried string trim, string trimleft and string trimright, but not much use. Is there anything like string split in TCL?
The first stage is to extract the basic relevant substring; the easiest way to do that is actually with a regular expression:
set inputString "xxxxxxx-s12345ab7_0_0_xx2.log"
if {![regexp {ab[^.]+} $inputString extracted]} {
error "didn't match!"
}
puts "got $extracted"
# ===> got ab7_0_0_xx2
Then, we want to get rid of those nasty underscores with string map:
set final [string map {"_" ""} $extracted]
puts "got $final"
# ===> ab700xx2
Hmm, not quite what we wanted! We wanted to keep the last underscore and to up-case the first part.
set pieces [split $extracted "_"]
set final [string toupper [join [lrange $pieces 0 2] ""]]_[join [lrange $pieces 3 end] "_"]
puts "got $final"
# ===> got AB700_xx2
(The split command divides a string up into “records” by an optional record specifier — which defaults to any whitespace character — that we can then manipulate easily with list operations. The join command does the reverse, but here I'm using an empty record specifier on one half which makes everything be concatenated. I think you can guess what the string toupper and lrange commands do…)
set a "xxxxxxx-s12345ab7_0_0_xx2.log"
set a [split $a ""]
set trig 0
set extract ""
for {set i 0} {$i < [llength $a]} {incr i} {
if {"ab" eq "[lindex $a $i][lindex $a [expr $i+1]]"} {
set trig 1
}
if {$trig == 1} {
append extract [lindex $a $i]
}
}
set extract "[string toupper [join [lrange [split [lindex [split $extract .] 0] _] 0 end-1] ""]]_[lindex [split [lindex [split $extract .] 0] _] end]"
puts $extract
Only regexp is enough to do the trick.
Set string "xxxxxxx-s12345ab7_0_0_xx2.log"
regexp {(ab)(.*)_(.*)_(.*)_(.*)\\.} $string -> s1 s2 s3 s4 s5
Set rstring "$s1$s2$s3$s4\_$s5"
Puts $rstring