PYK 2016-01-29: Warning: This implementation uses info hostname, or exec ipconfig on Windows. I was once offline and a program of mine was hanging. This package turned out to be the culprit.Alternatives to the Tcllib UUID package edit
Damon Courtney's
Windows provides an API for generating GUIDs and some extensions make use of this, but I needed a pure-Tcl UUID generator. So, I came up with this. This proc, by no means, conforms to the standards discussed in the above document, but it does produce unique* identifiers that are good enough for me. :) Damon Courtney
proc uuid {} {
## Try and get a string unique to this host.
set str [info hostname]$::tcl_platform(machine)$::tcl_platform(os)
binary scan $str h* hex
set uuid [format %2.2x [clock seconds]]
append uuid -[string range [format %2.2x [clock clicks]] 0 3]
append uuid -[string range [format %2.2x [clock clicks]] 2 5]
append uuid -[string range [format %2.2x [clock clicks]] 4 end]
append uuid -[string range $hex 0 11]
return $uuid
}
proc guid {} {
## Return a GUID for Windows, which is just an uppercase UUID with braces.
return \{[string toupper [uuid]]\}
}*JMN 2005-11-26 Note that the above 'guid' function does not produce unique values for quick successive calls.e.g using the following script, you will most likely get the same value in a, b & c.
foreach {a b c} [list [guid] [guid] [guid]] {break}For a result that is more likely to be unique - you may want to add a call to [expr {rand()}] or similar.Cecil Westerhof's
See Get UUID on *NIX.Napier's
Napier - I also ran into the uuid tcllib package being fairly slow on some machines. Upgrading in this case is not always an option. I wanted something lightweight but also something that would be useable in URL's and/or simple enough to be shared with a user (like for link codes the user may copy and paste). I tried to calculate a few pieces that would greatly improve the odds of an id not matching any other. In my case it's not the end of the world if there is some match at some time between multiple scripts building sessions. This should also be fairly performant. I am sure a few places I could make more efficient, but it does what I need :)namespace eval ::shortid { variable i 0; variable n 1 }
proc ::shortid::rand {min max} { expr { int( rand() * ( $max - $min + 1 ) + $min )} }
proc ::shortid::shuffle { list {max {}}} {
set l1 {}; set l2 {}; set l3 {}; set l4 {}
foreach le $list[set list {}] {
if {rand()<.5} {
if {rand()<.5} { lappend l1 $le } else { lappend l2 $le }
} {
if {rand()<.5} { lappend l3 $le } else { lappend l4 $le }
}
if {$max ne {} && [incr i] >= $max } { break }
}
return [concat $l1 $l2 $l3 $l4]
}
proc ::shortid::shuffle_string { str {max {}} } { join [shuffle [split $str {}] $max] {} }
proc ::shortid::generate { {max_length 8} } {
set i [incr [namespace current]::i]
lassign [shuffle [list 1 2 3 4]] 1 2 3 4
set clicks [clock clicks]
set cmds [string map { {=} {} } [binary encode base64 [join [shuffle [info commands] 20] {}]]]
set cl [expr { [string length $cmds] - 5 }]
set c1 [rand $1 $cl]; set c2 [rand $3 $cl]
set uuid [shuffle_string [format {%s%s%s} \
[ string range $cmds $c1 [expr { $c1 + 1 }] ] \
[ string range $cmds $c2 [expr { $c2 + 1 }] ] \
[ pid ]
] 4]
switch -- $1 {
1 { set op1 [incr [namespace current]::n]${i}$::tcl_platform(os)$::tcl_platform(osVersion) }
2 { set op1 $::tcl_platform(machine)${i}$::tcl_platform(user)[incr [namespace current]::n] }
3 { set op1 [shuffle_string [expr { int( rand() * [info cmdcount] * $1 ) }] 25] }
4 { set op1 $cmds }
}
switch -- $2 {
1 { set op2 ${i}$::tcl_platform(os)[incr [namespace current]::n]$::tcl_platform(osVersion) }
2 { set op2 [incr [namespace current]::n]$::tcl_platform(machine)$::tcl_platform(user)${i} }
3 { set op2 [shuffle_string [expr { int( rand() * [info cmdcount] * $2 ) }] 25] }
4 { set op2 $cmds }
}
lassign [shuffle [list 1 2 3 4]] 1 2 3 4
binary scan [ format {%s%s} \
[string range $op1 $3 [expr { $3 + 10 }]] [string range $op2 $2 [expr { $2 + 10 }]] \
] [expr { $1 >= 3 ? "h" : "H" }]* h1
binary scan [ format {%s%s} \
[string range $op2 $1 [expr { $1 + 10 }]] [string range $op1 $4 [expr { $4 + 10 }]] \
] [expr { $2 <= 2 ? "h" : "H" }]* h2
append uuid [ shuffle_string \
[ format {%s%s%s} $h1 $h2 [ string map { {=} {} } \
[binary encode base64 [format {%s%s} $i [string range $clicks 9 15]]]
] ] \
[ expr { $max_length - [string length $uuid] }] ]
return $uuid
}
proc shortid { {max_length 8} } { tailcall ::shortid::generate $max_length }This will generate short id's of the given length (8 characters by default). You can provide the max length desired and we will attempt to fill it to a point. Personally I never need much more than 8 so some changes would be needed to allow more.% shortid RnVy3878 % shortid VrmZ8757 % shortid dWWxf353 % shortid 16 ZkndjEe657N63w83
Scott Beasley's
Scott BeasleyI needed a working GUID generator that would be Multi Platform, generate unique id's, fast and in pure tcl. The Below code is what I came up with. I tried to use the tclib uuid, but it was just to slow for my needs and I could not ensure a critcl based compile on the hundreds of machines the code would run on. While posting this, I saw that the uuid proc above has some sameness :p Just a coincidence, only so many ways to do something simple I guess. This code has been tested and run on Windows XP, 2000-2003, Linux, FreeBSD and Mac OS X. It has generated over 400 million GUIDS without a dup in testing. I'm not guaranteeing anything though :)To use, just call the guid_init to setup the seed and machine info before you call the guid proc.
proc guid_init { } {
if {![info exists ::GuiD__SeEd__VaR]} {
set ::GuiD__SeEd__VaR 0
}
if {![info exists ::GuiD__MaChInFo__VaR]} {
set ::GuiD__MaChInFo__VaR $::tcl_platform(user)[info hostname]$::tcl_platform(machine)$::tcl_platform(os)
}
}
proc guid { } {
# String together the Seed and Machine Info along with a random number for a end base.
set MachInfo [expr {rand()}]$::GuiD__SeEd__VaR$::GuiD__MaChInFo__VaR
binary scan $MachInfo h* MachInfo_Hex
# Set the first part as the datetime in seconds.
set guid [format %2.2x [clock seconds]]
# Pick though clock clicks for a good "Random" sequence.
append guid -[string range [format %2.2x [clock clicks]] 0 3] \
-[string range [format %2.2x [clock clicks]] 1 4] \
-[string range [format %2.2x [clock clicks]] 4 end] \
-[string range $MachInfo_Hex 0 11]
incr ::GuiD__SeEd__VaR
return [string toupper $guid]
}Scott Beasley 2008-06-05: Per a Text exchange with Mr. Lars H I have thrown info cmdcount into the mix to hopefully help out on older machines in regards to uniqueness. The Above seems to work fine on newer faster (2001 onward) machines, this one on older (Year 2000 and before). This is still a work in progress.
proc guid { } {
set MachInfo [expr {rand()}]$::GuiD__SeEd__VaR$::GuiD__MaChInFo__VaR
binary scan $MachInfo h* MachInfo_Hex
set CmdCntAndSeq [string range "[info cmdcount]$::GuiD__SeEd__VaR$::GuiD__SeEd__VaR" 0 8]
binary scan [expr {rand()}] h* Rand_Hex
set guid [format %2.2x [clock seconds]]
# Pick though clock clicks for a good sequence.
append guid -[string range [format %2.2x [clock clicks]] 0 3] \
-[string range [format %2.2x $CmdCntAndSeq] 0 3] \
-[string range $Rand_Hex 3 6] \
-[string range $MachInfo_Hex 0 11]
incr ::GuiD__SeEd__VaR
return [string toupper $guid]
}Scott Nichols'
See TclGetGUID.TWAPI
On Windows. The discussion below shows a use example.ULID
Does not use the host information as a seed.SQLite
de 2018-09-27: If your application is using sqlite anyways this seems to be also pretty fast (and a bit faster as building up the formating of the uuid with SQL):proc uuid {} {
set u [<yourdb> onecolumn {select (hex(randomblob(16)))}]
return [string range $u 0 7]-[string range $u 8 11]-[string range $u 12 15]-[string range $u 16 19]-[string range $u 20 end]
}Discussion edit
PT 8-Jul-2004: I have just added a UUID module to tcllib that implements type 4 uuids from the draft specification document. eg: % package require uuid
1.0.0
% set id [uuid::uuid generate]
140d7c2c-4502-4144-6ae0-a4692e8ed819
% if {[uuid::uuid equal $id $id]} { puts "ids equal" }JMN 2005-11-26. On one of my windows machines - UUID version 1.0.0 calls to [uuid:uuid generate] take around 4.5 seconds to complete. This makes the function impractical for most uses. The delay seems to occur in a call to 'fconfigure <somesocket> -sockname'. I don't know if it's a peculiarity of my machine's network configuration or not - but even so it seems to me that this tcllib package should avoid calls that may take such a relatively long time.PT 2005-11-27: you should raise a bug report on sourceforge if you have not already done so. My answer is that some time before the tcllib 1.8 release we stopped using information from the socket call because it can be a problem when the XP firewall is in place. Obtain uuid 1.0.1. A second method it to use ActiveTcl or build the critcl extensions for tcllib. The uuid package includes critcl code which it will use if it can and this calls directly to the Win32 UuidCreate API.Scott NicholsI wrote a Windows C based Tcl extension for this (TclGetGUID) a few months back, and Pat helped by recommending the use of the Tcl C API call Tcl_UtfToUpper for converting a string to uppercase. The C source is really short and simple. It simply calls some underlying Windows APIs.
DKF: Don't forget to include planet and stellar system identifiers in that UUID... :^D
NEB: 2010-03-24 I'm new to TCL, so take this all with a grain of salt: I needed a way to format GUIDs pulled from LDAP, and puts them. Unfortunately, they dump as binary, so I needed to format them to a string. I couldn't find a way in the ldap modules, but did find the uuid module in tcllib. Unfortunately, although I can dig in and use ::uuid::tostring (once I found it) it doesn't format in the proper sequence. It seems to just take the array of bytes, and hexify them. GUIDS (at least on Windows) store the first three blocks smaller-byte-first. Note that tcllib's version should be perfectly sufficient for a generated UUID... it should be just as 'random' as if they were in the 'correct' order; but it will show the wrong string if you pass an existing binary GUID through it.Here is an example, along with a procedure of my solution:
# HKEY_CLASSES_ROOT\device\CLSID
# Device = {4315D437-5B8C-11D0-BD3B-00A0C911CE86}
# Prog ID from CLSID dumped to a byte array:
# \x37\xD4\x15\x43\x8C\x5B\xD0\x11\xBD\x3B\x0\xA0\xC9\x11\xCE\x86
set binGuid \x37\xD4\x15\x43\x8C\x5B\xD0\x11\xBD\x3B\x0\xA0\xC9\x11\xCE\x86
puts "binGuid=$binGuid"
puts "String GUID Should be\n{4315D437-5B8C-11D0-BD3B-00A0C911CE86}\n"
proc GUID2String { guid } {
if {[binary scan "$guid" iu1su1su1Su1Iu1Su1 p0 p1 p2 p3 p4 p5]==6} {
return [format "{%08X-%04X-%04X-%04X-%08X%04X}" $p0 $p1 $p2 $p3 $p4 $p5]
}
}
puts "Binary scan conversions:"
puts [GUID2String \x37\xD4\x15\x43\x8C\x5B\xD0\x11\xBD\x3B\x0\xA0\xC9\x11\xCE\x86]
puts [GUID2String $binGuid]
puts "Via the tcllib::uuid conversion:"
package require Tcl
package require uuid
puts "\{[::uuid::tostring \x37\xD4\x15\x43\x8C\x5B\xD0\x11\xBD\x3B\x0\xA0\xC9\x11\xCE\x86]\}"I was going to pull a given GUID from the system, and pass the binary through, but that doesn't seem to be working for me. The code below prints two strings--although the API calls should both return a struct. Notably, the second one returns what I put into it (!) so either I am doing something wrong (highly likely) or it isn't a straight pass-through as the website led me to believe.
puts "Grabbing Class ID"
package require twapi
puts [::twapi::CLSIDFromProgID Device]
puts [::twapi::CLSIDFromString "{4315D437-5B8C-11D0-BD3B-00A0C911CE86}"]I'll know more as I figure out how to read the source . . .APE: 2013-10-08 ...and the way to generate uuids with twapi (this one is very fast: 4 ms to generate 1000 uuids) ::twapi::new_uuid or ::twapi::new_guid which differ slightly in their return format. Both call into the Windows API discussed above.
