Updated 2017-11-21 18:59:23 by dbohdan ▲

CMCc Some code to map metakit views to arrays of dictionaries
    namespace eval dattach {
        variable debug 0
        proc Write {view selector array var el op} {
            upvar $var val
            
            variable debug
            if {$debug} {
                puts stderr "Write: '$view' '$selector' '$array' '$var' '$el' '$op'"
                puts stderr "V: $val($el)"
                catch {[dict get $val($el)]} err
                puts stderr "Err: $err"
            }
            
            set row [::mk::select $view $selector $el]
            
            if {[llength $row]} {
                eval ::mk::set ${view}.$row [dict get $val($el)] $selector $el
            } else {
                eval ::mk::row append $view [dict get $val($el)] $selector $el
            }
        }
        
        proc Read {view selector array var el op} {
            upvar $var val
            
            variable debug
            if {$debug} {
                puts stderr "Read: '$view' '$selector' '$array' '$var' '$el' '$op'"
            }
            
            set row [::mk::select $view $selector $el]
            if {[llength $row]} {
                set val($el) [eval dict create [::mk::get ${view}.$row]]
            } else {
                error "dattach can't read \"${array}\(${el}\): no such element in array"
            }
        }
        
        proc Unset {view selector array var el op} {
            upvar $var val
            
            variable debug
            if {$debug} {
                puts stderr "Unset: '$view' '$selector' '$array' '$var' '$el' '$op'"
            }
            
            if {$el == ""} {
                puts stderr "Trace: unset1 $view"
                ::mk::loop el1 ${view} {
                    #catch {puts stderr "Trace: unset2 $el1 [::mk::get $el1]"}
                    catch {::mk::row delete $el1}
                }
                puts stderr "Trace: unset done"
            } else {
                set row [::mk::select $view $selector $el]
                ::mk::row delete ${view}.$row
            }
        }
        
        proc attach {view array {selector ""}} {
            if {$selector == ""} {
                set selector [lindex [::mk::view  layout $view] 0]
            }
            
            variable debug
            if {$debug} {
                puts stderr "dattach:  $array to $view $selector"
            }
            
            upvar $array a
            set a() ""
            unset a()
            trace add variable a unset [list ::dattach::Unset $view $selector $array ]
            trace add variable a read [list ::dattach::Read $view $selector $array ]
            trace add variable a write [list ::dattach::Write $view $selector $array ]
        }
        
        proc snort {view array {selector ""}} {
            uplevel ::dattach::attach $view $array $selector
            upvar $array a
            ::mk::loop el1 ${view} {
                set sel [eval dict create [::mk::get $el1]]
                set a([dict get $sel $selector]) $sel
            }
        }
        
        namespace export attach snort
    }

and here are a few tests:
if {$argv0 == [info script]} {
    package require Mk4tcl

    #set ::dattach::debug 1

    proc dumpit {heading {var shoesize}} {
        puts "*** $heading"
        upvar $var array
        foreach last [array names array] {
            if {[catch {puts "$last: $array($last)"} error]} {
                puts "error on $var element $last: $error"
            }
        }
        puts "---"
    }

    set db [mk::file open db /tmp/datafile.mk]
    set vw [mk::view layout db.people {last first shoesize:I}]

    # fill in some db rows
    mk::row append $vw last "Lennon" first "John" shoesize 44
    mk::row append $vw last "Gordon" first "Flash" shoesize 42
    mk::row append $vw last "Hendrix" first "Jimi" shoesize 49
    mk::file commit db

    ::dattach::attach $vw shoesize last

    dumpit "attach gets rows lazily - so this will be empty"

    set x $shoesize(Lennon)
    set x $shoesize(Gordon)
    dumpit "Fetch some attached values"

    set shoesize(Cass) [dict create first Mama shoesize 40 alive n]
    dumpit "Create a new Row" shoesize

    dict set shoesize(Cass) last Lennon ;# note, this will have no effect
    dumpit "changing the key field has no effect"

    ::dattach::snort $vw shoes last
    dumpit "snort gets all rows in existence at creation time" shoes

    dict set shoes(Lennon) shoesize -1
    dumpit "changing a different attached variable has an effect on all" shoes

    # note - we take the first match on key
    ::dattach::snort $vw size shoesize
    dumpit "By Shoesize" size

    dict set shoesize(Cass) shoesize 44
    dumpit "array names can get out of sync on snorted arrays\n*** Note: this could be fixed, if trace array was." size
}

Category Metakit