# requires stooop package from tcllib
# loaded from sycamore.tcl

 proc arga argStr {
     set args [ split $argStr ]
     set argc [llength $args]
     # syc::debug "arga.argc = %s" $argc
     set objName ""
     set key ""
     set name ""
     set val ""
 	set bObj [expr $argc > 0]
     set bKey [expr $argc > 1]
     set bName [expr $argc > 2]
     set bVal [expr $argc > 3]
 	if $bObj {
 	    set objName [string tolower [lindex $args 0]]
 	    #syc::debug "arga.objName = %s" $objName
 	} 
     if $bKey {
       	set key [string tolower [lindex $args 1]]
 	    #syc::debug "arga.key = %s" $key
     }
     if $bName {
        	set name [string tolower [lindex $args 2]]
     }
     if $bVal {
     	set val [string tolower [lindex $args 3]]
     }    
# ? cannot get 'array set' to work in the form:
# array set argv {
#   argc    $argc
#   objName $objName
#   ... etcetera
# }
    set argv(argc)    $argc
    set argv(bObj)    $bObj
    set argv(bKey)    $bKey
    set argv(bName)   $bName
    set argv(bVal)    $bVal
    set argv(objName) $objName
    set argv(key)     $key
    set argv(name)    $name
    set argv(val)     $val
    # would like to return associative array
    # for now, settle for list
    # syc::debug "arga.argv = { %s }" [array get argv]
    return [array get argv]
 }

# -----------------------------------------------------------------------------
class sinfo {                                      ;# base class definition
    proc sinfo {this} {                            ;# base class constructor
        # non-static data member initialisation
        set ($this,objectID) $this    
    }
    
    proc ~sinfo {this} {}                          ;# base class destructor

    proc id {this} {
        return [format "sin.objectID = \{ %s \}" $($this,objectID)]
    }
    
    # static data member variables
    # set File  default.dat
    set delimiter ", "
    set debug 0
    set init 0
    set name "sinfo"
    set usage {sinfo init|diag|config|server|device|command [parameter]}
    set version 0.6

    class server {
        proc server {this name} {
            set ($this,name) $name 
            
            proc name {this} {
                return [format "server.name = \{ %s \}" $($this,name)]
            }
        }
        proc ~server {this} {}
    }       
    
    class sinfot {
        proc sinfot {this} {}
        proc ~sinfot {this} {}
    }

    proc helpMsgStr args {
        return [formatMsg $sinfo::name "usage" $sinfo::usage]
    }
    
    proc debug args {
        if {$sinfo::debug < 1} {
            return
        }
        set l [llength $args]
        set dMsg "Script code event"
        set dVal " "
        if {$l > 0} {
            set dMsg  [lindex $args 0]
            if {$l > 1} {
                set dVal  [lindex $args 1]
            }
        }
        sinWrite [format "sinfo::debug: %s" [format $dMsg $dVal]] "value"
    }

    proc diag args {
        set flag [lindex $args 0]
        set msg [format "diag=%s" $flag]
        switch $flag {
            "on" {
                set sinfo::debug 1
            }
            "off" {
                set sinfo::debug 0
            } 
            default {
                if {1 == $sinfo::debug} {
                    set msg "diag=on"
                } else {
                    set msg "diag=off"
                }
            }
        }
        return [format "sinfo.diag = \{ %s \}" $msg]
    }
    
    proc formatMsg {objName parName msg} {
#        return [format "%s.%s = \{ %s \}" $objName $parName $msg]
#        set msgStr [format "%s.%s = %s " $objName $parName $msg]
    #sinWrite "DEBUG formatMsg: msg = $msg" "value"
        return "$objName.$parName=$msg"
    }
    
    proc writeObjPar {objName parName} {
        return [format "%s.%s = \{ %s \}" \
            $objName $parName [set ::$objName::$parName]]
    }    

    proc writeError {objName msg} {
#        return [format "%s.error = \{ %s \}" $objName $msg]
        set msg [format "%s.error = \{ %s \}" $objName $msg]
        sinWrite $msg "error"
        return $msg
    }
    
    proc writeNspPar {objName parName} {
        set result ::
        append result $objName :: $parName
#        return [format "%s.%s = \{ %s \}" $objName $parName [set $result]]
        sinWrite [format "%s" [set $result]] "value"
    }

    proc writeList {objName parName parList} {
#        return [format "%s.%s = %s " $objName $parName \
#        	[join $parList $sinfo::delimiter]]
        set msg [format "%s" [join $parList $sinfo::delimiter]]
        sinWrite $msg "value"
        #return $msg
    }    
    
    proc writeNamespaceChildren {obj key nsp} {
		set chList {}
		set nameList {}
		set chList [namespace children $nsp]
		set l [llength $chList]
		for {set i 0} {$i < $l} {incr i} {
			lappend nameList [namespace tail [lindex $chList $i]]
		}	
		writeList $obj $key $nameList
	}
	
    proc writeNamespaceList {obj key nsp} {
      set nameList {}
      foreach v [info vars ${nsp}::*] {
        lappend nameList [namespace tail $v]
      }
      writeList $obj $key $nameList
    }
}

