How can I reference the same switch case command multiple times in TCL? - switch-statement

Here I want to use the exact same switch as I used above. $list contains a,b & c. I want to print Apple Ball & Cat accordingly. I want to use/reference this switch statement multiple times
switch $blk {
a {puts "Apple"}
b {puts "Ball"}
c {puts "Cat"}
default {puts "Nothing"}
}
foreach item $list {
// Here I want to use the exact same switch as I used above. $list contains a,b & c. I want to print Apple Ball & Cat accordingly. I want to use/reference this switch statement multiple times
}

One way is to put the code you want to re-use in a proc, e.g.
proc myswitch item {
switch $item {
a {puts "Apple"}
b {puts "Ball"}
c {puts "Cat"}
default {puts "Nothing"}
}
}
and then use it like:
myswitch $blk
foreach item $list {
myswitch $item
}

Another way is to share the script argument of the switch command:
set body {
a {puts "Apple"}
b {puts "Ball"}
c {puts "Cat"}
default {puts "Nothing"}
}
switch -- $blk $body
foreach item $list {
switch -- $item $body
}

Related

Tcl: constructing list with literal `$` in values

I'm trying to construct a (Tcl/)Tk command (to be associated with a widget's -command), that contains a variable that must be expanded at runtime.
In the original code this variable had a fixed name (so everything was simple and we used {...}):
Something like this:
proc addaction {widgid} {
$widgid add command -label "Action" -command {::actioncmd $::targetid}
}
addaction .pop1 # dynamic target is read from $::targetid
set ::targetid .foo ## now the action for the .pop1 widget targets .foo
set ::targetid .bar ## now the action for the .pop1 widget targets .bar
But now I would like to change this so we can replace the to-be-expanded variable with a fixed value in the "constructor".
The constraints are:
to keep the signature of addaction (therefore id must be optional)
not to touch ::actioncmd at all.
So I came up with something like this:
proc addaction {widgid {id $::targetid}} {
$widgid add command -label "Action" -command [list ::actioncmd $id]
}
addaction .pop1 # (as before)
addaction .pop2 .foo # static target for .pop2 is *always* .foo
Unfortunately my replacement code, doesn't work as the the $::targetid variable is no longer expanded. That is, if I trigger the widget's command I get:
$::targetid: no such object
Obviously the problem is with dynamically constructing a list that contains $args.
Or more likely: the subtle differences between lists and strings.
At least here's my test that shows that I cannot mimick {...} with [list ...]:
set a bar
set x {foo bar}
set y [list foo $a]
if { $x eq $y } {puts hooray} else {puts ouch}
# hooray, the two are equivalent, and both are 'foo bar'
set b {$bar}
set x {foo $bar}
set y [list foo $b]
if { $x eq $y } {puts hooray} else {puts ouch}
# ouch, the two are different, x is 'foo $bar' whereas y is 'foo {$bar}'
So: how can I construct a command foo $bar (with an expandable $bar) where $bar is expanded from a variable?
A naive solution could be:
proc addaction {widgid {id {}}} {
if { $id ne {} } {
set command [list ::actioncmd $id]
} else {
set command {::actioncmd $::targetid}
}
$widgid add command -label "Action" -command $command
}
But of course, in reality the addaction proc adds more actions than just a single one, and the code quickly becomes less readable (imo).
For cases such as yours, the easiest approach might be:
proc addaction {widgid {id $::targetid}} {
$widgid add command -label "Action" -command [list ::actioncmd [subst $id]]
}
That will be fine as long as those IDs are simple words (up to and including using spaces) but does require that you go in with the expectation that the value is being substituted (i.e., that $, [ and \ are special).
Alternatively, you could check how many arguments were passed and modify how the script is generated based on that:
# The value of the default doesn't actually matter
proc addaction {widgid {id $::targetid}} {
# How many argument words were passed? Includes the command name itself
if {[llength [info level 0]] == 2} {
# No extra argument; traditional code
$widgid add command -label "Action" -command {::actioncmd $::targetid}
} else {
# Extra argument: new style
$widgid add command -label "Action" -command [list ::actioncmd $id]]
}
}

Passing multiple variables from a Bash Script to an Expect Script

