#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 } } }