Updated 2012-12-29 19:54:02 by pooryorick

schlenk 2005-12-16 : Using real databases and loading a datamodel i often have to resolve the creation order of the tables, because the SQL tables reference themselves via Foreign keys. For direct database access with for example Pgtcl this isn't much of a problem, as one can deferr constraints like foreign keys in a transaction.

Basically this is a quite generic dependency resolver, based on the tcllib graph package, customized for the tcldb::table objects.
package require struct::graph 2

# Resolving reference dependecies for tcldb tables
#
# Create a dependency graph first, 
# then walk from leaves to the root
#

proc createGraph {tableObjs} {
    set g [::struct::graph ]

    foreach table $tableObjs {
        set tablename [$table cget -table]
        set fields [$table fieldlist 0 1 1]

        $g set $tablename $table
        if {![$g node exists $tablename]} {
            $g node insert $tablename
        }
        puts "Table: $tablename"
        foreach {field type param} $fields {
            puts "$field"
            puts "$type"
            puts $param 
            array unset finfo 
            set finfo(reference) ""
            $g node set $tablename $field [list $type $param]
            array set finfo $param
            if {$finfo(reference) eq ""} {continue}
            set reftable [lindex $finfo(reference) 0]
            if {![$g node exists $reftable]} {
                $g node insert $reftable
            } 
            $g arc insert $tablename $reftable
        }
    }
    return $g
}

proc filterIsolated {g n} {
    if {[llength [$g arcs -out $n]]} {
        return 0
    } else {
        return 1
    } 
}

proc findOrder {graph} {
    set g [::struct::graph tempGraph = $graph]

    set order [list]

    set old [llength [$g nodes]]
    while {[llength [$g nodes]]} {
        set isolated [$g nodes -filter [namespace current]::filterIsolated]
        if {[llength $isolated]} {
            foreach node $isolated {
                lappend order [list $node [$g set $node]]
                $g node delete $node
            }
        } else {
            break
        }
    }
    if {[llength [$g nodes]]} {
        return -code error "Could not resolve reference conflicts, objects left [$g nodes]"
    } 
    $g destroy
    return $order
}

To use it, put all your tcldb::table objects into a list, then call:
set g [createGraph $tablelist]
puts [findOrder $g]

This returns the creation order for your table as a list of lists, each sublist is a tablename tableobject pair.

escargo 16 Dec 2005 - In terms of dependencies, would determining the order via a topological sort work as well? Can the dependency graph be relied upon to have no cycles?

schlenk 16 Dec 2005 - I think a topological sort would work as well. If the dependency graph for this use case (sql table relations) would have cycles, this would be a clear indication that some database normalization could be a good idea.