proc sinfo::server args {
    array set argv [arga $args]
    debug "sinfo::server, server.argv = { %s }" [array get argv]
	set parSet {}
    set parNames {}
    if {$argv(bKey)} {
        set key $argv(key)
          debug "sinfo::server, key = $key"
        switch $key {
            "connection" -
            "experiment" -
            "help" -
            "key" -
            "list"
            {
          debug "sinfo::server, in switch $key, sinfox list server $key"
                set nameList [sinfox list server $key]
                sinfo::writeList "server" $key $nameList
            }
            "command" -
            "device"  -
            "devicetype" -
            "group" -
            "interface"
            {
                if {$argv(bName)} {
                    set name $argv(name)
                    debug "sinfo::server, using name $name"
                    #sinWrite [format "DEBUG: if bname, key = %s, name = %s" $key $name] "value"
                    set nameList [sinfox list server $key $name]
                    sinfo::writeList "server" $name $nameList
                    #todo: improve response for unknown name
                    #      eg server.error={device=foo}
                } else {
                    set nameList [sinfox list server $key]
                    debug "sinfo::server, key=$key, nameList = $nameList"
                    sinfo::writeList "server" $key $nameList
                }
            }
            
            "gtdevice"
            {
                if {$argv(bName)} {
                    set name $argv(name)
                    if [info exists ::server::gtDeviceList::$name] {
                        sinfo::writeNspPar server::gtDeviceList $name
                    } else {
                        set msg [format "key=%s.%s" "server" $key]	
                        return [sinfo::writeList "server" error $msg]
                    }
                } else {
                writeList "server" $key [gumtree::gtDeviceList]
#                    sinfo::writeNamespaceList "server" $key \
#                        [ ::server::gtDeviceList
                }                
            }
            
            default {
                puts default
                if [info exists ::server::$key] {
                    sinfo::writeNspPar server $key
                } else {
					set msg [format "key=%s.%s" "server" $key]	
					return [sinfo::writeList "server" error $msg]
                }
            }
        } 
    } else {
            # writeNamespaceList $objName
            set nameList [sinfox list server list]
            writeList "server" "list" $nameList
    }    
}

proc sinfo::checkType {objName} {
    if { [string compare -nocase $objName server] == 0 } then {
        set return "server"
    } elseif { [string compare -nocase $objName sequencer] == 0 } then {
        set return "sequencer"
    } else {
        switch [SICSType $objName] {
    		COUNT -
            DRIV { return "device" }
            COM { return "command" }
            TEXT { return "object" }
            default { return "unknown" }
        }
    }
}

proc sinfo::list args {
    array set argv [arga $args]
    debug "sinfo.argv = { %s }" [array get argv]
    set argc [llength $args]
    set objName $argv(objName)
    set key $argv(key)
    set name $argv(name)
   	sinfo::debug "sinfo.numargs = %s" $argc
    if {$argc < 1} {
        sinWrite [sinfo::helpMsgStr] "value"
        return
    }
	sinfo::debug "object = %s" $argv(objName)
    if $argv(bKey) {
		sinfo::debug "key = %s" $argv(key)
    }
    if $argv(bName) {
		sinfo::debug "name = %s" $argv(name)
    }
    
    set parList {}
    set numPars 0
    
    set objType [checkType $objName]
    sinfo::debug "sinfo.objectType = %s" $objType

    switch $objType {
      device 
      {
        set nameList [sinfox list $objName $key $name]
          writeList $objName $key $nameList
      }
      command 
      { 
        debug "sinfo.message = { %s is command objectType}" $objName
      }
      server 
      {
        set cmd [format "sinfo::server %s %s %s %s" \
          $objName $key $argv(name) $argv(val)]
          return [eval $cmd]
      }
      sequencer
      { 
        debug "sinfo.message = { %s is sequencer objectType}" $objName
          if {$argv(bKey)} {
            set key $argv(key)
            switch $key {
              "command"
              {
                if $bName {
                  set target [format "::sequencer::%s" $name]
                    sinfo::writeNamespaceList $objName $name $target 
                } else  {
                  sinfo::writeNamespaceChildren $objName \
                    $key ::sequencer
                }
              }
              default
              {
              }
            }
          } else {
            sinfo::writeNamespaceList "sequencer" "list" "::sequencer"
          }
      }		
      object 
      {
# todo: test for interface name
        switch $objName {
          default {
            writeError "sinfo" \
              [format "'%s' is invalid object" $objName]
          }
        }
      }
      unknown -    
        default {
          writeError "sinfo" [format "'%s' has invalid object type" $objName]
        }
    }
}

# -----------------------------------------------------------------------------
# wrapper procs for sinfo class

proc sinfo args {
    set l [llength $args]
    if {$l < 1} {
        sinWrite [sinfo::helpMsgStr] "value"
        return
    }
    set arglist [ split $args ]
    set objName [lindex $arglist 0]
    set cmd [format "sinfo::%s $args" $objName]
    #sinWrite "DEBUG: $cmd" "value"
#    set cmd $args
    #set cmd "sinfo::list $args"
    #FIXME the command should provide the output code for sinWrite
    #sinWrite [eval $cmd] "value"
    eval $cmd
}

proc sin args {
    set argc [llength $args]
    if {$argc < 1} {
        set msg \
            "sin.usage = \
            { sin \[server|sequencer|device|command\] \[parameter\] }"
        sinWrite $msg "value"
    } else {
        sinWrite [sinfo::list $args] "value"
    }
}