#### BEGIN COPYRIGHT BLURB
#   
#   TAO - Tcl Architecture of Objects
#   Copyright (C) 2007 Sean Woods
#   
#   See the file "license.terms" for information on usage and redistribution
#   of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#   
### END COPYRIGHT BLURB

namespace eval ::tdif {

    variable columnBaseClass llama.column.httpd
    variable spawned_objects {}

    proc node_normalize node {

	if [regexp {\-} $node] {
	    set node [split $node -]
	}
	if { [llength $node] == 2 } { 
	    set node [lindex $node 1]
	}

	return $node
    }


    proc   nodeid_normalize node {
	if { [llength $node] == 2 } { 
	    return [join $node -]
	}
	return $node
    }

    proc   nodeid_container node {
	set n [split $node -]
	if { [llength $n] < 2 } { 
	    return default
	}
	return [lindex $n 0]
    }

    proc   nodeid_object    node {	
	set n [split $node -]
	if { [llength $n] < 2 } { 
	    return $node
	}
	set result [lindex $n 1]
    }


    proc /node {nodestr {context default}} {
	variable handle_array
	if { [set container [lindex [::array get handle_array $nodestr] 1]] != {} } { 
	    return $container
	}
	set nodel [split $nodestr -]
	if { [llength $nodel] == 1 }  {
	    set container [Container $context]
	    set node      $nodestr
	} else {
	    set container [Container [lindex $nodel 0]]
	    set node      [lindex $nodel end]
	}
	if { $container == {} } { 
	   error [list Could not locate a container for $nodestr in $context]
	}
	return [::tdif::spawn_object $container $node]
    }

    proc Container {shandle {container {}} {class {}}} {
	variable handle_array
	variable linker_containers

	if [string is integer $shandle] {
	    return [lindex [::array get handle_array default] 1]
	}
	if { $shandle == "root" } { 
	    return [lindex [::array get handle_array default] 1]
	}
	set newhandle [lindex [split $shandle -] 0]
    
	if { $container == {} } {
	    set container [lindex [::array get handle_array $newhandle] 1]
	    return $container
	}
	::array set handle_array [list $newhandle $container]
	if [$container isa tdif.linker] {
	    ladd linker_containers $newhandle
	}
	if [$container isa tdif.container] { 
	    $container cset globalName $shandle
	    # Tell the system it's attached
	    $container tdifAttach
	}
	
	set  item [::array get handle_array]
	return $item
    }

    proc Handle {{container {}}} {
	variable handle_array
	foreach {var val} [::array get handle_array] {
	    if { [lsearch {default links} $var] >= 0 } {
		continue
	    }
	    if { $val == $container } {
		return $var
	    }
	}
    }

    proc LinkerList {} {  
	variable linker_containers
	return [lsort [get linker_containers]]
    }

    proc ContainerList {} { 
	variable handle_array
	return [lsort [::array names handle_array]]
    }

    proc columnObj {sqlObj table column} {
	set clist  [split $column .]
	set cname [lindex $clist end]
	set cSql $sqlObj
	switch [llength $clist] {
	    1 {
		set element [lindex [split $table .] end].$column
	    }
	    2 {
		set element $column
	    }
	    3 {
		set cSql    [lindex $clist 0]
		set element [join [lrange $clist 1 2] .]
	    }
	    default {
		error "WTF? $column"
	    }
	}
	set obj $cSql.$element

	if [tao::object_exists $obj] {
	    return $obj
	}
	tao::object_create $obj [$cSql nodeGet $element]
	puts [list $obj [::tao::object_class $obj] [$obj cget desc]]
	return $obj
    }

    proc columnDefaults {column info} {
	variable columnBaseClass

	if ![dict exists $info type] {
	    dict set info type string
	}
	if ![dict exists $info type] {
	    dict set info type string
	}
	set type [dict get $info type]
	dict set info class [::tao::class_join $columnBaseClass $type]	
	if ![dict exists $info width] {
	    dict set info width 40
	}
	if ![dict exists $info desc] {
	    dict set info desc $column
	    set desc $column
	} else {
	    set desc [dict get $info desc]
	}

	if ![dict exists $info label] {
	    dict set info label [::string toupper [::string index $desc 0]][::string range $desc 1 end]
	}
	return $info
    }

    proc spawned_object {container node} { 
	set data [list_objects $container]
	set idx  [lsearch $data $node]
	if { $idx >=0 } { 
	    return [lindex $data [expr $idx + 1]]
	}
	return {}
    }

    proc list_objects {container} { 
	variable spawned_objects
	return [lindex [array get spawned_objects $container] 1]
    }

    proc spawn_register {container node nobj} {
	variable spawned_objects
	dict set spawned_objects $container $node $nobj
    }

    proc spawn_unregister {container node nobj} { 
	variable spawned_objects
	dict unset spawned_objects $container $node
    }

    proc clear_objects container { 
	foreach {node_id info} [list_objects $container] {
	    catch {
		::tao::delete [lindex $info 0]
	    }
	}	
    }

    proc nodeObject {node {container {}}} {
	if { $container == {} } { 
	    set container [Container [nodeid_container $node]]
	    if { $container == {} } { 
		error "Cannot find container for $node"
	    }
	}
	set node  [$container nodeAlias [nodeid_object $node]]
	return ::${container}/${node}
    }

    proc spawn_object {container node {force_new 0}} {
	variable spawned_objects
	set rawnode $node
	set obj [nodeObject $node $container]

	if $force_new {
	    ::tao::delete $obj
	} else {
	    if [::tao::object_exists $obj] { 
		thanatos touch $obj
		return $obj
	    }
	}
	set objInfo  [$container train $node]
	set class [dict get $objInfo class]
	if ![::tao::class_exists $class 1] {
	    set class [$container nodeClass default]
	    dict set objInfo class $class
	}

	dict set objInfo this $obj
	::tao::object_create $obj $objInfo
	if { $rawnode != $node } { 
	    spawn_register $container $rawnode $obj
	    spawn_register $container $node $obj
	}
	return $obj
    }


    proc connect {handle configDict} {
	::tao::object_create $handle $configDict
	Container $handle $handle
	$handle wake
    }	

    ###
    #  Build up a dict of all of the links 
    #  to an object
    #
    #  1) check all of the linker containers
    #  2) query the objects's container
    #  3) query the node itself
    ###

    proc nodeLinks node {
	set result {}
	foreach container [LinkerList] {
	    set result [dict merge $result [$container nodeLinks $node]]
	}
	if [[/node $node] isa tdif.element.linked] {
	    set result [dict merge $result [[/node $node] links]]
	}
	return $result
    }

    proc nodeRenew node {
	thanatos kiss [nodeObject $node]
    }
}