1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
::namespace eval ::tool {}
proc ::tool::is_null value {
return [expr {$value in {{} NULL}}]
}
proc ::tool::uuid_seed args {
if {[llength $args]==0 || ([llength $args]==1 && [is_null [lindex $args 0]])} {
if {[info exists ::env(USERNAME)]} {
set user $::env(USERNAME)
} elseif {[info exists ::env(USER)]} {
set user $::env(USER)
} else {
set user $::env(user)
}
incr ::tool::nextuuid $::tool::globaluuid
set ::tool::UUID_Seed [list user@[info hostname] [clock format [clock seconds]]]
} else {
incr ::tool::globaluuid $::tool::nextuuid
set ::tool::nextuuid 0
set ::tool::UUID_Seed $args
}
}
###
# topic: 0a19b0bfb98162a8a37c1d3bbfb8bc3d
# description:
# Because the tcllib version of uuid generate requires
# network port access (which can be slow), here's a fast
# and dirty rendition
###
proc ::tool::uuid_generate args {
if {![llength $args]} {
set block [list [incr ::tool::nextuuid] {*}$::tool::UUID_Seed]
} else {
set block $args
}
return [::sha1::sha1 -hex [join $block ""]]
}
###
# topic: ee3ec43cc2cc2c7d6cf9a4ef1c345c19
###
proc ::tool::uuid_short args {
if {![llength $args]} {
set block [list [incr ::tool::nextuuid] {*}$::tool::UUID_Seed]
} else {
set block $args
}
return [string range [::sha1::sha1 -hex [join $block ""]] 0 16]
}
###
# topic: b14c505537274904578340ec1bc12af1
# description:
# Implementation the uses a compiled in ::md5 implementation
# commonly used by embedded application developers
###
namespace eval ::tool {
namespace export *
}
###
# Cache the bits of the UUID seed that aren't likely to change
# once the software is loaded, but which can be expensive to
# generate
###
set ::tool::nextuuid 0
set ::tool::globaluuid 0
::tool::uuid_seed
|
