Rogue Class Linux Download Login

Artifact Content

Artifact 11809247f8752a2f08644bb4f5ebcfd6324967a2:


# underlying proc for the [dict find] command
# [dict find dictionaryValue key defaultValue]
# If the key does not exist, then return the defaultValue
# Otherwise, return the value associated with the key.

proc dictFind {dict name {default {}}} {
    set retval $default
    if {[dict exists $dict $name]} {
        set retval [dict get $dict $name]
    }
    return $retval
}

# register the [dict find] command

proc addDictFind {} {
    set map [namespace ensemble configure dict -map]
    lappend map find dictFind
    namespace ensemble configure dict -map $map
}

# get the contents of a file

proc getFileContents {path} {
    set fh [open $path]
    fconfigure $fh -translation binary
    set retval [read $fh]
    close $fh
    return $retval
}

# nested object property lookup
# [prop obj -opt1 -opt2 -opt3]
# Like obj.opt1.opt2.opt3 object chaining in Javascript

proc prop {obj args} {
    set cur $obj
    if {[llength $args] == 0} {
        error "No property name given"
    }
    foreach {arg} $args {
        set cur [$cur cget $arg]
    }
    return $cur
}


# homebrew mktemp based on http://wiki.tcl.tk/772
proc mktemp {} {
    set path "/tmp/[getGuid]"
    set fd [open $path {CREAT EXCL RDWR} 0600]
    close $fd
    return $path
}

# homebrew GUID generator based on http://wiki.tcl.tk/10871
proc getGuid {} {
    set state [getGuidState]
    set machinfo [dict get $state machinfo]
    set seed [dict get $state seed]
    set machInfo "[expr {rand()}]$seed$machinfo"
    binary scan $machInfo h* machInfoHex
    set idLong "[info cmdcount]$seed$seed"
    set cmdcountAndSeq [string range $idLong 0 8]
    binary scan [expr {rand()}] h* randHex

    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 $cmdcountAndSeq] 0 3] \
        -[string range $randHex 3 6]                       \
        -[string range $machInfoHex 0 11]
    incrGuidSeed

    return [string toupper $guid]
}

proc getGuidState {} {
    if {[info exists ::guidState]} {
        return $::guidState
    }

    set machinfo ""
    append machinfo              \
        $::tcl_platform(user)    \
        [info hostname]          \
        $::tcl_platform(machine) \
        $::tcl_platform(os)
    set ::guidState {
        machinfo $machinfo
        seed     0
    }
    return $::guidState
}

proc incrGuidSeed {} {
    set state [getGuidState]
    dict incr $::guidState seed
}

package provide rclutil 1