###
#  Schema data storage in he non-volitile state of the system
#
#  Will be also be saved in ~/path.schema
###

set ::lastStmt {}
namespace eval ::tdif {
    #namespace forget *
    #namespace import ::tao::*

    if 0 {
	# Old node methods that need to be remade into TDIF calls
    method GetLinks {{dump 0}} {
	if [cget links links] {
            set links [$containerObj NodeLinks $globalName]
	    cset links $links
        }
        return $links
    }

    method GetReferences {{dump 0}} { 
	if [cget references references] {
	    set references {}
            foreach container [tdif ContainerList] {
                catch {
		    foreach {lid lobj ltype} [[tdif Container $container] NodeReferences $globalName] {
			lappend references $lid $lobj $ltype
		    }
                }
            }
	    cset references $references
        }
        return $references
    }
    }

    proc NewColumn {element class info {table_object {}}} { 
	set obj [Locate $element]
	set column [lindex [split $element .] end]
	#set obj $table.$column
	if { $table_object == {} } {
	    set elist [split $element .]
	    set l [llength $elist]
	    set container [Locate [join [lrange $elist 0 [expr $l - 2]] .]]
	    if [catch {$container /table} table_object] {
		error "Could not generate $element from $container, $table_object"
	    }
	}
	if [::tao::object_exists $obj] { 
	    return $obj
	}
	set lclass [::tao::class_join llama.column $class]
	if ![::tao::class_exists $lclass] { 
	    set lclass llama.column.string
	}
	set data $info
	#::tao::object_class $obj $lclass
	#set ::tao::object::objclass($obj) $lclass
 
	::tao::new $lclass $obj \
	    globalName [$table_object globalName]-${column} element $element \
	    column $column
	object_dlearn $obj $table_object
	object_cset $obj $info

	#$obj cset $info
	#$obj init $table_object $column $info

	return $obj
    }

    proc NewContainer {table class handle sqlobj} {
	::tao::object_create $table [list class $class table $table handle $handle sqlObj $sqlobj]
	tdif Container $handle $table
    }

    proc Locate {element {sqlobj {}}} {
	return $element
    }


    proc object_dlearn {handle sensai} {
	set statevar [object_dict $handle] 
	set sensaivar [object_dict $sensai]
	set statedat [set $statevar]
	set newvalues {}
	dict for {var val} [set $sensaivar] {
	    if {[lsearch {globalName node_id element} $var] >= 0} continue
	    if [dict exists $statedat $var] { 
		if { [dict get $statedat $var] != {} } {
		    continue
		}
	    }
	    lappend newvalues $var $val
	}
	object_cset $handle $newvalues
    }

    proc driver_alias {name {classlist {}}} {
	variable drivers
	if { $classlist != {} } { 
	    set drivers($name) $classlist
	    return
	}
	set alias [lindex [array get drivers $name] 1]
	if { $alias != {} } { 
	    return $alias
	}
	return $name
    }

    proc table_columns {element {type {}}} {

	set include_primary 1
	set include_unique  1
	set include_nonkey  1

	set sqlObj [$element cget sqlObj]
	set primary_key [$sqlObj nodeGetField $element primary_key]

	switch $type {
	    primary_key -
	    primary { 
		set include_unique 0 
		set include_nonkey 0 
	    }
	    indexes { 
		set include_primary 0 
		set include_nonkey 0
	    }
	    keys {
		set include_nonkey 0
	    }
	    nonindexes {
		set include_primary 0 
		set include_unique 0
	    }
	    nonkeys {
		set include_primary 0 
	    }
	}

	set result {}

	if $include_unique {
	    foreach item [$sqlObj nodeGetField $element key_columns] {
		ladd result $item
	    }
	    if !$include_primary {
		foreach item $primary_key {
		    ldelete result $item
		}
	    }

	} elseif $include_primary {
	    set result $primary_key 
	}

	if $include_nonkey {
	    foreach item [$sqlObj nodeGetField $element real_columns] {
		ladd result $item
	    }
	}
	return $result
    }

    proc table_object element {
	variable sqlObj
	set elist [split $element .]
	if { [llength $elist] < 2 } { 
	    error "Bad Element Name: $element"
	}
	set table [join [lrange $elist 0 1] .]
	set db     [lindex $elist 0]
	set handle [lindex $elist 1]
	set lclass db.${db}.container.${handle}
	if ![::tao::class_exists $lclass 1] {
	    set lclass [baseclass].container.entities
	}
        set obj [namespace current]::${element}
	if ![::tao::object_exists $obj] { 
	    $lclass $obj handle $handle sqlObj $sqlObj table $table element $table 
	    #$obj set_sql_obj $sqlObj $table
	    #$obj createTableObj
	    #::odie::Container $handle $obj
	}
	return $obj
    }

