“” & {}
% set myvar "abcd"
abcd
% puts {1 $myvar 2}
1 $myvar 2 --------->No Substitution
% puts "1 $myvar 2"
1 abcd 2 ---------->Substitution
%
Logic is:
a=a+b;
b=a-b;
a=a-b;
set a 100
set b 12
set a [expr $a + $b]
set b [expr $a - $b]
puts "b = $b"
set a [expr $a - $b]
puts "a = $a"
2. TCL code to convert list to string and string to list.
Difference between a string and a list?
Data structures in Tcl cannot rely on distinguishing between strings and single-element lists. If this is Important in your application, you will need to include some extra flag information in the data structure To distinguish the two cases.
List to String:
set string ""
set list {a b c d e f}
for {set i 0} {$i<[llength $list]} {incr i} {
append string [lindex $list $i]
}
puts $string
Output:
abcdef
String to List: Quick answer: Use the split command.
set string abcdef
set l [split abcdef {} ]
puts $l : a b c d e f
3. How to multiply two numbers without using multiplication operator.
set a 6
set b 5
set s 0
for {set i 1} {$i <= $b} {incr i} {
set s [expr $a + $s]
}
puts $s
4 .What is namespace?
A namespace is an encapsulated collection of commands and variables to ensure that they won’t
Interfere with the commands and variables of other namespaces. A namespace is similar to a
Local variable within a proc.Tcl has always had one such collection, which we refer as the
Global namespace.
Tcl supports many object-oriented programming constructs, including namespaces. A namespace is
a collection of commands and variables. Namespaces are very useful for avoiding name collisions.
In addition, most Tcl packages create their own namespace to store their procedures and variables.
Name space example.
namespace eval test {
proc sum {a b} {
set num [expr $a + $b]
puts “The sum is: $num”
}
}
You can easily call a procedure within a namespace from another namespace by using the double colons (::)
test::sum 2 3
namespace eval sample {
proc sum {m n} {
set res [expr $m + $n]
return $res
}
}
puts [sample::sum 2 5]
5. List processing and String Processing Commands in Tcl.
TCL Lists:
• Zero or more elements separated by white space:
Example: set myList “red green blue”
Example: set myList {red green blue}
Result: red green blue
• Braces and backslashes for grouping:
Example: set myList {a b {c d e} f}
Result: a b {c d e} f
• Using the “List” command
Example: set myList [ list red green blue ]
Result: red green blue
• With variable substitution
Example:
set v1 red; set v2 green; set v3 blue
set myList [ list $v1 $v2 $v3 ] Result: red green blue
set myList [ list [ set v1] $v2 $v3 ] Result: red green blue
set myList “$v1 $v2 $v3” Result: red green blue
set myList “[ set v1] $v2 $v3” Result: red green blue
set myList {$v1 $v2 $v3} Result: $v1 $v2 $v3
TCL Lists
• The “list” manipulation commands allow you to manipulate or query individual elements within the list.
• List Commands:
– list
– lappend
– lindex
– linsert
– llength
– lrange |end
– lreplace |end
– lsearch ?mode? (mode is one of -exact, -glob, -regexp)
– lsort ?switch?
(switch can be -ascii, -dictionary, -integer, -real, -increasing, -decreasing, -unique etc…)
List Manipulation – Examples
% set list1 { a b c }
a b c
% set list2 { 1 2 3 }
1 2 3
% lappend list1 x y z
a b c x y z
% set list1
a b c x y z
% lindex $list1 4
y
% linsert $list1 4 p q
a b c x p q y z
% llength $list1
6
% lrange $list1 3 end
x y z
% lrange $list1 1 4
b c x y
% lrange $list1 1 2
b c
% lreplace $list1 4 end p q r
a b c x p q r
% lsearch $list1 p
-1
% lsearch $list1 x
3
% lsort $list1
a b c x y z
% lsort -dec $list1
z y x c b a
%
TCL Strings
• String manipulation commands allow you to work with blocks of characters (strings) within the string
– string compare
– string equal
– string first
– string last
– string index
– string length
– string range |end
– string
– string ?chars?
String Manipulation – Examples
$ tclsh
% set str1 "cisco"
cisco
% set str2 "systems"
systems
% string compare $str1 $str2
-1
% string equal $str1 $str2
0
% string first is $str1
1
% string first co $str1
3
% string first c $str1
0
% string index $str1 2
s
% string length $str1
5
% string range $str1 2 4
sco
% string range $str1 2 end
sco
% string toupper $str1
CISCO
% string tolower [ string toupper $str1 ]
cisco
% string trim $str1 o
Cisc
Split & Join operations
• join ?joinString?
– Returns a string formed from , optionally joined by ?joinString?
• split ?splitChars?
– Returns a list formed from , split at ?splitChars?, is specified
Example:
join { one two three four} . Result: one.two.three.four
split /usr/cisco/bin/tclsh / Result: usr cisco bin tclsh
split cisco {} Result: c i s c o
join {c i s c o } {} Result: cisco
6. TCL program to find number of vowels in a string.
set str "abcde"
set c 0
set l [string length $str]
puts " Length Of The String = $l"
for {set j 0} {$j<$l} {incr j} {
set b [string index $str $j]
if { $b=="a" | $b=="e" | $b=="i" | $b=="o" | $b=="u"} {incr c}
}
puts " The Number Of vowels Are =$c"
set str "abcde"
set c 0
set l [string length $str]
puts " Length Of The String = $l"
for {set j 0} {$j<$l} {incr j} {
set b [string index $str $j]
if { $b=="a" | $b=="e" | $b=="i" | $b=="o" | $b=="u"} {incr c}
}
puts " The Number Of vowels Are =$c"
7. Simple TCL Ping Script
Doing ping tests for lots of IP addresses can be tiring since you can't paste all the ping commands at the same time. You have to do it one at a time. All you need is Patience or you can opt for a TCL scripting language. For the ping script just modify the ip addresses what is shown below and it should be good.
foreach address {
1.1.1.1
2.2.2.2
3.3.3.3
4.4.4.4
5.5.5.5
6.6.6.6
} { puts [ exec "ping $address" ] }
1.1.1.1
2.2.2.2
3.3.3.3
4.4.4.4
5.5.5.5
6.6.6.6
} { puts [ exec "ping $address" ] }
8.Generate random no in TCL
set random_number [expr int(rand()*10)]
set random_number [expr int(rand()*10)]
9. Upvar Command
Usage: Used when we have to change the value of a global variable from inside a procedure’s scope
Upvar: Create link to variable in a different stack frame. upvar simplifies the implementation of call-by-name procedure calling and also makes it easier to implement Tcl procedures that are new control constructs.
What is the use of upvar?
A) Map a variable from the calling scope into the local procedure scope.
B) Map a variable from the local scope into the calling scope.
C) Copy the value of a variable from the calling scope to the local scope
upvar [level ] otherVar myVar...
Make local variable myVar become an alias for variable otherVar in the
stack frame indicated by level, where level is either a number indicating
the number of levels up the stack relative to the current level or a number
preceded by “#”, indicating an absolute level. The default level is 1.
Tcl’s upvar command is another answer to coding indirect variable references.
Upvar allows one to reference a variable or array by some other name. Using a
first argument of 0 allows variables in the current scope to be accessed.
Upvar is also used when passing arrays to procedures, in which the default procedure scope frame (1) is used:
proc calc_pop_density {state_array_name} {
The upvar command links a local variable with another variable (usually global).
Any change made to local variable will also change the global variable.
The upvar command allows you to easily pass arrays and arguments into procedures.
Syntax : upvar level $target_variable link_variable
Example:
proc example {one two} {
upvar $one local1
upvar $two local2
set local1 Kavitha
set local2 Anbarasu
}
set glob1 David
set glob2 Beckam
puts $glob1
puts $glob2\n
example glob1 glob2
puts $glob1
puts $glob2
Output
David
Beckam
Kavitha
Anbarasu
In the above example we are able to change the value of two global variables glob1 and glob2 from within a procedure.
10. EVAL Command
Beckam
Kavitha
Anbarasu
In the above example we are able to change the value of two global variables glob1 and glob2 from within a procedure.
10. EVAL Command
• eval - Evaluate a Tcl script
• eval arg ?arg ...?
• Eval takes one or more arguments, which together comprise a Tcl script containing one or
more commands. Eval concatenates all its arguments in the same fashion as the concat
command, passes the concatenated string to the Tcl interpreter recursively, and returns the result
of that evaluation (or any error generated by it). Note that the list command quotes sequences of
words in such a way that they are not further expanded by the eval command.
set a 10
set b a
eval puts $$b
Example:1
set cmd {puts "Evaluating a puts"}
puts $cmd
puts "Evaluating a puts"
eval $cmd
Example 2:
set str {set lst [list 100 200 300 400]}
set a [eval $str]
puts $a : 100 200 300 400
Example 3:
set a {puts "this is log file"}
puts $a
eval $a
puts "this is log file"
11. Find the length of a string without using string length command in TCL?
set str "manish"
set len 0
set list1 [ split $str "" ]
foreach value $list1 {
incr len
}
puts $len
12. Usage of ?: in TCL
Usage:
?: is used in sub patterns in a regexp
Whenever you don’t want a particular subpattern to be included as a sub-pattern use “?:” in front of the sub-pattern
Example:
set string "Projects: Brocade Cisco Fujitsu"
regexp "Projects: (Brocade|Cisco) (?:Fujitsu|Juniper|Cisco) (Fujitsu|Juniper)" $string sub1 sub2 sub3
puts "$sub1\n$sub2\n$sub3\n"
In the above example, the output will be
Projects: Brocade Cisco Fujitsu
Brocade
Fujitsu
The pattern “Cisco” does not come under sub pattern as “?:” is given
The output without ?: would be
Projects: Brocade Cisco Fujitsu
Brocade
Cisco
13. Fibonacci series.
set fib0 0
set fib1 0
set fib2 1
set s ""
for {set i 0} {$i < 10} {incr i} {
set fib3 [expr {$fib1 + $fib2}]
set fib1 $fib2
set fib2 $fib3
append s "$fib1, "
}
puts "$fib0,$s"
set fib2 1
set s ""
for {set i 0} {$i < 10} {incr i} {
set fib3 [expr {$fib1 + $fib2}]
set fib1 $fib2
set fib2 $fib3
append s "$fib1, "
}
puts "$fib0,$s"
proc fib {n} {
return [expr {$n<2 ? $n : [fib [expr $n-1]] + [fib [expr $n-2]]}]
}
14. TCL Program- Factorial value with and without using recursion.
Without Recursion:
proc fact { n } {
set f 1
while {$n>=2} {
set f [expr {$f*$n}]
incr n -1
}
return $f
}
With Recursion:
proc fact { n } {
set f 1
while {$n>=2} {
set f [expr {$f*$n}]
incr n -1
}
return $f
}
With Recursion:
proc recfact n {
if {$n<=1} {
return 1 }
expr $n * [recfact [expr {$n-1}]]
}
if {$n<=1} {
return 1 }
expr $n * [recfact [expr {$n-1}]]
}
puts “The factorial value without recursion [fact 4]”
puts “The factorial value with recursion [recfact 4]”
puts “The factorial value with recursion [recfact 4]”
15. TCL Program – count letters in the given string.
set str “LIHAKHDBLICIHJAADFDCSDBBBDFDB”
set l [string length $str]
puts $l
set cnt_A 0
set cnt_B 0
set cnt_C 0
set i 0
while {$i<=$l} {
if {“A”==[string index $str $i]} {
incr cnt_A } elseif {“B”==[string index $str $i]} {
incr cnt_B } elseif {“C”==[string index $str $i]} {
incr cnt_C }
incr i
}
set l [string length $str]
puts $l
set cnt_A 0
set cnt_B 0
set cnt_C 0
set i 0
while {$i<=$l} {
if {“A”==[string index $str $i]} {
incr cnt_A } elseif {“B”==[string index $str $i]} {
incr cnt_B } elseif {“C”==[string index $str $i]} {
incr cnt_C }
incr i
}
puts “The count of A is $cnt_A \n
The count of B is $cnt_B \n
The count of C is $cnt_C”
The count of B is $cnt_B \n
The count of C is $cnt_C”
o/p:
29
The count of A is 3
29
The count of A is 3
The count of B is 5
The count of C is 2
16. TCL Program – Check given number is odd or even
proc oddeven {n} {
if {$n%2==0} {
puts “the given $n is even” } else {
puts “the given number $n is odd” }
if {$n%2==0} {
puts “the given $n is even” } else {
puts “the given number $n is odd” }
}
oddeven 24
oddeven 67
o/p:
the given 24 is even
the given number 67 is odd
the given 24 is even
the given number 67 is odd
17.TCL Program – Find maximum number in the given 3 numbers.
set a 10
set b 20
set c 15
if {$a>$b && $a>$c} {
puts “a is bigger and value is $a” } elseif {$b>$a && $b>$c} {
puts “b is bigger and value is $b” } else {
puts “c is bigger and value is $c” }
set b 20
set c 15
if {$a>$b && $a>$c} {
puts “a is bigger and value is $a” } elseif {$b>$a && $b>$c} {
puts “b is bigger and value is $b” } else {
puts “c is bigger and value is $c” }
o/p:
b is bigger and value is 20
b is bigger and value is 20
18. TCL Program – reverse string.
proc strrev {str} {
set l [string length $str]
set l [expr $l-1]
set rev {}
for {set i $l} {$i>=0} {incr i -1} {
append rev [string index $str $i] }
puts “$rev”
}
set l [string length $str]
set l [expr $l-1]
set rev {}
for {set i $l} {$i>=0} {incr i -1} {
append rev [string index $str $i] }
puts “$rev”
}
strrev “welcome”
o/p:
emoclew
emoclew
19. TCL Program – various puts conditions on variables.
set a 10
puts $a
puts “$a”
puts {$a}
puts a
puts ‘$a’
puts \$a
puts $a
puts “$a”
puts {$a}
puts a
puts ‘$a’
puts \$a
o/p:
10
10
$a
a
’10′
$a
10
10
$a
a
’10′
$a
20. Write a sorting program that lsort implements in Tcl.
This command sorts the elements of list, returning a new list in sorted order. The implementation of the lsort command uses the merge-sort algorithm which is a stable sort that has O(n log n) performance characteristics.
proc mergesort list {
set len [llength $list]
if {$len <= 1} {return $list}
set middle [expr {$len / 2}]
set left [lrange $list 0 [expr {$middle - 1}]]
set right [lrange $list $middle end]
return [merge [mergesort $left] [mergesort $right]]
}
proc merge {left right} {
set res {}
while {[set lleft [llength $left]] > 0 && [set lright [llength $right]] > 0} {
if {[lindex $left 0] <= [lindex $right 0]} {
set left [lassign $left value]
} else {
set right [lassign $right value]
}
lappend res $value
}
if {$lleft > 0} {lappend res {*}$left}
if {$lright > 0} {set res [concat $res $right]}
return $res
}
21. Increment eacl element in a list ? eg: incrlist {1 2 3} =>2 3 4
set list1 {1 2 3}
set list2 {}
foreach i $list1 {
lappend list2 [expr {$i+1}] }
puts $list2
o/p:
2 3 4
set list1 {1 2 3}
set list2 {}
foreach i $list1 {
lappend list2 [expr {$i+1}] }
puts $list2
o/p:
2 3 4
22. How to extract “information” from “ccccccccaaabbbbaaaabbinformationabcaaaaaabbbbbbbccbb”
in tcl using a single command.
in tcl using a single command.
puts [string trim "ccccccccaaabbbbaaaabbinformationabcaaaaaabbbbbbbccbb" "abc"]
o/p:
information
23.How to Swap 30 & 40 in IP address 192.30.40.1 using TCL script
set var “192.30.40.1″
set list1 [split $var "."]
set list2 [lreplace $list1 1 2 40 30]
set result [join $list2 "."]
puts $result
o/p:
192.40.30.1
Using regsub in two line it can be swapped and using one line it can be swapped see below ..
ALITER
set a 192.30.40.1
set b [ string range $a 3 4 ]
set c [ string range $a 6 7 ]
set d [ string replace $a 3 4 $c ]
set e [ string replace $d 6 7 $b]
puts $e
===OR=====
set a 192.30.40.1
set b [ split $a .]
set u [lindex $b 0]
set v [lindex $b 3]
set x [lindex $b 1]
set y [lindex $b 2]
set z [join "$u $y $x $v" .]
puts $z
====OR====
set ip 192.30.40.1
regexp {([0-9]+\.)([0-9]+\.)([0-9]+\.)([0-9]+)} $ip match 1st 2nd 3rd 4th
append new_ip $1st $3rd $2nd $4th
puts $new_ip
set list1 [split $var "."]
set list2 [lreplace $list1 1 2 40 30]
set result [join $list2 "."]
puts $result
o/p:
192.40.30.1
Using regsub in two line it can be swapped and using one line it can be swapped see below ..
ALITER
set ip 10.20.30.40
regsub {(\d\d).(\d\d).(\d\d).(\d\d)} $ip {\1.\3.\2.\4} ip1
ALITER
puts $ip1
regsub {(\d+).(\d+).(\d+).(\d+)} $ip {\1.\3.\2.\4} ip1
puts $ip1
set a 192.30.40.1
set b [ string range $a 3 4 ]
set c [ string range $a 6 7 ]
set d [ string replace $a 3 4 $c ]
set e [ string replace $d 6 7 $b]
puts $e
===OR=====
set a 192.30.40.1
set b [ split $a .]
set u [lindex $b 0]
set v [lindex $b 3]
set x [lindex $b 1]
set y [lindex $b 2]
set z [join "$u $y $x $v" .]
puts $z
====OR====
set ip 192.30.40.1
regexp {([0-9]+\.)([0-9]+\.)([0-9]+\.)([0-9]+)} $ip match 1st 2nd 3rd 4th
append new_ip $1st $3rd $2nd $4th
puts $new_ip
24. Set ip address as 10.30.20.1 write a script to replace the 30 with 40.
set var “10.30.20.1″
regsub 30 $var 40 result
puts $result
o/p:
10.40.20.1
ALITER
set ip 10.20.30.40
regsub
{(\d\d).(\d\d).(\d\d).(\d\d)} $ip {\1.\3.\2.\4} ip1
ALITER
puts $ip1
regsub
{(\d+).(\d+).(\d+).(\d+)} $ip {\1.\3.\2.\4} ip1
puts $ip1
25.How do you check whether a string is palindrome or not using TCL script.
proc palindrome {str} {
set l [string length $str]
set i 0
incr l -1
set flag 0
while {$l>=0} {
set s [string index $str $i]
set e [string index $str $l]
if {$s==$e} { } else {
set flag 1
break }
incr l -1
incr i 1
}
if {$flag ==0} { puts “The given string $str is palindrome” } else {
puts “The given string $str is not palindrome” }
}
palindrome “malayalam”
palindrome “welcome”
o/p:
The given string malayalam is palindrome
The given string welcome is not palindrome
#Write a program to find given string is palindrome or not
set a madam
set len [string length $a]
set n [expr ($len-1)/2]
for {set i 0} {$i < $n} {incr i} {
set b [string index $a $i]
set c [expr $len - 1 - $i]
set d [string index $a $c]
if {$b != $d} {
puts "not palindrome"
exit
}
}
puts "palindrome"
26. TCL Program – string operations .
set string1 “fg”
set string2 “cdeabfg”
set string2 “cdeabfg”
puts [string compare $string1 $string2]
puts [string length $string1]
puts [string index $string2 2]
puts [string first $string1 $string2]
puts [string last $string1 $string2]
o/p:
1
2
e
5
5
o/p:
1
2
e
5
5
6.
set var “welcome to \$100 language tcl”
puts $var
set var “welcome to \$100 language tcl”
puts $var
o/p:
welcome to $100 language tcl
welcome to $100 language tcl
27.Split and join in TCL
split :
set date1 17/01/2011
set list1 [split $date1 /]
puts $list1
set var “”
foreach i $list1 {
lappend var $i }
puts $var
set list1 [split $date1 /]
puts $list1
set var “”
foreach i $list1 {
lappend var $i }
puts $var
o/p:
17 01 2011
17 01 2011
17 01 2011
17 01 2011
set date2 “18 01 2012″
set date2 [join $date2 /]
puts $date2
set date2 [join $date2 /]
puts $date2
set date3 “/19/11/2009″
set date3 [split $date3 /]
puts $date3
foreach i $date3 {
puts $i }
set date3 [split $date3 /]
puts $date3
foreach i $date3 {
puts $i }
o/p:
18/01/2012
{} 19 11 2009
18/01/2012
{} 19 11 2009
19
11
2009
11
2009
b.should not use “\” in join
set list2 [join "16 02 2012" \]
puts $list2
set list2 [join "16 02 2012" \]
puts $list2
o/p;
——–
missing close-bracket
while executing
“set list2 [join "16 02 2012" \]
puts $list2
——–
missing close-bracket
while executing
“set list2 [join "16 02 2012" \]
puts $list2
”
28.– eval
set var {puts “welcome to tcl” }
puts $var
eval $var
puts $var
eval $var
o/p:
puts “welcome to tcl”
welcome to tcl
puts “welcome to tcl”
welcome to tcl
b.#eval
puts “evaluation usage”
set test1 { ;#should use this block by using eval
set b 10
puts $b }
puts “evaluation usage”
set test1 { ;#should use this block by using eval
set b 10
puts $b }
eval $test1
o/p:
evaluation usage
10
evaluation usage
10
29. TCL Program – Average of given numbers using args in TCL
proc avg {args} {
set s 0
set count 0
foreach i $args {
incr count
set s [expr {$s+$i}] }
set avg [expr {$s/$count}]
puts “count is $count and sum is $s and avg is $avg”
return $avg }
puts [avg 23 34 12 67 45]
set s 0
set count 0
foreach i $args {
incr count
set s [expr {$s+$i}] }
set avg [expr {$s/$count}]
puts “count is $count and sum is $s and avg is $avg”
return $avg }
puts [avg 23 34 12 67 45]
o/p:
count is 5 and sum is 181 and avg is 36
36
count is 5 and sum is 181 and avg is 36
36
30. Deleting a list element by value.
proc ldelete {list value } {
set ix [lsearch -exact $list $value]
if {$ix >= 0} {
puts [lreplace $list $ix $ix]
} else {
puts $list
}
}
ldelete "1 2 3 4 5" 3
31. IMPORTANT:
proc args_parser {args} {
set length [llength $args]
puts "Length of the args is $length"
for { set i 0 } { $i < $length } { incr i } {
set arg_name [lindex $args $i]
incr i
set arguments($arg_name) [lindex $args $i]
}
return [array get arguments]
}
proc b {args} {
array set ar [eval args_parser $args]
set name $ar(-name)
set age $ar(-age)
set country $ar(-country)
set location $ar(-location)
puts "$name is aged $age\n";
puts "$name is located at $location,$country\n";
}
b -name manish -age 27 -location bangalore -country India
32. TCL Program – remove duplicates in the given list.
set list1 “venkat gopi prashanth mahantesh krishna nagendra venkat krishna”
set l [llength $list1]
set i 0
set result “”
set l [llength $list1]
set i 0
set result “”
foreach j $list1 {
set arr($i) $j
incr i
}
set arr($i) $j
incr i
}
for {set k 0} {$k<$l} {incr k} {
set n 0
for {set j [expr $k+1]} {$j<$l} {incr j} {
if {$arr($k)==$arr($j)} {
incr n }
}
if {$n==0} {
lappend result $arr($k)
}
}
set n 0
for {set j [expr $k+1]} {$j<$l} {incr j} {
if {$arr($k)==$arr($j)} {
incr n }
}
if {$n==0} {
lappend result $arr($k)
}
}
puts $result
o/p:
gopi prashanth mahantesh nagendra venkat Krishna
gopi prashanth mahantesh nagendra venkat Krishna
Write a script to remove duplicates word in string
set lst "This issues the have is can be the most the"
regsub -all "the" $lst "" out
puts $out
33. TCL Program – Remove the list2 elements in list1
set list1 ” venkat praveen gopi syed ravi robert ”
set list2 “gopi ravi ”
set list2 “gopi ravi ”
foreach i $list2 {
set index 0
foreach j $list1 {
if { $i==$j } {
set list1 [lreplace $list1 $index $index]
}
incr index 1
}
}
puts $list1
set index 0
foreach j $list1 {
if { $i==$j } {
set list1 [lreplace $list1 $index $index]
}
incr index 1
}
}
puts $list1
o/p:
venkat praveen syed Robert
venkat praveen syed Robert
34.TCL Program – upvar in tcl
proc inc name {
upvar $name a
set a [expr $a + 1]
}
set x 20
inc x
puts $x
upvar $name a
set a [expr $a + 1]
}
set x 20
inc x
puts $x
o/p:
21
21
35.TCL Program – keylset and kelget.
package require Tcl 8.5
package require Thread 2.6
package require Thread 2.6
keylset person ID 159 NAME {Venkatesh Reddy}
puts [keylget person ID]
puts [keylget person NAME]
puts [keylget person ID]
puts [keylget person NAME]
# Create individual users and a list
keylset user1 id 8108 alias venkat ; # {{id 101} {alias john}}
keylset user2 id 2312 alias praveen ; # {{id 102} {alias ally}}
set users [list $user1 $user2]
keylset user1 id 8108 alias venkat ; # {{id 101} {alias john}}
keylset user2 id 2312 alias praveen ; # {{id 102} {alias ally}}
set users [list $user1 $user2]
# Show the list
foreach user $users {
puts “ID: [keylget user id]”
puts “Alias: [keylget user alias]”
puts “”
}
foreach user $users {
puts “ID: [keylget user id]”
puts “Alias: [keylget user alias]”
puts “”
}
% source keylsetkeylget.tcl
o/p:
159
Venkatesh Reddy
ID: 8108
Alias: venkat
159
Venkatesh Reddy
ID: 8108
Alias: venkat
ID: 2312
Alias: praveen
%
Alias: praveen
%
36. Working of subst command in indirect way :regsub ----to add
1. Use of subst.
It is used to perform multiple passes of substitution before evaluating a command. Example is shown below.
array set french {I Je speak parlez French Francais}
set language french
foreach word {I speak French} {
if {[info exists ${language}($word)]} {
puts -nonewline "[subst $${language}($word)] "
} else {
puts -nonewline "$word "
}
}
Output: Je parlez Francais
or
subst - Perform backslash, command, and variable substitutions
When it performs its substitutions, subst does not give any special treatment to double quotes or curly braces (except within command substitutions)
set a 44
puts [subst {xyz {$a}}]
Output: xyz {44}
37. Write a proc which will reverse a array ie value as index and index as value.
Eg a(1) 10 should be a(10) 1
http://pleac.sourceforge.net/pleac_tcl/arrays.html
http://stackoverflow.com/questions/11497726/how-to-reverse-an-array-in-tcl
array set A {1 10 2 20 3 30 4 40 5 50}
set lst [array get A]
puts $lst
set newlst [lreverse $lst]
puts $newlst
array set B $newlst
puts [array get B]
puts [parray B]
38. 4 ways to pass an arguments to procedure.
Pass by value
Proc sum {a b} {
Set num [expr $a + $b]
Puts “The sum is: $num”
}
Sum 2 3
Pass by name
Array set months {1 Jan 2 Feb}
Parray months
Or
Proc increase {initial_apy change} {
Upvar $initial_pay x
Foreach item [array names x] {
Set x($item) [expr $x($item) + $change]
}
}
Array set Pay {Ray Steve 50 Fred 200}
Increase Pay 25
Parray Pay
Defaults
Proc myprocdefault {{}{}{}} {
Puts “$a $b $c”
}
Myprocdefault
Variable arguments
Proc show {a args} {
Puts $a
foreach val $args {puts $val}
}
Show 1 2 3
39. What is the use of return command?
The return command will return a value from procedure.
Proc sum {a b} {
return [expr $a + $b]
}
Set num [sum 2 3]
Puts “The sum is: $num”
40. Different ways of global variable identification.
set var 3
proc glob {} {
global var
puts "the value of variable is $var"
}
glob
or
Declaring global variable using double colon (::)
Proc proc01 {} {
Puts “The value of var1 is: $::var1”
}
41.Example for call a procedure by name and value.
proc Hours {weekly daily} {
upvar $weekly x
foreach item [array names x] {
set x($item) [expr $x($item) + $daily]
}
}
array set Timecard {Tom 20 Sue 24 Mike 18}
puts "This is the array before the procedure:"
parray Timecard
set res [Hours Timecard 8]
puts $res
42. Create a procedure that will accept one argument and variable arguments
proc variable {a args} {
puts $a
foreach val $args { puts $val }
}
variable 1 2 3 4 5
Output:
1
2
3
4
5
43. What is exec command used for ?
Exec command is used to execute programs external to TCL.
% cd "C:/Program Files (x86)/Windows Media Player"
% exec wmplayer.exe test.wmv
44. What are special variables in TCL.
Argc : number of command line arguments
Argv0: name of the script
Argv: list of command line arguments
Env : env array is an array of environmental variables.
45. Use of source command?
Source command loads in a Tcl file and will execute the commands contained within the file.
46. Use of package command?
Package is similar to libraries except that they require explicit loading.
47.Use of package require command?
Package require command organizes sets of procedures under a single name, and lets you request packages by name and revision number.
48. What are the possible package require problem?
Say package A and package B both define procedure name sum. If these two packages are loaded and each contains same proc name, then the last package loaded will define the procedure, even it is different from the first procedure.
Solution: namespaces will help alleviate this problem.
49. How global, upvar and uplevel behaves in TCL?
Variables are local to the procedure unless "global" or "upvar" command is used, see below.
If the last argument is named args all the remaining arguments are stored in this list. This way a procedure can have variable number of arguments.
global
global variablename variablename2 ...
Indicate that the variable with name variablename is in the global scope.
upvar
upvar $name1 a $name2 b ...
Indicate the that procedure can change data in the callers scope for argument name1 using the name a and name2 using name b, etc. Use with care!
upvar $name a
set a 1
uplevel Similar to the upvar command but used to evaluate commands in the scope of the calling procedure. Use with care!
uplevel incr x
Increments the variable x in the calling procedure.
Uplevel : Execute a script in a differ ent stack frame.
uplevel
uplevel [level ] arg...
Concatenate arguments and evaluate them in the stack frame context indicated
by level, wher e level is either a number indicating the number of
levels up the stack relative to the current level or a number preceded by “#”,
indicating an absolute level. The default level is 1.
uplevel example:
proc do {varname first last body} {
upvar $varname v
for {set v $first} {$v <= $last} {incr v} {
uplevel $body
}
}
set lst {}
do i 1 5 {
lappend lst [expr {$i*$i}]
}
puts $lst
Uplevel
proc a {} {
set x a
uplevel 3 {set x Hi}
puts "x in a = $x"
}
proc b {} {
set x b
a
puts "x in b = $x"
}
proc c {} {
set x c
b
puts "x in c = $x"
}
set x main
c
puts "x in main == $x"
%
%
c
x
in a = a
x
in b = b
x
in c = c
%
puts "x in main == $x"
x in main == Hi
%
50. The upvar command will
A) Map a variable from the calling scope into the local procedure scope.=
B) Map a variable from the local scope into the calling scope.
C) Copy the value of a variable from the calling scope to the local scope.
upvar [level ] otherVar myVar...
Make local variable myVar become an alias for variable otherVar in the
stack frame indicated by level, where level is either a number indicating
the number of levels up the stack relative to the current level or a number
preceded by “#”, indicating an absolute level. The default level is 1.
Tcl’s upvar command is another answer to coding indirect variable refer ences.
Upvar allows one to refer ence a variable or array by some other name. Using a
first argument of 0 allows variables in the current scope to be accessed.
Upvar is also used when passing arrays to procedures, in which the default procedure scope frame (1) is used:
proc calc_pop_density {state_array_name} {
UPVAR
upvar allows you access variables up x levels in the call stack.
They don't necessarily need to be global variables.
You can use upvar to emulate global by passing upvar #0 varName
localVarName You will get the global variable with a local name in that case.
To emulate pass by reference, you are pass the name of the
variable, then call upvar on that name.
If you know the name of the variable, you can use it as is.
Observe the following code:
# here there
is only 1 global variable, but we also need to access to variables defined in
the calling functions
proc p3 {} {
# upvar
defaults to 1, so not needed to put in here
# also
notice you can call upvar on more than one variable
upvar dog myDog horse myHorse cat myCat
upvar 2 cow myCow alpha myAlpha
upvar #0 samurai mySamurai
puts
"Level 1: $myDog $myHorse $myCat"
puts
"Level 2: $myCow $myAlpha"
puts
"Global : $mySamurai"
}
proc p2 {} {
set dog "bowow"
set horse "niegh"
set cat "meow"
p3
}
proc p1 {} {
set cow "moo"
set alpha "beta"
p2
}
set samurai "japan"
p1
This returns
Level 1: bowow
niegh meow
Level 2: moo beta
Global : japan
upvar is just a way to get at variables from the call stack.
(calling functions) including the 'global' stack.
51. What is difference between lappend and concat?
The difference is in the output.
set list1 {1 2 3}
puts $list1
set list2 {a b c}
puts $list2
set new [lappend list1 $list2]
puts $new
set lengthlist [llength $new]
puts $lengthlist
#output
1 2 3
a b c
1 2 3 {a b c}
4
set list1 {1 2 3}
puts $list1
set list2 {a b c}
puts $list2
set b [concat $list1 $list2]
puts $b
set concatlength [llength $b]
puts $concatlength
#output
1 2 3
a b c
1 2 3 a b c
6
puts $list1
set list2 {a b c}
puts $list2
set new [lappend list1 $list2]
puts $new
set lengthlist [llength $new]
puts $lengthlist
#output
1 2 3
a b c
1 2 3 {a b c}
4
set list1 {1 2 3}
puts $list1
set list2 {a b c}
puts $list2
set b [concat $list1 $list2]
puts $b
set concatlength [llength $b]
puts $concatlength
#output
1 2 3
a b c
1 2 3 a b c
6
52. Write a script to display the version of Tcl you are using
puts [info tclversion]
puts [info patchlevel]
53.Use of catch command . (just want to know what happen if we use variable m or without using it)
Use of catch command.
Catch command is use to handle exceptions within a script.
Catch command will gather an error condition and return the results rather than aborting the script.
% catch {unset var} result
1
% puts $result
can't unset "var": no such variable
%s
catch {puts $b} err
puts $err
or
puts “ hello”
catch {puts $a} m
Puts “name”
Output will be :
Hello
1 and variable is not defined.
Name.
Or
catch is used to change the actions produced by errors.
Example:
if {[catch {set foobar} errmsg]} {
puts “the message output: $errmsg”
}
May take up to two arguments:
A command block to execute.
An optional variable to store error messages within.
Returns:
1 if an error has been caught.
0 otherwise.
54. Create a list of week days and print the first and last character of each day using foreach command.
set lst {sunday monday tuesday wednesday thursday friday saturday}
foreach day $lst {
set out "[string index $day 0][string index $day end] "
append newlst "$out"
}
puts $newlst
55. How to increment each element in a list?
set lst {0 3 2 10}
foreach num $lst {
incr num
append newlst "$num "
}
puts $newlst
56. Write a proc to increment the ip by the given no. of times. The incremented IPs should be a valid one.
proc generate_ips {start_ip number_of_ips} {
regexp {([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)} $start_ip - oct1 oct2 oct3 oct4
set ip_list ""
while {[llength $ip_list] < $number_of_ips} {
for {} {$oct4 <= 254} {incr oct4} {
lappend ip_list "$oct1.$oct2.$oct3.$oct4"
if {[llength $ip_list] == $number_of_ips} {
break
}
}
if {$oct4 == 255} {
set oct4 0
incr oct3
}
if {$oct3 == 256} {
set oct3 0
incr oct2
}
if {$oct2 == 256} {
set oct2 0
incr oct1
}
if {$oct1 == 256} {
break
}
}
return $ip_list
}
57. how to split string by blank lines?
set a {dfsfhdslkj}
set a [split $a ""]
puts $a
foreach val $a {
puts "$val \n"
}
58. TCL numeric two list comparison?
set a [list 2 1 3]
set b [list 3 1 2]
set a1 [lsort $a]
puts $a1
set b1 [lsort $b]
puts $b1
if {[string equal -nocase [llength $a1] [llength $b1]] == 1} {
puts "list are of equal length"
if {$a1 == $b1} {
puts "list are equal"
}
} else {
puts "list are unequal"
}
59. Find the biggest element from the list?
% set numberlist {15 30 22 75 50 0x30A 150 110}
15 30 22 75 50 0x30A 150 110
% set numberlist [lsort -integer $numberlist]
15 22 30 50 75 110 150 0x30A
% puts [lindex $numberlist end]
0x30A
%
60. How unset command works.
Unset a variable, array element or entire array.
unset a
unset array(elf)
unset array
61. Different levels of procs in TCL
Set x 5; set y 5
;# A second level proc - This will be called by one
proc two {y} {
upvar 1 $y z ;# tie the calling value to variable z
upvar 2 x a ;# Tie variable x two levels up to a
puts "two: Z: $z A: $a" ;# Output the values, just to confirm
set z 1; ;# Set z, the passed variable to 1;
set a 2; ;# Set x, two layers up to 2;
}
;# A first level proc - This will be called by the global space code.
proc one {y} {
upvar $y z ;# This ties the calling value to variable z
puts "one: Z: $z" ;# Output that value, to check it is 5
two z; ;# call proc two, which will change the value
}
one y; ;# Call one, and output X and Y after the call.
puts "\nX: $x Y: $y"
Out:
one: Z: 5
two: Z: 5 A: 5
X: 2 Y: 1
62. Use of subst.
It is used to perform multiple passes of substitution before evaluating a command. Example is shown below.
array set french {I Je speak parlez French Francais}
set language french
foreach word {I speak French} {
if {[info exists ${language}($word)]} {
puts -nonewline "[subst $${language}($word)] "
} else {
puts -nonewline "$word "
}
}
Output: Je parlez Francais
or
subst - Perform backslash, command, and variable substitutions
When it performs its substitutions, subst does not give any special treatment to double quotes or curly braces (except within command substitutions)
set a 44
puts [subst {xyz {$a}}]
Output: xyz {44}
63. Write code fragments to store, retrieve, and display your first, middle, and last name using a single string variable, a single list variable, a single array variable, and a single keyed list variable
set name "nawraj lekhak"
puts $name
set name [list nawraj lekhak]
puts $name
puts [lindex $name 0]
puts [lindex $name 1]
array set arrname {nawraj lekhak}
puts "==[array get arrname]"
puts "[array names arrname]--"
puts $arrname(nawraj)
64. Get two numbers from user input and do the sum.
C:\Users\manish>tclsh
puts “Enter the number”
flush stdout
% set n1 [gets stdin]
% set n2 [gets stdin]
% set n3 [expr $n1 + $n2]
% flush stdout
65. How can in invoke another program from within a TCL program ?
exec -- is the solution J
66. Difference of local and global variable.
set x 100
proc fun {} {
global x
puts "inside fun $x"
}
proc fun1 {} {
set x 500
puts "inside fun1 $x"
}
fun
fun1
67. Regexp to match email-id
Regex:
[a-z0-9_-]+(\.[a-z0-9_-]+)*@[a-z0-9_-]+(\.[a-z0-9_-]+)+
Matches:
j_smith@foo.com
j.smith@bc.canada.ca
smith99@foo.co.uk
1234@mydomain.net
Doesn't Match:
@foo.com
.smith@foo.net
smith.@foo.org
68. Some regexp and regsub scenarios:
set str2 "abc^def"
regexp "\[^a-f]*def" $str2 match
puts "using \[^a-f] the match is: $match"
regexp "\[a-f^]*def" $str2 match
puts "using \[a-f^] the match is: $match"
regsub {\^} $str2 " is followed by: " str3
puts "$str2 with the ^ substituted is: \"$str3\""
regsub "(\[a-f]+)\\^(\[a-f]+)" $str2 "\\2 follows \\1" str3
puts "$str2 is converted to \"$str3\""
69. Check whether input char is vowel or notputs "Enter a character\n"
set ch [gets stdin]
if {$ch == "a" || $ch == "A" || $ch == "e" || $ch == "E" || $ch == "i" || $ch == "I" || $ch == "o" || $ch == "O" || $ch == "u" || $ch == "U"} {
puts "character is vowel"
} else {
puts "Input charcater is not vowel"
}
70. Print below format
*
* *
* * *
* * * *
set out ""
set i 1
set pattern *
while {$i < 5} {
append out "$pattern "
puts $out
incr i
}
Or
set lst {* * * * * * *}
set i 0
foreach val $lst {
puts "[lrepeat [incr i] $val]"
}
71. Write a Program to print half pyramid as using numbers as shown in figure below.
1
1 2
1 2 3
1 2 3 4
1 2 3 4 5
set out ""
set i 1
set pattern 0
while {$i < 6} {
append out "[incr $pattern] "
puts $out
incr i
}
72. Write a C Program to print triangle of characters as below
A
B B
C C C
D D D D
set lst {A B C D E}
set i 0
foreach val $lst {
set out [lrepeat [incr i] $val]
puts "$out "
}
73. Write a TCL code to print inverted half pyramid using * as shown below
* * * * *
* * * *
* * *
* *
*
set a *
set i 5
for {set i 5} {$i > 0} {incr i -1} {
puts [lrepeat $i $a]
}
74. Write a TCL code to print inverted half pyramid as using numbers as shown below.
1 2 3 4
1 2 3
1 2
1
set lst {1 2 3 4 5}
set len [llength $lst]
set i 0
while {$len > 0} {
set out [lrange $lst $i [expr $len - 1]]
puts $out
incr len -1
}
75. A program that computes sum from 1 to n
proc sumto {n} {
set sum 0
for {set i 0} {$i <= $n} {incr i} {
set sum [expr $i + $sum]
}
return $sum
}
set out [sumto 5]
puts $out
76. TCL program to check a leap year
puts "Enter a year\n"
set yr [gets stdin]
if {$yr%400 == 0} {
puts "Input year is leap year\n"
} elseif {$yr%100 == 0} {
puts "Input year is leap year\n"
} elseif {$yr%4 == 0} {
puts "Input year is leap year\n"
} else {
puts "Input year is not leap year\n"
}
77. TCL program to find Armstrong number.
A number is armstrong if the sum of cubes of individual digits of a number is equal to the number itself. For example 371 is an armstrong number as 33 + 73 + 13 = 371. Some other armstrong numbers are: 0, 1, 153, 370, 407.
set str 153
set len [string length $str]
set num1 [string index $str 0]
set num2 [string index $str 1]
set num3 [string index $str 2]
if {[expr ($num1*$num1*$num1) + ($num2*$num2*$num2) + ($num3*$num3*$num3)] == "$str"} {
puts "str is a armstrong number"
} else {
puts "given string is not an armstrong number"
}
Or
set str 150
set len [string length $str]
set num1 [string index $str 0]
set num2 [string index $str 1]
set num3 [string index $str 2]
if {[expr (pow($num1,3)) + (pow($num2,3)) + (pow($num3,3))] == "$str"} {
puts "str is a armstrong number"
} else {
puts "given string is not an armstrong number"
}
78. Print below pattern.
0
0 1
0 1 2
0 1 2 3
0 1 2 3 4
0 1 2 3 4 5
set i 0
set out ""
while {$i <= 5} {
append out "$i "
puts $out
incr i
}
79. Print below pattern
0 1 2 3 4
0 1 2 3
0 1 2
0 1
0
set lst {0 1 2 3 4 5}
set len [llength $lst]
set i 0
while {$len > 0} {
set out [lrange $lst $i [expr $len -1]]
puts $out
incr len -1
}
80. Print below pattern.
5 4 3 2 1 0
5 4 3 2 1
5 4 3 2
5 4 3
5 4
5
set lst {5 4 3 2 1 0}
set len [llength $lst]
set i 0
while {$len > 0} {
set out [lrange $lst $i [expr $len -1]]
puts $out
incr len -1
}
81. Print below pattern.
0
0 1
0 1 2
0 1 2 3
0 1 2 3 4
0 1 2 3 4 5
0 1 2 3 4
0 1 2 3
0 1 2
0 1
0
set i 0
set out ""
while {$i <= 5} {
append out "$i "
puts $out
incr i
}
set len [llength $out]
while {$len >= 0} {
set out [lrange $out 0 [expr $len -2]]
incr len -1
puts $out
}
82. Tcl script to extract the no. of warning and errors?
Input:
xx : Severity: Warning Occurrence: 2
yy :Severity: Error Occurrence: 2
ZZ:Severity: Error Occurrence: 4
at the end I want to have Warnings =2
Error =6
Program:
# input file
set fname "tcluser16.txt"
set input_file [open $fname "r"]
# define variables
set nr_warns 0
set nr_errs 0
while { [gets $input_file line] != -1 } {
# try to extract Warning Occurrence
set result [regexp {[Ww]arning\s+.*:\s*([0-9]+)}\
$line match num]
if {$result} {
set nr_warns [expr $nr_warns + $num]
}
# try to extract extract Error Occurrence
set result [regexp {[Ee]rror\s+.*:\s*([0-9]+)}\
$line match num]
if {$result} {
set nr_errs [expr $nr_errs + $num]
}
}
# print results
puts "Number of Warnings: $nr_warns"
puts "Number of Errors : $nr_errs"
# close input file
close $input_file
83. Find duplicate files from different directories?
set searcrhResults {
dir1/dir2/dir3/file1.tcl dir1/dir3/file1.tcl dir1/dir2/file1.tcl dir1/dir2/dir3/file2.tcl dir1/dir2/dir3/file3.tcl dir1/dir3/file2.tcl dir1/file3.tcl dir1/file4.tcl }
foreach file $searcrhResults {
if {[catch {incr filenames([file tail $file],cnt)}]} {set filenames([file tail $file],cnt) 1}
lappend filenames([file tail $file],paths) [file dirname $file]
}
84. Regexp to match below pattern?
set mystring "------ some string ---------"
set result [regexp {(-+)\s*([^-]*)\s*(-+)} $mystring match first middle rest]
or
regexp -- {(^[-]+)([a-z]+\s[a-z]+)([-]+$)} $pattern newstring first middle end
puts $newstring
puts $first
puts $middle
puts $en
85. Program to count the repeat numbers in the file
Input:
January 4000 300 200
February 2000 100 0
March 4000 50 10
April 4000 120 300
May 1000 100 0
June 2000 0 0
July 400 1 1
August 4000 200 100
September 2000 100 200
October 0 0 0
Then the program will write to an output file with content
January 4000 300 200 1
February 2000 100 0 1
March 4000 50 10 2
April 4000 120 300 3
May 1000 100 0 0
June 2000 0 0 2
July 400 1 1 0
August 4000 200 100 4
September 2000 100 200 3
October 0 0 0 0
Program:
set fil [open "tpham1002002.txt"]
while {! [eof $fil]} {
set line [gets $fil]
set col2 [lindex $line 1]
if {$col2!=""} {
if {[array get count $col2]==""} { set count($col2) 0 }
incr count($col2)
lappend line $count($col2)
}
puts $line
}
close $fil
86.File reading example
## all problems found by 'open' throw exceptions:
if {[catch {set read_fh [open "input.txt" "r"]} errmsg]} {
error "ERROR: $errmsg"
}
## read the file line-by-line:
while {[gets $read_fh this_line] != -1} {
...
}
## or read the entire file into one string:
set file_contents [read $read_fh]
## or read the next N bytes into a string:
set next_block [read $read_fh 1024]
close $read_fh
87. File writing example
## all problems found by 'open' throw exceptions:
if {[catch {set write_fh [open "output.txt" "w"]} errmsg]} {
error "ERROR: $errmsg"
}
puts $write_fh "blah blah blah"
## need a catch on close, because that's where most errors happen:
if {[catch { close $write_fh } errmsg]} {
error "ERROR: $errmsg"
}
88. To check whether file is dir or file
.
file isdirectory
file isdirectory <path>
Returns whether or not the given path is a directory.
if {![file isdirectory "indir"]} {
...
}
file isfile
file isfile <path>
Returns whether or not the given path is a regular file.
if {[file isfile "maybe_a_link.txt"]} {
...
}
89. Write five integers into a file called “myfile,” then close the file.
set fd [open "myfile.txt" w+]
set data "1 2 3 4 5"
puts $fd $data
close $fd
90. Read the contents of “myfile” from exercise 1. Calculate and display the sum of the integers.
set fd1 [open myfile.txt r]
set sum 0
foreach num [read $fd1] {
set sum [expr $sum + $num]
}
puts $sum
91. Exercise 1:
# open a file for writing
if {[catch {set fd [open myfile w]} errmsg]} {
error "Unable to open file 'myfile' for writing\n$errmsg"
}
# write 5 integers into the file
puts $fd "5 10 15 20 25"
# close the file
close $fd
92. Exercise 2
#open the file ‘myfile’ for reading
if {[catch {set fd [open myfile]} errmsg]} {
error "Unable to open file 'myfile' for reading\n$errmsg"
}
# read the contents of the file ‘myfile’ into a variable called ‘nums’
# then calculate and display the total of the integers
while {[gets $fd nums] != -1} {
set sum 0
foreach num $nums {
set sum [expr $num + $sum]
}
}
puts "The sum is $sum”
# close the file
close $fd
93. Exercise 3:
#open the file for reading
if {[catch {set fd [open myfile]} errmsg]} {
error "Unable to open file 'myfile' for reading\n$errmsg"
}
# read the contents of the file into a variable called 'nums'
while {[gets $fd nums] != -1} {
set sum 0
foreach num $nums {
puts [format "%20d" $num]
set sum [expr $num + $sum]
}
}
puts [format "\nTotal: %13d" $sum]
94. To read entire file.
set fd [open "myfile.txt" r]
while {![eof $fd]} {
gets $fd data
puts $data
}
close $fd
95. How to pass an array to a proc ?
You will need to use passing by reference to pass array information to a procedure. Array values cannot be passed as procedure arguments. Keyed lists should also be passed by reference
It is not possible directly we need to use upvar .
proc show_array arrayName {
upvar $arrayName myArray
foreach element [array names myArray] {
puts stdout "${arrayName}($element) = $myArray($element)"
}
}
set arval(0) zero
set arval(1) one
show_array arval
or
proc arr arr1 {
upvar $arr1 arr2
set namelst [array names arr2]
foreach val $namelst {
puts "${arr1}($val) = $arr2($val)"
}
}
array set arr3 {0 hello 1 hi}
arr arr3
96. Write a proc which will reverse a array ie value as index and index as value.
Eg a(1) 10 should be a(10) 1
array set A {1 10 2 20 3 30 4 40 5 50}
set lst [array get A]
puts $lst
set newlst [lreverse $lst]
puts $newlst
array set B $newlst
puts [array get B]
puts [parray B]
97. Input is “40000000000000000000”. It can be any number long . Write a regexp which will take block of 2 nos from given number and print the values in separate variables.
set num "125342354832"
regsub -all {(..)} $num {\1 } var
puts $var
or
set str "40awd409999"
set i 1
while {[string length $str] > 1} {
regexp -nocase {[0-9a-z][0-9a-z]} $str match
set str$i $match
regsub $match $str "" str
incr i
}
if {[string length $str] == 1} {
set str$i $str
}
puts "$str1 $str2 $str3 $str4 $str5 $str6"
or
% set data "asdhlakjfsdhfl12312"
asdhlakjfsdhfl12312
% set fivers [regexp -all -inline {.{1,2}} $data]
as dh la kj fs dh fl 12 31 2
set i 0
foreach num $lst {
set var($i) $num
puts $var($i)
incr i
}
98. How can I create/use association lists or property lists?
Use arrays or Extended Tcl keyed lists.
For example, if you did a:
keylset ttyFields ttyName tty1a
keylset ttyFields baudRate 57600
keylset ttyFields parity strip
And then an echo $ttyFields, you'd get:
{ttyName tty1a} {baudRate 57600} {parity strip}
Or using arrays:
set ttyFields(ttyName) tty1a
set ttyFields(baudRate) 57600
set ttyFields(parity) strip
99.How can I pass an array into a proc?
Use upvar rather than try to use global variables when possible. If the function is event driven, you are forced to use global variables.
# print elements of an array
proc show_array arrayName {
upvar $arrayName myArray
foreach element [array names myArray] {
puts stdout "${arrayName}($element) = $myArray($element)"
}
}
set arval(0) zero
set arval(1) one
show_array arval
To return an array from a procedures, just take the array name in as an argument, as above. Any changes you make in the array will be made in the parent's array as well.
Extended Tcl introduces a concept called keyed lists which are arrays made out of lists of key-value pairs and can be passed by value to routines, over networks, etc.
100. How can I use variables to hold array names?
% set foo "bar baz"
bar baz
% foreach aap $foo {
set $aap(1) "something"
}
can't read "aap(1)": variable isn't array
This means Tcl tries to substitute the array element aap(1) which doesn't exist. To fix this use:
% foreach aap $foo {
set [set aap](1) "something"
}
In this case two arrays bar and baz are created.
An alternative format is:
% foreach aap $foo {
set ${aap}(1) "something"
}
101.Pass an array to proc
proc a1 {a2} {
upvar $a2 x
foreach index [array names x] {
puts "x($index) = $x($index)"
}
}
array set a {0 10 1 20 2 30}
a1 a
102. Write a script that searches the contents of a directory recursively for a pattern
Find all the Tcl files in the current directory:
glob *.tcl
Find all the Tcl files in the user's home directory, irrespective of what the current directory is:
glob -directory ~ *.tcl
Find all subdirectories of the current directory:
glob -type d *
Find all files whose name contains an "a", a "b" or the sequence "cde":
glob -type f *{a,b,cde}*
103. How to return an array?
proc get_mroute_active { &multicast } {
upvar ${&multicast} MULTICAST ;
set group -1 ;
set src -1 ;
set mcast_group_source_id -1 ;
set MULTICAST($mcast_group_source_id,id) $mcast_group_source_id ;
set MULTICAST($mcast_group_source_id,mcast_group) $group ;
set MULTICAST($mcast_group_source_id,mcast_source) $src ;
puts [array size MULTICAST] ;
parray MULTICAST ;
}
array set multicast { } ;
get_mroute_active multicast
puts [array size multicast] ;
parray multicast ;
104.Example for arrays as parameter
proc print12 {array} {
upvar $array a
puts "$a(1), $a(2)"
}
set array(1) "A"
set array(2) "B"
print12 array
105.How to return status from script?
package require Tclx
proc sum {a b} {
keylset retList status 0
set res [expr $a + $b]
if {$res > 5} {
puts pass
keylset retList status 1
} else {
keylset retList status 0
puts fail
keylset retList log $res
}
return $retList
}
set out [sum 1 2]
puts $out
106. How can I tell the difference between a string and a list?
Data structures in Tcl cannot rely on distinguishing between strings and single-element lists. If this is important in your application, you will need to
include some extra flag information in the data structure to distinguish the two cases.
SMALL NOTES:
“” & {}
In case it wasn't clear in the answer,
interpolation means that substitution will happen. If you have a variable named
myvar = "some string", then {a $myvar b} will result in the string
literal "a $myvar b"... while "a $myvar b" will result in
the string literal "a some string b"
subst
%
set S1_ip 10
10
%
set S2_ip 20
20
%
%
foreach dut "1 2" {
puts
[subst $[subst S${dut}_ip]]
}
10
20
%
Back reference
%
set str "hi hello"
hi
hello
%
%
%
regsub {(\w+) (\w+)} $str {\2 \1} new
1
%
puts $new
hello
hi
%
%
regsub {([A-Za-z]+)\s+([A-Za-z]+)} $str {\2 \1} new1
1
%
puts $new1
hello
hi
%
Look ahead
+ve
% set f "test.pl"
test.pl
%
% regexp {.*(?=.pl)} $f file
1
% puts $file
test
%
Look ahead
–ve
%
set t "test.tcl"
test.tcl
%
%
regexp {.*(?!.pl)} $t file1
1
%
puts $file1
test.tcl
%
-inline & -all
Causes the
command to return, as a list, the data that would otherwise be placed in match
variables. When using -inline, match variables may not be specified. If
used with -all, the list will be concatenated at each iteration, such that
a flat list is always returned. For each match iteration, the command will
append the overall match data, plus one element for each subexpression in the
regular expression. Examples are:
regexp -inline
-- {\w(\w)} " inlined "
=> {in n}
regexp -all -inline -- {\w(\w)} " inlined "
=> {in n li i
ne e}
%
set a AppleOrangeBananaStrawberryPeach
AppleOrangeBananaStrawberryPeach
%
regexp -inline -all {[A-Z][a-z]+} $a
Apple
Orange Banana Strawberry Peach
%
Looking for a London courier service? If yes so you are at the right place. Speedy sprint courier service makes finding the right Online Courier service for you easy. As the Best Speedy Sprint Courier across London. We offer a wide range of parcel collection with Same Day Pickup and Same Day Delivery services, including expedited and premium options to ensure maximum flexibility for our customers. Speedy Sprint has to be done as fast and headache-free as feasible so let’s goodbye to search Speedy sprint courier near me.
ReplyDeleteI never have seen articles like this. I meant it's so knowledgeable, informative, and good looking site. I appreciate your hard work. Are you looking for premium hosting then contact us on cheap web hosting in Pakistan 2019 and web hosting companies in Pakistan 2019 . For more information, please visit Domain Host Web .
ReplyDeleteVery good to know programming about tickle
ReplyDeleteThanks for sharing a quality blog, You can visit winstore.pk for online shopping in Pakistan
ReplyDeletemobile on installment
mobile on installment in pakistan
bike on installment lahore
laptop on installment in karachi
Thanks for sharing, please find the below links if you are looking for a best marketing company.
ReplyDeleteTikTok agency ad account
Google Agency ad account
The Shellfish Company Limited exports Irish oysters, Irish mussels, periwinkles, cockles and manila clams. Call us for the best shellfish Ireland produces.
ReplyDeleteIrish shellfish