To manipulate Strings in Tcl, we use the string command.
If you need to replace comma:
set value { 10.00 }
puts [string map -nocase { . , } $value]
# Return: 10,00
We can replace several strings:
set text "This is a replacement test text"
puts [string map -nocase { e E s S a A } $text]
# Returns: THIS IS A TEXT OF REPLACEMENT TEST
Of course, we can replace words:
set text "This is a replacement test text"
puts [string map -nocase {test TEST a {second}} $text]
# Returns: This is the second replacement TEST text.
So far so good!
But one question that does not want to be silent is .. How to replace more than one identical occurrence in the sentence, giving a DIFFERENT substitution for each of them?
For example:
set time {10:02:12}
puts [string map -nocase { { : +} {: =} } $time]
I would like this result: 10 + 02 = 12
proc seqmap {str match args} {
set rc $str
foreach l [lreverse [regexp -all -indices -inline ***=$match $str]] \
replacement [lreverse $args] {
set rc [string replace $rc {*}$l $replacement]
}
return $rc
}
seqmap 10:02:12 : { + } { = }
=> 10 + 02 = 12
I'm using lreverse in case the replacement has a different length than the string it replaces. The indices would be off if the replacements were done from left to right.
The ***= is used to avoid special treatment of wildcard characters in the match string.
Of course, things get a lot more complicated if you want to handle the case where the number of occurrences doesn't match the number of provided substitutions. And even more if you want to replace several different strings.
This version handles the complications mentioned above:
proc seqmap {map str} {
# Transform the map into a dict with each key containing a list of replacements
set mapdict {}
foreach {s r} $map {dict lappend mapdict $s $r}
# Build a map where each key maps to a unique tag
# At the same time build a dict that maps our tags to the replacements
# First map the chosen tag character in case it is present in the string
set newmap {# #00}
set mapdict [dict map {s r} $mapdict {
lappend newmap $s [set s [format #%02d [incr num]]]
set r
}]
# Add the tag character to the dict so it can be mapped back
dict set mapdict #00 #
# Map the tags into the string
set rc [string map $newmap $str]
# Locate the positions where the tags ended up
set match [regexp -all -indices -inline {#\d\d} $rc]
# Create a list of replacements matching the tags
set replace [lmap l $match {
# Extract the tag
set t [string range $rc {*}$l]
# Obtain a replacement for this tag
set s [lassign [dict get $mapdict $t] r]
# Return the used replacement to the end of the list
dict set mapdict $t [linsert $s end $r]
# Add the replacement to the list
set r
}]
# Walk the two lists in reverse order, replacing the tags with the selected replacements
foreach l [lreverse $match] r [lreverse $replace] {
set rc [string replace $rc {*}$l $r]
}
# Done
return $rc
}
You call it just like you would string map, so with a key-value mapping and the string to perform the replacements on. Any duplicated keys specify the subsequent values to be substituted for each occurrence of the key. When the list is exhausted it starts over from the beginning.
So puts [seqmap {: + : = : *} 10:02:12] => 10+02=12
And puts [seqmap {: + : =} 10:02:12:04:16] => 10+02=12+04=16
As presented, the command can handle up to 99 unique keys. But it can easily be updated if more are needed.
I'd like to automatically convert URLs, i.e
"https://sc-uat.ct.example.com/sc/" into "https://invbeta.example.com/sc/"
"https://sc-dev.ct.example.com/sc/" into "https://invtest.example.com/sc/"
"https://sc-qa.ct.example.com/sc/" into "https://invdemo.example.com/sc/"
I've tried following code snippet in TCL
set loc "https://sc-uat.ct.example.com/sc/"
set envs(dev) "test"
set envs(uat) "beta"
set envs(qa) "demo"
puts $envs(uat)
regsub -nocase {://.+-(.+).ct.example.com} $loc {://inv[$envs(\1)].example.com} hostname
puts "new location = $hostname"
But the result is: new location = https://inv[$envs(uat)].example.com/sc/
It seems that [$envs(uat)] is NOT evaluated and substituted further with the real value. Any hints will be appreciated. Thanks in advance
But the result is: new location =
https://inv[$envs(uat)].example.com/sc/ It seems that [$envs(uat)] is eval-ed further.
You meant to say: [$envs(uat)] is not evaluated further?
This is because due to the curly braces in {://inv[$envs(\1)].example.com}, the drop-in string is taken literally, and not subjected to variable or command substitution. Besides, you don't want command and variable substitution ([$envs(\1)]), just one of them: $envs(\1) or [set envs(\1)].
To overcome this, you must treat the regsub-processed string further via subst:
set hostname [subst -nocommands -nobackslashes [regsub -nocase {://.+-(.+).ct.example.com} $loc {://inv$envs(\1).example.com}]]
Suggestions for improvement
I advise to avoid the use of subst in this context, because even when restricted, you might run into conflicts with characters special to Tcl in your hostnames (e.g., brackets in the IPv6 authority parts). Either you have to sanitize the loc string before, or, better work on string ranges like so:
if {[regexp -indices {://(.+-(.+)).ct.example.com} $loc _ replaceRange keyRange]} {
set key [string range $loc {*}$keyRange]
set sub [string cat "inv" $envs($key)]
set hostname [string replace $loc {*}$replaceRange $sub]
}
The challange is to change user's AD passwort.
I have a TCL Script wrapping ldapmodify to set the passcode, which works:
set unicodePwd [encodePw4ad $pw]
lappend text {dn: $dn}
lappend text {changetype: modify}
lappend text {replace: unicodePwd}
lappend text {unicodePwd:: $unicodePwd}
lappend text {-}
set fn /tmp/ldiff.[clock microseconds].ldif
write_file $fn [subst [join $text \n]]
.....
exec ldapmodify -H $host -D $binddn -x -w $bindpw -f $fn
Using TCL 8.6 with LDAP 1.9.2 Package the code looks:
set unicodePwd [encodePw4ad $pw]
set handle [::ldap::secure_connect $host 636 0]
ldap::bind $handle $binddn $bindpw
#ldap::modify $handle $dn [list postalCode 123456]
ldap::modify $handle $dn [list unicodePwd $unicodePwd]
ldap::unbind $handle
ldap::disconnect $handle
This works for the "postalCode" but not for the "unicodePwd".
LDAP error unwillingToPerform '': 0000001F: SvcErr: DSID-031A12D2, problem 5003 (WILL_NOT_PERFORM), data 0
Any hint to investigate?
I cannot test this (as I don't have a the environment available), but following this quote ...
The syntax of the unicodePwd attribute is octet-string; however, the
directory service expects that the octet-string will contain a UNICODE
string (as the name of the attribute indicates). This means that any
values for this attribute passed in LDAP must be UNICODE strings that
are BER-encoded (Basic Encoding Rules) as an octet-string. In
addition, the UNICODE string must begin and end in quotes that are not
part of the desired password.
from https://support.microsoft.com/en-gb/help/269190/how-to-change-a-windows-active-directory-and-lds-user-password-through
... the value for the unicodePwd record entry must be formatted as follows in Tcl (>= 8.6):
set pwd "abc123"
set pwd [string cat \" $pwd \"]; # must begin/ end in quotes
set pwd [encoding convertto unicode $pwd]; # UNICODE (UTF-16LE) string
set unicodePwd [binary encode base64 $pwd]; # base64 encoded variant
NB: You can watch that the resulting string from [encoding convertto unicode $pwd] using 2 bytes per character (16 bytes for "abc123" incl. quotes), or just eight if you were using the utf-8 or whatever, when running [string length] at the different steps.
Problem found:
ldapmodify uses 'unicodePwd::'. The '::' tells the AD, that the value is base64 encoded.
in TCL ldap::modify 'unicodePwd' has to be send in unicode only (no base64).
We did find a way to send base64 via the TCL ldap::modify
I am forced to use TCL for something and I need to create a json string like this:
{ "mainKey": "mainValue", "subKey": [{"key1":"value1"},{"key2":"value2"}]}
So I am trying to do this:
set subDict1 [dict create key1 value1]
set subDict2 [dict create key2 value2]
set subDictList [list $subDict1 $subDict2]
set finalDict [dict create mainKey mainValue subKey $subDictList]
When I convert this dict to json, I get:
{"mainKey":"mainValue", "subKey":{"key1 value1":{"key2":"value2"}}}
instead of the required:
{ "mainKey": "mainValue", "subKey": [{"key1":"value1"},{"key2":"value2"}]}
What am I doing wrong?
First you have to understand that TCL is a very typeless language. What exactly are list and dicts in tcl?
In Tcl a list is a string that is properly formatted where each member of the list is separated by spaces (space, tab or newline) and if the data contained by an item contains spaces they can be escaped either by:
using backslash escaping:
"this is a list\ of\ four\ items"
using "" grouping:
{this is a "list of four items"}
using {} grouping:
{this is a {list of four items}}
Note that internally, once a string has been parsed as a list, Tcl uses a different internal data structure to store the list for speed. But semantically it is still a string. Just like HTML is a specially formatted string or JSON is a specially formatted string Tcl takes the attitude that lists are nothing but specially formatted strings.
So, what are dicts? In Tcl dicts are lists with even number of elements. That's it. Nothing special. A dict is therefore also semantically a string (though as mentioned above, once tcl sees you using that string as a dict it will compile it to a different data structure for optimizing speed).
Note again the core philosophy in tcl: almost all data structures (with the exception of arrays) are merely strings that happens to be formatted in a way that has special meaning.
This is the reason you can't auto-convert tcl data structures to JSON - if you ask Tcl to guess what the data structure is you end up with whatever the programmer who wrote the guessing function want it to be. In your case it looks like it defaults to always detecting lists with even number of elements as dicts.
So how can you generate JSON correctly?
There are several ways to do this. You can of course use custom dedicated for loops or functions to convert your data structure (which again, is just a specially formatted string) to JSON.
Several years ago I've written this JSON compiler:
# data is plain old tcl values
# spec is defined as follows:
# {string} - data is simply a string, "quote" it if it's not a number
# {list} - data is a tcl list of strings, convert to JSON arrays
# {list list} - data is a tcl list of lists
# {list dict} - data is a tcl list of dicts
# {dict} - data is a tcl dict of strings
# {dict xx list} - data is a tcl dict where the value of key xx is a tcl list
# {dict * list} - data is a tcl dict of lists
# etc..
proc compile_json {spec data} {
while [llength $spec] {
set type [lindex $spec 0]
set spec [lrange $spec 1 end]
switch -- $type {
dict {
lappend spec * string
set json {}
foreach {key val} $data {
foreach {keymatch valtype} $spec {
if {[string match $keymatch $key]} {
lappend json [subst {"$key":[
compile_json $valtype $val]}]
break
}
}
}
return "{[join $json ,]}"
}
list {
if {![llength $spec]} {
set spec string
} else {
set spec [lindex $spec 0]
}
set json {}
foreach {val} $data {
lappend json [compile_json $spec $val]
}
return "\[[join $json ,]\]"
}
string {
if {[string is double -strict $data]} {
return $data
} else {
return "\"$data\""
}
}
default {error "Invalid type"}
}
}
}
(See http://wiki.tcl.tk/JSON for the original implementation and discussion of JSON parsing)
Because tcl can never correctly guess what your "string" is I've opted to supply a format string to the function in order to correctly interpret tcl data structures. For example, using the function above to compile your dict you'd call it like this:
compile_json {dict subKey list} finalDict
I've begged the tcllib maintainers to steal my code because I still believe it's the correct way to handle JSON in tcl but so far it's still not in tcllib.
BTW: I license the code above as public domain and you or anyone may claim full authorship of it if you wish.
It's not completely wrong to say that Tcl is a typeless language, because the types of the data objects in a Tcl program aren't expressed fully in the code, and not always even in the Tcl_Obj structures that represent data objects internally. Still, types are certainly not absent from a Tcl program, it's just that the type system is a lot less intrusive in Tcl than in most other programming languages.
The complete type definition in a Tcl program emerges from a dynamic combination of code and data objects as the program executes. The interpreter trusts you to tell it how you want your data objects to behave.
As an example, consider the following string:
set s {title: Mr. name: Peter surname: Lewerin}
Is this a string, an array, or a dictionary? All of the above, actually. (At least it's not an integer, a double or a boolean, other possible Tcl types.)
Using this string, I can answer a number of questions:
Tell me about your name
puts $s
# => title: Mr. name: Peter surname: Lewerin
What do polite people call you?
puts [dict values $s]
# => Mr. Peter Lewerin
What was your last name again?
puts [lindex $s end]
# => Lewerin
Here, I used the same string as a string, as a dictionary, and as an array. The same string representation was used for all three types of object, and it was the operations I used on it that determined the type of the object in that precise moment.
Similarly, the literal 1 can mean the integer 1, the single-character string 1, or boolean truth. There is no way to specify which kind of 1 you mean, but there is no need either, since the interpreter won't complain about the ambiguity.
Because Tcl doesn't store complete type information, it's quite hard to serialize arbitrary collections of data objects. That doesn't mean Tcl can't play well with serialization, though: you just need to add annotations to your data.
This string:
di [dm [st mainKey] [st mainValue]] [dm [st subKey] [ar [di [dm [st key1] [st value1]]] [di [dm [st key2] [st value2]]]]]
can be fed into the Tcl interpreter, and given the proper definitions of di, dm, st, and ar (which I intend to signify "dictionary", "dictionary member", "string", and "array", respectively), I can have the string construct a dictionary structure equivalent to the one in the question, or the string representation of such an object, just a bare list of keys and values, or XML, or JSON, etc. By using namespaces and/or slave interpreters, I can even dynamically switch between various forms. I won't provide examples for all forms, just JSON:
proc di args {return "{[join $args {, }]}"}
proc st val {return "\"$val\""}
proc ar args {return "\[[join $args {, }]]"}
proc dm {k v} {return "$k: $v"}
The output becomes:
{"mainKey": "mainValue", "subKey": [{"key1": "value1"}, {"key2": "value2"}]}
This example used the command nesting of the Tcl interpreter to define the structure of the data. Tcl doesn't need even that: a list of token classes and tokens such as a scanner would emit will suffice:
< : ' mainKey ' mainValue : ' subKey ( < : ' key1 ' value1 > < : ' key2 ' value2 > ) >
Using these simple commands:
proc jsonparseseq {endtok args} {
set seq [list]
while {[lsearch $args $endtok] > 0} {
lassign [jsonparseexpr {*}$args] args expr
lappend seq $expr
}
list [lassign $args -] $seq
}
proc jsonparseexpr args {
set args [lassign $args token]
switch -- $token {
' {
set args [lassign $args str]
set json \"$str\"
}
: {
lassign [jsonparseexpr {*}$args] args key
lassign [jsonparseexpr {*}$args] args val
set json "$key: $val"
}
< {
lassign [jsonparseseq > {*}$args] args dict
set json "{[join $dict {, }]}"
}
( {
lassign [jsonparseseq ) {*}$args] args arr
set json "\[[join $arr {, }]]"
}
}
list $args $json
}
proc jsonparse args {
lindex [jsonparseexpr {*}$args] end
}
I can parse that stream of token classes (<, (, ', :, ), >) and tokens into the same JSON string as above:
jsonparse < : ' mainKey ' mainValue : ' subKey ( < : ' key1 ' value1 > < : ' key2 ' value2 > ) >
# -> {"mainKey": "mainValue", "subKey": [{"key1": "value1"}, {"key2": "value2"}]}
Tcl offers quite a lot of flexibility; few languages will be as responsive to the programmer's whim as Tcl.
For completeness I will also demonstrate using the Tcllib huddle package mentioned by slebetman to create a the kind of structure mentioned in the question, and serialize that into JSON:
package require huddle
# -> 0.1.5
set subDict1 [huddle create key1 value1]
# -> HUDDLE {D {key1 {s value1}}}
set subDict2 [huddle create key2 value2]
# -> HUDDLE {D {key2 {s value2}}}
set subDictList [huddle list $subDict1 $subDict2]
# -> HUDDLE {L {{D {key1 {s value1}}} {D {key2 {s value2}}}}}
set finalDict [huddle create mainKey mainValue subKey $subDictList]
# -> HUDDLE {D {mainKey {s mainValue} subKey {L {{D {key1 {s value1}}} {D {key2 {s value2}}}}}}}
huddle jsondump $finalDict {} {}
# -> {"mainKey":"mainValue","subKey":[{"key1":"value1"},{"key2":"value2"}]}
Another approach is to create regular Tcl structures and convert ("compile") them to huddle data according to a type specification:
set subDict1 [dict create key1 value1]
set subDict2 [dict create key2 value2]
set subDictList [list $subDict1 $subDict2]
set finalDict [dict create mainKey mainValue subKey $subDictList]
huddle compile {dict mainKey string subKey {list {dict * string}}} $finalDict
The result of the last command is the same as of the last huddle create command in the previous example.
Documentation: dict, join, lappend, lassign, lindex, list, lsearch, proc, puts, return, set, switch, while
I was using the command 'string trimright' to trim my string but I found that this command trims more than required.
My expression is "dssss.dcsss" If I use string trim command to trim the last few characters ".dcsss", it trims the entire string. How can I deal with this?
Command:
set a [string trimright "dcssss.dcsss" ".dcsss"]
puts $a
Intended output:
dcsss
Actual output
""
The string trimright command treats its (optional) last argument as a set of characters to remove (and so .dcsss is the same as sdc. to it), just like string trim and string trimleft do; indeed, string trim is just like using both string trimright and string trimleft in succession. This makes it unsuitable for what you are trying to do; to remove a suffix if it is present, you can use several techniques:
# It looks like we're stripping a filename extension...
puts [file rootname "dcssss.dcsss"]
# Can use a regular expression if we're careful...
puts [regsub {\.dcsss$} "dcssss.dcsss" {}]
# Do everything by hand...
set str "dcssss.dcsss"
if {[string match "*.dcsss" $str]} {
set str [string range $str 0 end-6]
}
puts $str
If what you're doing really is filename manipulation, like it looks like, do use the first of these options. The file command has some really useful commands for working with filenames in a cross-platform manner in it.