    proc init {sql_obj {sql_master_obj {}} {root {}}} {
	variable sqlObj
	variable msqlObj

	#
	# Drop cached info
	#

	set sqlObj $sql_obj
	set msqlObj $sql_obj

	if { $sql_master_obj == {} } {
  	    set msqlObj $sql_obj
        } else {
  	    set msqlObj $sql_master_obj
	}
    }

    proc column_object element {
        set obj [Locate $element]
        if [::tao::object_exists $obj] {
            return $obj
        }
	set elist [split $element .]
	return [[table_object [join [lrange $elist 0 1] .]] /column [lindex $elist end]]
    }

    proc record_object {table record} {
        set tableObj   [table_object $table]
        set recordObj  [$tableObj /node $record]
        return $recordObj
    }

    ### Sets or unsets a flag value
    proc flag {cmnd varname {val {}} {cd 0}} {
        upvar 1 $varname var
        if ![info exists var] {
	    set var {}
        }
        if [regexp , $var] {
	    set cd 1
	    set var [split $var ,]
        }
	
        switch $cmnd {
	    add {
		ladd var $val
	    }
	    remove {
		ldelete var $val
	    }
	    fix {
		set cd 1
	    }
        }
        if $cd {
	    set var [join $var ,]
        }
    }


    #
    # Loads or saves date from a TCL array to a specially 
    # designed SQL table
    #
    # For backward compadibility
    # new code should use yggdrasil instead
    #

    proc arrayhash { cmnd keyval varname table key {force 0}} {

	if { $keyval == {} } {
	    return
	}
	set Obj [table_object $table]
	switch $cmnd {
	    load {		
		if { $varname == {} } {
		    error "Missing varname argument"
		}
		if {[string range $varname 0 1] == "::" } { 
		    upvar #0 $varname var		    
		} else {
		    upvar 1 $varname var
		}
		array set var [$Obj nodeGet $key]
		return [llength [array names var]]
	    }
	    save {
		if { $varname == {} } {
		    error "Missing varname argument"
		}
		if {[string range $varname 0 1] == "::" } { 
		    upvar #0 $varname var		    
		} else {
		    upvar 1 $varname var
		}
		$Obj nodeSet [list $key $keyval] [array get var]
	    }
	    create -
	    destroy {
		$Obj nodeDelete $key
		sql::cmnd "DELETE FROM $table where $key='$keyval'"
	    }
	}
    }

    proc lookup_add {table index display value} {
	variable msqlObj
	set rows [$msqlObj query "SELECT $index FROM $table WHERE 
	$display='[$msqlObj fix $value]'"]
	if { $rows == {} } {
	    $msqlObj "INSERT INTO $table SET 
	    $display='[$msqlObj fix $value]'"
            set rows [last_insert_id]
        }
	return $rows
    }

   
    proc record {function table row {varname {}} {fields all}} {

	set database [lindex [split $table .] 0]
	set tablename [lindex [split $table .] 1]
	
	set Obj [table_object $table]

	set primary_key [$Obj Columns primary]

	if { $fields == "all" } {
	    set fields [$Obj Columns]
	}
	
	if { $function != "delete" && $varname == {} } {
	    error "No argument given for varname to ::sql::record"
	}
	upvar 1 $varname record

	if { $row == {} } {
	    set row new
	}
	if { $row == "new" && $function != "save" } {
	    foreach field $fields {
		set record($table.$field) {}
	    }
	    set record($table.$primary_key) new
	    return
	}

	switch $function {
	    clear {
		foreach field $fields {
		    set record($table.$field) {}
		    set record($table.$field.display) {}
		}		
	    }
	    load -
	    arrayload {
		set raw [$Obj nodeGet $row]
		array set record [sql_valueListFormat $table database $raw]
	    }
	    arraycompare -
	    arraysave -
	    save {
		set valuelist    [sql_valueListFormat $table column [array get record] $table]
		set valuelist    [$Obj ValueListFilter nonkey $valuelist]
		set row [$Obj nodeSet $row $valuelist]
		return $row
	    }
	    delete {
		$Obj nodeDelete $row
	    }
	}
    }

    proc fix string {
        regsub -all \' $string \'\' result
        return $result
    }    

}