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

# Copyright (c) 2020 D. Bohdan.  MIT License.
# Ported from Jimlib: https://gitlab.com/dbohdan/jimlib


namespace eval ulid {
    variable defaultPRNG prng
    variable base32 [split 0123456789ABCDEFGHJKMNPQRSTVWXYZ {}]
}


# Generate a ULID.  See https://wiki.tcl-lang.org/page/ULID.
proc ulid {{t {}} {prng {}}} {
    variable ulid::defaultPRNG

    if {$t eq {}} {
        set t [clock clicks -milliseconds]
    }

    if {$prng eq {}} {
        set prng $defaultPRNG
    }

    return [ulid::encode-time $t 10][ulid::gen-random $prng 16]
}


proc ulid::encode-time {t len} {
    variable base32

    if {$t < 0 || $t > 0xffffffffffff} {
        error [list expected unsigned integer representable in 48 bits\
                    but got $t]
    }

    set result {}
    for {set i 0} {$i < $len} {incr i} {
        set m [expr {$t % 32}]
        set result [lindex $base32 $m]$result
        set t [expr {($t - $m) / 32}]
    }

    return $result
}


proc ulid::gen-random {prng len} {
    variable base32

    set result {}
    for {set i 0} {$i < $len} {incr i} {
        append result [lindex $base32 [eval $prng]]
    }

    return $result
}


proc ulid::prng {} {
    return [expr {int(32 * rand())}]
}


puts [ulid]
puts [ulid 0]