- Added Sycamore protocol and command context to SICS
- Added sinfo to SICS - Added driver for TCP/IP Astrium velocity selector - Added driver for TCP/IP Astrium chopper controller SKIPPED: psi/amor2t.c psi/amorstat.c psi/dornier2.c psi/ecb.c psi/el734hp.c psi/fowrite.c psi/libpsi.a psi/make_gen psi/nextrics.c psi/pardef.c psi/pimotor.c psi/pipiezo.c psi/polterwrite.c psi/psi.c psi/scontroller.c psi/serial.c psi/tasinit.c psi/tasscan.c psi/tcpdocho.c psi/tcpdornier.c psi/tricssupport.c psi/velodornier.c
This commit is contained in:
koennecke
387
sinfo.tcl
Normal file
387
sinfo.tcl
Normal file
@@ -0,0 +1,387 @@
|
||||
# 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"
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user