punkshell/src/vendormodules/oolib-0.1.tm

#JMN - api should be kept in sync with package patternlib where possible
#
package provide oolib [namespace eval oolib {
    variable version
    set version 0.1
}]

namespace eval oolib {
    oo::class create collection {
        variable o_data ;#dict
        variable o_alias
        constructor {} {
            set o_data [dict create]
        }
        method info {} {
            return [dict info $o_data]
        }
        method count {} {
            return [dict size $o_data]
        }
        method isEmpty {} {
            expr {[dict size $o_data] == 0}
        }
        method names {{globOrIdx {}}} {
            if {[llength $globOrIdx]} {
                if {[string is integer -strict $globOrIdx]} {
                    if {$idx < 0} {
                        set idx "end-[expr {abs($idx + 1)}]"
                    }
                    if {[catch {lindex [dict keys $o_data] $idx} result]} {
                        error "[self object] no such index : '$idx'"
                    } else {
                        return $result
                    }
                } else {
                    #glob
                    return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx]
                }
            } else {
                return [dict keys $o_data]
            }
        }
        #like names but without globbing
        method keys {} {
            dict keys $o_data
        }
        method key {{posn 0}} {
            if {$posn < 0} {
                set posn "end-[expr {abs($posn + 1)}]"
            }
            if {[catch {lindex [dict keys $o_data] $posn} result]} {
                error "[self object] no such index : '$posn'"
            } else {
                return $result
            }
        }
        method hasKey {key} {
            dict exists $o_data $key
        }
        method get {} {
            return $o_data
        }
        method items {} {
            return [dict values $o_data]
        }
        method item {key} {
            if {[string is integer -strict $key]} {
                if {$key > 0} {
                    set valposn [expr {(2*$key) +1}]
                    return [lindex $o_data $valposn]
                } else {
                    set key "end-[expr {abs($key + 1)}]"
                    return [lindex [dict keys $o_data] $key]
                }
            }
            if {[dict exists $o_data $key]} {
                return [dict get $o_data $key]
            }
        }
        #inverse lookup
        method itemKeys {value} {
            set value_indices [lsearch -all [dict values $o_data] $value]
            set keylist [list]
            foreach i $value_indices {
                set idx [expr {(($i + 1) *2) -2}]
                lappend keylist [lindex $o_data $idx]
            }
            return $keylist
        }
        method search {value args} {
            set matches [lsearch {*}$args [dict values $o_data] $value]
            if {"-inline" in $args} {
                return $matches
            } else {
                set keylist [list]
                foreach i $matches {
                    set idx [expr {(($i + 1) *2) -2}]
                    lappend keylist [lindex $o_data $idx]
                }
                return $keylist
            }
        }
        #review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists?
        method alias {newAlias existingKeyOrAlias} {
            if {[string is integer -strict $newAlias]} {
                error "[self object] collection key alias cannot be integer"
            }
            if {[string length $existingKeyOrAlias]} {
                set o_alias($newAlias) $existingKeyOrAlias
            } else {
                unset o_alias($newAlias)
            }
        }
        method aliases {{key ""}} {
            if {[string length $key]} {
                set result [list]
                foreach {n v} [array get o_alias] {
                    if {$v eq $key} {
                        lappend result $n $v
                    }
                }		
                return $result
            } else {
                return [array get o_alias]
            }
        }
        #if the supplied index is an alias, return the underlying key; else return the index supplied.
        method realKey {idx} {
            if {[catch {set o_alias($idx)} key]} {
                return $idx
            } else {
                return $key
            }
        }
        method add {value key} {
            if {[string is integer -strict $key]} {
                error "[self object] collection key must not be an integer. Use another structure if integer keys required"
            }
            if {[dict exists $o_data $key]} {
                error "[self object] col_processors object error: key '$key' already exists in collection"
            }
            dict set o_data $key $value
            return [expr {[dict size $o_data] - 1}] ;#return index of item
        }
        method remove {idx {endRange ""}} {
            if {[string length $endRange]} {
                error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time"
            }
            if {[string is integer -strict $idx]} {
                if {$idx < 0} {
                    set idx "end-[expr {abs($idx+1)}]"
                }
                set key [lindex [dict keys $o_data] $idx]
                set posn $idx
            } else {
                set key $idx
                set posn [lsearch -exact [dict keys $o_data] $key]
                if {$posn < 0} {
                    error "[self object] no such index: '$idx' in this collection"
                }
            }
            dict unset o_data $key
            return
        }
        method clear {} {
            set o_data [dict create]
            return
        }
        method reverse {} {
            set dictnew [dict create]
            foreach k [lreverse [dict keys $o_data]] {
                dict set dictnew $k [dict get $o_data $k]
            }
            set o_data $dictnew
            return
        }
        #review - cmd as list vs cmd as script?
        method map {cmd} {
            set seed [list]
            dict for {k v} $o_data {
                lappend seed [uplevel #0 [list {*}$cmd $v]]
            }
            return $seed
        }
        method objectmap {cmd} {
            set seed [list]
            dict for {k v} $o_data {
                lappend seed [uplevel #0 [list $v {*}$cmd]]
            }
            return $seed
        }
    }

}