I've been trying to get an expect/bash script that can read each line of a CSV file and pull both the hostname address and the password; as these are all different for each MikroTik I am trying to access.
I've recently sent an auto.rsc file to several thousand MikroTik routers that are being used as a residential solution. This file filled up the HDD (it had an IP scan which created a log that managed to do the deed.) This prevents me from sending additional auto.rsc files to purge the logs as there is no available room.
The solution I came up with was to use an expect script to login to these and delete the auto.log file. This was successful with my RSA script.
set timeout 3
set f [open "dynuList.txt"]
set dynu [split [read $f] "\n"]
close $f
foreach dynu $dynu {
spawn ssh -o "StrictHostKeyChecking no" -i mtk4.key admin+t#$dynu
expect {
"> " { send "\:do \{ file remove push.auto.log \} on-error\=\{ \[\] \}\r" }
"Connection refused" { catch {exp_close}; exp_wait; continue }
eof { exp_wait; continue }
}
expect ".*"
close
wait
}
The script I am having issues with is as follows:
n=`wc -l hostPasswordDynuList.csv | awk '{print$1}'`
i=1
while [ $i -le $n ]
do
host='awk -F "," 'NR==$i {print $1}' hostPasswordDynuList.csv'
password='awk -F "," 'NR==$i {print $2}' hostPasswordDynuList.csv'
./removeLogExpect.sh $host $password
i=`expr $i + 1`
done
Which should pass variables to this expect script
#!/usr/bin/bash/expect -f
set timeout 3
set host [lindex $argv 0]
set password [lindex $argv 1]
spawn ssh -o "StrictHostKeyChecking no" admin+t#$host
expect {
"password: " { send $password"\r" }
"Connection refused" { catch {exp_close}; exp_wait; continue }
eof { exp_wait; continue }
}
expect {
".*" { send "\:do \{ file remove push.auto.log \} on-error\=\{ \[\] \}\r" }
}
expect ".*"
close
wait
I was hoping that the script would be able to connect to then login to each MikroTik that didn't have RSA keys setup and then the command to clear out the auto.log file. As it stands the script doesn't seem to be passing the variables to the expect half whatsoever. Any help would be appreciated.
expect is an extension of the Tcl language, which is a fully featured programming language: it can read files and parse comma separated fields. There's no need for an inefficient shell script to invoke your expect program multiple times
#!/usr/bin/bash/expect -f
set timeout 3
set file hostPasswordDynuList.csv
set fh [open $file r]
while {[gets $fh line] != -1} {
lassign [split $line ,] host password
spawn ssh -o "StrictHostKeyChecking no" admin+t#$host
expect {
"password: " { send $password"\r" }
"Connection refused" {
catch {exp_close}
exp_wait
continue
}
eof {
exp_wait
continue
}
}
expect ".*"
send ":do { file remove push.auto.log } on-error={ \[\] }\r"
expect ".*"
exp_close
exp_wait
}
close $fh
See https://tcl.tk/man/tcl8.6/TclCmd/contents.htm for documentation on Tcl's builtin commands.
The line expect ".*" is probably not doing what you think it does: the default pattern matching style is glob, so .* looks for a literal dot followed by any number of characters. You might be thinking of the regular expression "any character zero or more times" for which you would need to add the -re option.
However, the key to robust expect code is to expect more specific patterns.

Tcl Switch case error ,I need proper explanation for the error

