[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.

----

[Category Database]