| [3330] | 1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
|---|
| [11] | 2 | # ---------------------------------------------------------------------- |
|---|
| 3 | # COMPONENT: tuples - represents a series of tuples for arbitrary data |
|---|
| 4 | # |
|---|
| 5 | # This object represents a series of tuples. Each tuple can contain |
|---|
| 6 | # one or more elements--for example, (a) or (a,b,c). Each column |
|---|
| 7 | # in the tuple has a well-defined name and metadata. Columns can |
|---|
| 8 | # be added even after data has been stored in the tuple list. |
|---|
| 9 | # ====================================================================== |
|---|
| 10 | # AUTHOR: Michael McLennan, Purdue University |
|---|
| [3177] | 11 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
|---|
| [115] | 12 | # |
|---|
| 13 | # See the file "license.terms" for information on usage and |
|---|
| 14 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
|---|
| [11] | 15 | # ====================================================================== |
|---|
| 16 | package require Itcl |
|---|
| 17 | |
|---|
| 18 | itcl::class Rappture::Tuples { |
|---|
| 19 | constructor {args} { # defined below } |
|---|
| 20 | |
|---|
| 21 | public method column {option args} |
|---|
| 22 | public method insert {pos args} |
|---|
| 23 | public method delete {{from ""} {to ""}} |
|---|
| 24 | public method put {args} |
|---|
| 25 | public method get {args} |
|---|
| 26 | public method find {args} |
|---|
| 27 | public method size {} |
|---|
| 28 | |
|---|
| 29 | protected method _range {{from ""} {to ""}} |
|---|
| 30 | |
|---|
| 31 | private variable _colnames "" ;# list of column names |
|---|
| 32 | private variable _col2info ;# maps column name => column options |
|---|
| 33 | private variable _tuples ;# maps index => tuple data |
|---|
| 34 | |
|---|
| 35 | private common _counter 0 ;# for auto-generated column names |
|---|
| 36 | } |
|---|
| [1929] | 37 | |
|---|
| [11] | 38 | # ---------------------------------------------------------------------- |
|---|
| 39 | # CONSTRUCTOR |
|---|
| 40 | # ---------------------------------------------------------------------- |
|---|
| 41 | itcl::body Rappture::Tuples::constructor {args} { |
|---|
| 42 | eval configure $args |
|---|
| 43 | } |
|---|
| 44 | |
|---|
| 45 | # ---------------------------------------------------------------------- |
|---|
| 46 | # USAGE: column insert <pos> ?-name n? ?-label l? ?-default v? |
|---|
| 47 | # USAGE: column delete ?<name> <name>...? |
|---|
| 48 | # USAGE: column names ?<pattern>? |
|---|
| 49 | # USAGE: column info <name> |
|---|
| 50 | # |
|---|
| 51 | # Used by clients to manipulate the columns associated with this |
|---|
| 52 | # list of tuples. Each column is identified by a short name. If |
|---|
| 53 | # a name is not supplied when the column is created, then one is |
|---|
| 54 | # generated automatically. The column names can be queried back |
|---|
| 55 | # in the order they appear in a tuple by using the "column names" |
|---|
| 56 | # command. |
|---|
| 57 | # ---------------------------------------------------------------------- |
|---|
| 58 | itcl::body Rappture::Tuples::column {option args} { |
|---|
| 59 | switch -- $option { |
|---|
| [1929] | 60 | insert { |
|---|
| 61 | # parse the incoming args |
|---|
| 62 | if {[llength $args] < 1} { |
|---|
| 63 | error "wrong # args: should be \"column insert pos ?-name n? ?-label l? ?-default v?\"" |
|---|
| 64 | } |
|---|
| 65 | set pos [lindex $args 0] |
|---|
| 66 | set args [lrange $args 1 end] |
|---|
| 67 | Rappture::getopts args params { |
|---|
| 68 | value -name #auto |
|---|
| 69 | value -label "" |
|---|
| 70 | value -default "" |
|---|
| 71 | } |
|---|
| [4512] | 72 | |
|---|
| 73 | # FIXME: This is a band-aid. The value can be an arbitrary |
|---|
| 74 | # string and therefore misinterpretered as an invalid list. |
|---|
| 75 | # Try to parse the value as a list and if that fails make a |
|---|
| 76 | # list out of it. Hopefully this doesn't break run file |
|---|
| 77 | # comparisons. |
|---|
| 78 | if { [catch {llength $params(-default)}] != 0 } { |
|---|
| 79 | set params(-default) [list $params(-default)] |
|---|
| 80 | } |
|---|
| 81 | |
|---|
| [1929] | 82 | if {[llength $args] != 0} { |
|---|
| 83 | error "wrong # args: should be \"column insert pos ?-name n? ?-label l? ?-default v?\"" |
|---|
| 84 | } |
|---|
| [11] | 85 | |
|---|
| [1929] | 86 | # insert the new column |
|---|
| 87 | set cname $params(-name) |
|---|
| 88 | if {$params(-name) == "#auto"} { |
|---|
| 89 | set cname "column[incr _counter]" |
|---|
| 90 | } |
|---|
| 91 | if {[lsearch -exact $_colnames $cname] >= 0} { |
|---|
| 92 | error "column name \"$cname\" already exists" |
|---|
| 93 | } |
|---|
| 94 | set _colnames [linsert $_colnames $pos $cname] |
|---|
| 95 | set _col2info($cname-label) $params(-label) |
|---|
| 96 | set _col2info($cname-default) $params(-default) |
|---|
| [11] | 97 | |
|---|
| [1929] | 98 | # run through all existing tuples and insert the default val |
|---|
| 99 | set max [array size _tuples] |
|---|
| 100 | for {set i 0} {$i < $max} {incr i} { |
|---|
| 101 | set oldval $_tuples($i) |
|---|
| 102 | set _tuples($i) [linsert $oldval $pos $params(-default)] |
|---|
| 103 | } |
|---|
| 104 | } |
|---|
| 105 | delete { |
|---|
| 106 | foreach cname $args { |
|---|
| 107 | set pos [lsearch -exact $_colnames $cname] |
|---|
| 108 | if {$pos < 0} { |
|---|
| 109 | error "bad column name \"$cname\"" |
|---|
| 110 | } |
|---|
| 111 | set _colnames [lreplace $_colnames $pos $pos] |
|---|
| 112 | unset _col2info($cname-label) |
|---|
| 113 | unset _col2info($cname-default) |
|---|
| [11] | 114 | |
|---|
| [1929] | 115 | # run through all existing tuples and delete the column |
|---|
| 116 | set max [array size _tuples] |
|---|
| 117 | for {set i 0} {$i < $max} {incr i} { |
|---|
| 118 | set oldval $_tuples($i) |
|---|
| 119 | set _tuples($i) [lreplace $oldval $pos $pos] |
|---|
| 120 | } |
|---|
| 121 | } |
|---|
| 122 | } |
|---|
| 123 | names { |
|---|
| 124 | if {[llength $args] == 0} { |
|---|
| 125 | return $_colnames |
|---|
| 126 | } elseif {[llength $args] == 1} { |
|---|
| 127 | set pattern [lindex $args 0] |
|---|
| 128 | set rlist "" |
|---|
| 129 | foreach cname $_colnames { |
|---|
| 130 | if {[string match $pattern $cname]} { |
|---|
| 131 | lappend rlist $cname |
|---|
| 132 | } |
|---|
| 133 | } |
|---|
| 134 | return $rlist |
|---|
| 135 | } else { |
|---|
| 136 | error "wrong # args: should be \"column names ?pattern?\"" |
|---|
| 137 | } |
|---|
| 138 | } |
|---|
| 139 | info { |
|---|
| 140 | if {[llength $args] != 1} { |
|---|
| 141 | error "wrong # args: should be \"column info name\"" |
|---|
| 142 | } |
|---|
| 143 | set cname [lindex $args 0] |
|---|
| 144 | set pos [lsearch -exact $_colnames $cname] |
|---|
| 145 | if {$pos < 0} { |
|---|
| 146 | error "bad column name \"$cname\"" |
|---|
| 147 | } |
|---|
| 148 | return [list -label $_col2info($cname-label) -default $_col2info($cname-default)] |
|---|
| 149 | } |
|---|
| 150 | default { |
|---|
| 151 | error "bad option \"$option\": should be delete, info, insert, names" |
|---|
| 152 | } |
|---|
| [11] | 153 | } |
|---|
| 154 | } |
|---|
| 155 | |
|---|
| 156 | # ---------------------------------------------------------------------- |
|---|
| 157 | # USAGE: insert <pos> ?<tuple> <tuple> ...? |
|---|
| 158 | # |
|---|
| 159 | # Used by clients to insert one or more tuples into this list at |
|---|
| 160 | # the given position <pos>. Each <tuple> is a Tcl list of values |
|---|
| 161 | # in order corresponding to the column names. |
|---|
| 162 | # ---------------------------------------------------------------------- |
|---|
| 163 | itcl::body Rappture::Tuples::insert {pos args} { |
|---|
| 164 | set cols [llength $_colnames] |
|---|
| 165 | set max [array size _tuples] |
|---|
| 166 | |
|---|
| 167 | if {"end" == $pos} { |
|---|
| [1929] | 168 | set pos $max |
|---|
| [11] | 169 | } elseif {![string is integer $pos]} { |
|---|
| [1929] | 170 | error "bad position \"$pos\": should be integer or \"end\"" |
|---|
| [11] | 171 | } elseif {$pos < 0} { |
|---|
| [1929] | 172 | set pos 0 |
|---|
| [11] | 173 | } elseif {$pos > $max} { |
|---|
| [1929] | 174 | set pos $max |
|---|
| [11] | 175 | } |
|---|
| 176 | |
|---|
| 177 | # make some room to insert these tuples |
|---|
| 178 | set need [llength $args] |
|---|
| 179 | for {set i [expr {$max-1}]} {$i >= $pos} {incr i -1} { |
|---|
| [1929] | 180 | set _tuples([expr {$i+$need}]) $_tuples($i) |
|---|
| [11] | 181 | } |
|---|
| 182 | |
|---|
| 183 | # add the tuples at the specified pos |
|---|
| 184 | foreach t $args { |
|---|
| [1929] | 185 | # make sure each tuple has enough columns |
|---|
| 186 | while {[llength $t] < $cols} { |
|---|
| 187 | lappend t "" |
|---|
| 188 | } |
|---|
| 189 | set _tuples($pos) $t |
|---|
| 190 | incr pos |
|---|
| [11] | 191 | } |
|---|
| 192 | } |
|---|
| 193 | |
|---|
| 194 | # ---------------------------------------------------------------------- |
|---|
| 195 | # USAGE: delete ?<from>? ?<to>? |
|---|
| 196 | # |
|---|
| 197 | # Used by clients to delete one or more tuples in this list. With |
|---|
| 198 | # no args, it deletes all tuples. With a single <from> arg, it deletes |
|---|
| 199 | # the tuple at that number. With both args, it deletes tuples in the |
|---|
| 200 | # specified range. |
|---|
| 201 | # ---------------------------------------------------------------------- |
|---|
| 202 | itcl::body Rappture::Tuples::delete {{from ""} {to ""}} { |
|---|
| 203 | if {"" == $from && "" == $to} { |
|---|
| [1929] | 204 | catch {unset _tuples} |
|---|
| 205 | return |
|---|
| [11] | 206 | } |
|---|
| 207 | if {[array size _tuples] == 0} { |
|---|
| [1929] | 208 | return ;# nothing to delete |
|---|
| [11] | 209 | } |
|---|
| 210 | |
|---|
| 211 | set last [expr {[array size _tuples]-1}] |
|---|
| 212 | foreach {from to} [_range $from $to] break |
|---|
| 213 | |
|---|
| 214 | # delete all tuples in the specified range |
|---|
| 215 | set gap [expr {$to-$from+1}] |
|---|
| 216 | for {set i $from} {$i <= $last-$gap} {incr i} { |
|---|
| [1929] | 217 | set _tuples($i) $_tuples([expr {$i+$gap}]) |
|---|
| [11] | 218 | } |
|---|
| 219 | for {} {$i <= $last} {incr i} { |
|---|
| [1929] | 220 | unset _tuples($i) |
|---|
| [11] | 221 | } |
|---|
| 222 | } |
|---|
| 223 | |
|---|
| 224 | # ---------------------------------------------------------------------- |
|---|
| 225 | # USAGE: put ?-format <columns>? <pos> <tuple> |
|---|
| 226 | # |
|---|
| 227 | # Used by clients to store a different tuple value at the specified |
|---|
| 228 | # position <pos> in this list. Normally, it stores the entire |
|---|
| 229 | # <tuple> at the specified slot, which must already exist. (Use |
|---|
| 230 | # insert to create new slots.) If the -format option is specified, |
|---|
| 231 | # then it interprets <tuple> according to the names in the -format, |
|---|
| 232 | # and updates only specific columns at that slot. |
|---|
| 233 | # ---------------------------------------------------------------------- |
|---|
| 234 | itcl::body Rappture::Tuples::put {args} { |
|---|
| 235 | Rappture::getopts args params { |
|---|
| [1929] | 236 | value -format "" |
|---|
| [11] | 237 | } |
|---|
| 238 | if {[llength $args] != 2} { |
|---|
| [1929] | 239 | error "wrong # args: should be \"put ?-format cols? pos tuple\"" |
|---|
| [11] | 240 | } |
|---|
| 241 | foreach {pos tuple} $args break |
|---|
| 242 | foreach {pos dummy} [_range $pos ""] break ;# fix index |
|---|
| 243 | |
|---|
| 244 | if {![info exists _tuples($pos)]} { |
|---|
| [1929] | 245 | error "index $pos doesn't exist" |
|---|
| [11] | 246 | } |
|---|
| 247 | |
|---|
| 248 | if {[string length $params(-format)] == 0} { |
|---|
| [1929] | 249 | # no format -- add tuple as-is (with proper number of columns) |
|---|
| 250 | set cols [llength $_colnames] |
|---|
| 251 | while {[llength $tuple] < $cols} { |
|---|
| 252 | lappend tuple "" |
|---|
| 253 | } |
|---|
| 254 | set _tuples($pos) $tuple |
|---|
| [11] | 255 | } else { |
|---|
| [1929] | 256 | # convert column names to indices |
|---|
| 257 | set nlist "" |
|---|
| 258 | foreach cname $params(-format) { |
|---|
| 259 | set n [lsearch -exact $_colnames $cname] |
|---|
| 260 | if {$n < 0} { |
|---|
| 261 | error "bad column name \"$cname\"" |
|---|
| 262 | } |
|---|
| 263 | lappend nlist $n |
|---|
| 264 | } |
|---|
| [11] | 265 | |
|---|
| [1929] | 266 | # convert data only for those indices |
|---|
| 267 | set val $_tuples($pos) |
|---|
| 268 | foreach n $nlist t $tuple { |
|---|
| 269 | set val [lreplace $val $n $n $t] |
|---|
| 270 | } |
|---|
| 271 | set _tuples($pos) $val |
|---|
| [11] | 272 | } |
|---|
| 273 | } |
|---|
| 274 | |
|---|
| 275 | # ---------------------------------------------------------------------- |
|---|
| 276 | # USAGE: get ?-format <columns>? ?<from>? ?<to>? |
|---|
| 277 | # |
|---|
| 278 | # Used by clients to query data from this list of tuples. Returns |
|---|
| 279 | # a list of tuples in the specified range, or a list of all tuples |
|---|
| 280 | # if the range is not specified. |
|---|
| 281 | # ---------------------------------------------------------------------- |
|---|
| 282 | itcl::body Rappture::Tuples::get {args} { |
|---|
| 283 | Rappture::getopts args params { |
|---|
| [1929] | 284 | value -format "" |
|---|
| [11] | 285 | } |
|---|
| 286 | if {[llength $args] > 2} { |
|---|
| [1929] | 287 | error "wrong # args: should be \"get ?-format cols? ?from? ?to?\"" |
|---|
| [11] | 288 | } |
|---|
| 289 | set from "" |
|---|
| 290 | set to "" |
|---|
| 291 | foreach {from to} $args break |
|---|
| 292 | foreach {from to} [_range $from $to] break |
|---|
| 293 | |
|---|
| 294 | # empty? then return nothing |
|---|
| 295 | if {[array size _tuples] == 0} { |
|---|
| [1929] | 296 | return "" |
|---|
| [11] | 297 | } |
|---|
| 298 | |
|---|
| 299 | set rlist "" |
|---|
| 300 | if {[string length $params(-format)] == 0} { |
|---|
| [1929] | 301 | # no format string -- return everything as-is |
|---|
| 302 | for {set i $from} {$i <= $to} {incr i} { |
|---|
| 303 | lappend rlist $_tuples($i) |
|---|
| 304 | } |
|---|
| [11] | 305 | } else { |
|---|
| [1929] | 306 | # convert column names to indices |
|---|
| 307 | set nlist "" |
|---|
| 308 | foreach cname $params(-format) { |
|---|
| 309 | set n [lsearch -exact $_colnames $cname] |
|---|
| 310 | if {$n < 0} { |
|---|
| 311 | error "bad column name \"$cname\"" |
|---|
| 312 | } |
|---|
| 313 | lappend nlist $n |
|---|
| 314 | } |
|---|
| 315 | set single [expr {[llength $nlist] == 1}] |
|---|
| [11] | 316 | |
|---|
| [1929] | 317 | # convert data only for those indices |
|---|
| 318 | for {set i $from} {$i <= $to} {incr i} { |
|---|
| 319 | set t "" |
|---|
| 320 | foreach n $nlist { |
|---|
| 321 | if {$single} { |
|---|
| 322 | set t [lindex $_tuples($i) $n] |
|---|
| 323 | } else { |
|---|
| 324 | lappend t [lindex $_tuples($i) $n] |
|---|
| 325 | } |
|---|
| 326 | } |
|---|
| 327 | lappend rlist $t |
|---|
| 328 | } |
|---|
| [11] | 329 | } |
|---|
| 330 | return $rlist |
|---|
| 331 | } |
|---|
| 332 | |
|---|
| 333 | # ---------------------------------------------------------------------- |
|---|
| 334 | # USAGE: find ?-format <columns>? ?<tuple>? |
|---|
| 335 | # |
|---|
| 336 | # Used by clients to search for all or part of a <tuple> on the |
|---|
| 337 | # list. Without the extra -format option, this searches for an |
|---|
| 338 | # exact match of the <tuple> and returns a list of indices that |
|---|
| 339 | # match. With the -format option, it checks the values for only |
|---|
| 340 | # the specified <columns>, and again returns a list of indices |
|---|
| 341 | # with matching values. |
|---|
| 342 | # ---------------------------------------------------------------------- |
|---|
| 343 | itcl::body Rappture::Tuples::find {args} { |
|---|
| 344 | Rappture::getopts args params { |
|---|
| [1929] | 345 | value -format "" |
|---|
| [11] | 346 | } |
|---|
| 347 | if {[llength $args] > 1} { |
|---|
| [1929] | 348 | error "wrong # args: should be \"find ?-format cols? ?tuple?\"" |
|---|
| [11] | 349 | } |
|---|
| 350 | |
|---|
| 351 | # convert column names to indices |
|---|
| 352 | set nlist "" |
|---|
| 353 | foreach cname $params(-format) { |
|---|
| [1929] | 354 | set n [lsearch -exact $_colnames $cname] |
|---|
| 355 | if {$n < 0} { |
|---|
| 356 | error "bad column name \"$cname\"" |
|---|
| 357 | } |
|---|
| 358 | lappend nlist $n |
|---|
| [11] | 359 | } |
|---|
| 360 | |
|---|
| 361 | # scan through all entries and find matching values |
|---|
| 362 | set rlist "" |
|---|
| 363 | set last [expr {[array size _tuples]-1}] |
|---|
| 364 | if {[llength $args] == 0} { |
|---|
| [1929] | 365 | # no tuple? then all match |
|---|
| 366 | for {set i 0} {$i <= $last} {incr i} { |
|---|
| 367 | lappend rlist $i |
|---|
| 368 | } |
|---|
| [11] | 369 | } else { |
|---|
| [1929] | 370 | set tuple [lindex $args 0] |
|---|
| 371 | if {[llength $nlist] == 0} { |
|---|
| 372 | # no format? then look for an exact match |
|---|
| 373 | for {set i 0} {$i <= $last} {incr i} { |
|---|
| 374 | if {[string equal $tuple $_tuples($i)]} { |
|---|
| 375 | lappend rlist $i |
|---|
| 376 | } |
|---|
| 377 | } |
|---|
| 378 | } else { |
|---|
| 379 | # match only the columns in the -format |
|---|
| 380 | for {set i 0} {$i <= $last} {incr i} { |
|---|
| 381 | set matching 1 |
|---|
| 382 | foreach n $nlist t $tuple { |
|---|
| 383 | set val [lindex $_tuples($i) $n] |
|---|
| 384 | if {![string equal $t $val]} { |
|---|
| 385 | set matching 0 |
|---|
| 386 | break |
|---|
| 387 | } |
|---|
| 388 | } |
|---|
| 389 | if {$matching} { |
|---|
| 390 | lappend rlist $i |
|---|
| 391 | } |
|---|
| 392 | } |
|---|
| 393 | } |
|---|
| [11] | 394 | } |
|---|
| 395 | return $rlist |
|---|
| 396 | } |
|---|
| 397 | |
|---|
| 398 | # ---------------------------------------------------------------------- |
|---|
| 399 | # USAGE: size |
|---|
| 400 | # |
|---|
| 401 | # Used by clients to determine the number of tuples stored on this |
|---|
| 402 | # list. Returns the size of the list. |
|---|
| 403 | # ---------------------------------------------------------------------- |
|---|
| 404 | itcl::body Rappture::Tuples::size {} { |
|---|
| 405 | return [array size _tuples] |
|---|
| 406 | } |
|---|
| 407 | |
|---|
| 408 | # ---------------------------------------------------------------------- |
|---|
| 409 | # USAGE: _range ?<from>? ?<to>? |
|---|
| 410 | # |
|---|
| 411 | # Used internally to convert a <from>/<to> range to a range of real |
|---|
| 412 | # number values. If both are "", then the range is the entire range |
|---|
| 413 | # of data. The <from> and <to> values can be integers or the keyword |
|---|
| 414 | # "end". |
|---|
| 415 | # ---------------------------------------------------------------------- |
|---|
| 416 | itcl::body Rappture::Tuples::_range {{from ""} {to ""}} { |
|---|
| 417 | set last [expr {[array size _tuples]-1}] |
|---|
| 418 | if {"" == $from && "" == $to} { |
|---|
| [1929] | 419 | return [list 0 $last] |
|---|
| [11] | 420 | } |
|---|
| 421 | |
|---|
| 422 | if {"end" == $from} { |
|---|
| [1929] | 423 | set from $last |
|---|
| [11] | 424 | } elseif {![string is integer $from]} { |
|---|
| [1929] | 425 | error "bad position \"$from\": should be integer or \"end\"" |
|---|
| [11] | 426 | } |
|---|
| 427 | if {$from < 0} { |
|---|
| [1929] | 428 | set from 0 |
|---|
| [11] | 429 | } elseif {$from > $last} { |
|---|
| [1929] | 430 | set from $last |
|---|
| [11] | 431 | } |
|---|
| 432 | |
|---|
| 433 | if {"" == $to} { |
|---|
| [1929] | 434 | set to $from |
|---|
| [11] | 435 | } elseif {"end" == $to} { |
|---|
| [1929] | 436 | set to $last |
|---|
| [11] | 437 | } elseif {![string is integer $to]} { |
|---|
| [1929] | 438 | error "bad position \"$to\": should be integer or \"end\"" |
|---|
| [11] | 439 | } |
|---|
| 440 | if {$to < 0} { |
|---|
| [1929] | 441 | set to 0 |
|---|
| [11] | 442 | } elseif {$to > $last} { |
|---|
| [1929] | 443 | set to $last |
|---|
| [11] | 444 | } |
|---|
| 445 | |
|---|
| 446 | if {$from > $to} { |
|---|
| [1929] | 447 | # make sure to/from are in proper order |
|---|
| 448 | set tmp $from |
|---|
| 449 | set from $to |
|---|
| 450 | set to $tmp |
|---|
| [11] | 451 | } |
|---|
| 452 | return [list $from $to] |
|---|
| 453 | } |
|---|