Kindly help me detecting the error in the following code
proc strcmp { d1 d2 } {
set res [string compare $d1 $d2]
switch $res
0 {
puts "String is equal "
}
1 {
puts "$d1 > $d2"
} default {
puts "$d2 > $d1"
}
}
I get this error message when i try to execute in tcl 8.5
wrong # args: should be "switch ?switches? string pattern body ... ?default body?"
You have the "0" on a different line. Tcl treats newlines as command terminators. You're probably seeing an error like "0: no such command"
Use either line continuations
switch $res \
0 {
puts "String is equal "
} \
1 {
puts "$d1 > $d2"
} \
default {
puts "$d2 > $d1"
}
or enclosing brackets (good for readability)
switch $res {
0 {
puts "String is equal "
}
1 {
puts "$d1 > $d2"
}
default {
puts "$d2 > $d1"
}
}
Docs:
http://tcl.tk/man/tcl8.6/TclCmd/Tcl.htm (rules 1 and 9)
http://tcl.tk/man/tcl8.6/TclCmd/switch.htm
The exact error I got when I tried to run your code was:
bad option "-1": must be -exact, -glob, -regexp, or -- while executing
The Tcl docs for switch mention these commands: they tell the switch how to match the arguments. Adding -exact -- before $res at the start of the switch statement seems to make it work:
proc strcmp { d1 d2 } {
set res [string compare $d1 $d2]
switch -exact -- $res {
0 {
puts "String is equal "
}
1 {
puts "$d1 > $d2"
}
default {
puts "$d2 > $d1"
}
}
}
strcmp "world" "hello"
strcmp "hello" "hello"
strcmp "hello" "world"
(You could drop the -exact if you want, as it's the default – I only include it so you can see where to put in another option.)
This gives the following output (codepad example):
world > hello
String is equal
world > hello
so for some reason, -1 (the return code from string compare for the third example) is getting matched to 1 by the switch statement. I don't know enough Tcl to know why that might be the case – you could consider asking that as a different question.

Hiding STDIN echo after pressing Enter

I'm working on a message system that uses unix terminal, so to make message output more user friendly, I wanted to hide <STDIN> input after pressing enter button to use it in another message output.
my $user = "Someone";
my $message = <STDIN>; #must show what does user type but should hide the message after pressing enter
chomp $message;
print messagefile "<$user> $message\n";
I've read in forums that some method is using Term::ReadKey but unfortunately I'm not able to do that since that module does not present in the system.
Borrowed from answer. It reads one character at time, and when enter is pressed, it wipes current line with \r <spaces> \r
use strict;
use warnings;
sub get_pass {
local $| = 1;
my $ret = "";
while (1) {
my $got = getone();
last if $got eq "\n";
print $got;
$ret .= $got;
}
print "\r", " " x length($ret), "\r";
return $ret;
}
my $user = "Someone";
my $message = get_pass();
chomp $message;
print "<$user> $message\n";
BEGIN {
use POSIX qw(:termios_h);
my ($term, $oterm, $echo, $noecho, $fd_stdin);
$fd_stdin = fileno(STDIN);
$term = POSIX::Termios->new();
$term->getattr($fd_stdin);
$oterm = $term->getlflag();
$echo = ECHO | ECHOK | ICANON;
$noecho = $oterm & ~$echo;
sub cbreak {
$term->setlflag($noecho);
$term->setcc(VTIME, 1);
$term->setattr($fd_stdin, TCSANOW);
}
sub cooked {
$term->setlflag($oterm);
$term->setcc(VTIME, 0);
$term->setattr($fd_stdin, TCSANOW);
}
sub getone {
my $key = '';
cbreak();
sysread(STDIN, $key, 1);
cooked();
return $key;
}
}
END { cooked() }
From http://www.perlmonks.org/?node_id=33353
use autodie qw(:all);
print "login: ";
my $login = <>;
print "Password: ";
system('stty', '-echo'); # Disable echoing
my $password = <>;
system('stty', 'echo'); # Turn it back on

Providing a status update when "ENTER" is pressed, while program is working

I have a PERL script that loops through and calls a binary with a different argument. I am using IPC::Run. I would like when the user presses a key such as "ENTER" a status message is displayed such as
"Currently working on 14 of 28 total scripts (50% complete)"
My script is as follows:
foreach my $file (#files) {
$file =~ s/$file_dir//;
#Run the test case, store the output in $stdout
run [ "php", "PROGRAM.phar", "$file" ], ">", \my $stdout;
print LOG_FILE "Return code $?\n";
print LOG_FILE "Output: $stdout");
}
Basically how would I interrupt the binary in order to display my status message?
If I correct this usage of IPC::Run is not multithreaded. It will execute the commands one by one and it is not possible to print messages because there is only one process.
Like:
use Parallel::ForkManager;
$pm = new Parallel::ForkManager($MAX_PROCESSES);
my $input;
foreach $data (#all_data) {
# Forks and returns the pid for the child:
my $pid = $pm->start and next;
... do some work with $data in the child process ...
$pm->finish; # Terminates the child process
chomp($input= <STDIN>);
print "Some statistics\n" if $input =~ m!\n!;
}
Regards,

Resources