Posted to tcl by dbohdan at Sun Oct 04 09:02:45 GMT 2020view raw

  1. # Copyright (c) 2020 D. Bohdan. MIT License.
  2. # Ported from Jimlib: https://gitlab.com/dbohdan/jimlib
  3.  
  4.  
  5. namespace eval ulid {
  6. variable defaultPRNG prng
  7. variable base32 [split 0123456789ABCDEFGHJKMNPQRSTVWXYZ {}]
  8. }
  9.  
  10.  
  11. # Generate a ULID. See https://wiki.tcl-lang.org/page/ULID.
  12. proc ulid {{t {}} {prng {}}} {
  13. variable ulid::defaultPRNG
  14.  
  15. if {$t eq {}} {
  16. set t [clock clicks -milliseconds]
  17. }
  18.  
  19. if {$prng eq {}} {
  20. set prng $defaultPRNG
  21. }
  22.  
  23. return [ulid::encode-time $t 10][ulid::gen-random $prng 16]
  24. }
  25.  
  26.  
  27. proc ulid::encode-time {t len} {
  28. variable base32
  29.  
  30. if {$t < 0 || $t > 0xffffffffffff} {
  31. error [list expected unsigned integer representable in 48 bits\
  32. but got $t]
  33. }
  34.  
  35. set result {}
  36. for {set i 0} {$i < $len} {incr i} {
  37. set m [expr {$t % 32}]
  38. set result [lindex $base32 $m]$result
  39. set t [expr {($t - $m) / 32}]
  40. }
  41.  
  42. return $result
  43. }
  44.  
  45.  
  46. proc ulid::gen-random {prng len} {
  47. variable base32
  48.  
  49. set result {}
  50. for {set i 0} {$i < $len} {incr i} {
  51. append result [lindex $base32 [eval $prng]]
  52. }
  53.  
  54. return $result
  55. }
  56.  
  57.  
  58. proc ulid::prng {} {
  59. return [expr {int(32 * rand())}]
  60. }
  61.  
  62.  
  63. puts [ulid]
  64. puts [ulid 0]