485 lines
13 KiB
Tcl
485 lines
13 KiB
Tcl
# support for Frappy
|
|
|
|
proc find_config {files obj {driver 0}} {
|
|
# try to find out in which of the files the object was defined
|
|
set config ""
|
|
foreach file $files {
|
|
lassign [split $file .] addon kind
|
|
if {$kind eq "config"} {
|
|
set config $file
|
|
} else {
|
|
if {[addon_$addon exists $obj]} {
|
|
return $file
|
|
}
|
|
}
|
|
}
|
|
return $config
|
|
}
|
|
|
|
proc cfg_files {} {
|
|
set name [samenv name]
|
|
set nl [split $name /]
|
|
set files []
|
|
if {[llength $nl] == 1} {
|
|
lappend files ${name}.config
|
|
} else {
|
|
set name [lindex $nl 0]
|
|
lappend files ${name}.config
|
|
set selected_stick [lindex $nl 1]
|
|
if {[file exists ${selected_stick}.stick]} {
|
|
set selected_addons [lrange $nl 2 end]
|
|
} else {
|
|
set selected_stick ""
|
|
set selected_addons [lrange $nl 1 end]
|
|
}
|
|
if {$selected_stick ne ""} {
|
|
lappend files ${selected_stick}.stick
|
|
}
|
|
foreach addon $selected_addons {
|
|
lappend files ${addon}.addon
|
|
}
|
|
}
|
|
return $files
|
|
}
|
|
|
|
proc get_obj_path {obj} {
|
|
set g [silent "" hgetpropval /$obj group]
|
|
if {$g eq "_pardef_"} {
|
|
return /$obj
|
|
}
|
|
return [silent /sics/$obj hgetpropval /sics/$obj objectPath]
|
|
}
|
|
|
|
proc describe_node {base path {visibility 1}} {
|
|
upvar result result
|
|
|
|
set hp $base/$path
|
|
lassign [split [hinfo $hp] ,] type nkids length
|
|
set enum [silent 0 hgetpropval $hp enum_]
|
|
if {$enum eq "0"} {
|
|
set enum [silent 0 hgetpropval $hp enum]
|
|
}
|
|
set extra ""
|
|
if {$enum eq "1"} {
|
|
set type bool
|
|
} elseif {$enum ne "0"} {
|
|
set type enum
|
|
set idx 0
|
|
set elements [list]
|
|
foreach item [split $enum ,] {
|
|
lassign [split $item =] name num
|
|
if {$num != ""} {
|
|
set idx $num
|
|
}
|
|
lappend elements [format {"%s": %d} $name $idx]
|
|
incr idx
|
|
}
|
|
set extra [format {, "enum": {%s}} [join $elements ", "]]
|
|
}
|
|
set item [list [format {"path": "%s", "type": "%s"%s} $path $type $extra]]
|
|
set priv [silent internal hgetpropval $hp priv]
|
|
if {$priv eq "internal"} {
|
|
lassign [split $base /] null obj
|
|
if {[sicstype $obj] eq "DRIV" && $path eq ""} { # treat special easedriv (mf, old ips)
|
|
lappend item {"readonly": false} [format {"cmd": "run %s"} $obj]
|
|
}
|
|
} else {
|
|
lappend item {"readonly": false} [format {"cmd": "%s"} [hgetpropval $hp sicscommand]]
|
|
}
|
|
set description [silent "" hgetpropval $hp help]
|
|
if {$description ne ""} {
|
|
lappend item [format {"description": "%s"} $description]
|
|
}
|
|
if {[silent true hgetpropval $hp visible] eq "false"} {
|
|
lappend item {"visibility": 3}
|
|
} elseif {$visibility != 1} {
|
|
lappend item [format {"visibility": %s} $visibility]
|
|
}
|
|
if {$nkids > 0} {
|
|
lappend item [format {"kids": %d} $nkids]
|
|
}
|
|
lappend result [format {{%s}} [join $item ", "]]
|
|
if {$nkids > 0} {
|
|
if {[silent "" hgetpropval $hp group] ne ""} {
|
|
set visibility 1
|
|
} else {
|
|
set visibility 3
|
|
}
|
|
foreach kid [hlist $hp] {
|
|
if {[catch {
|
|
#describe_node $hp [join "$path $kid" /] $visibility
|
|
if {[silent "" hgetpropval $hp/$kid sicsdev] eq ""} {
|
|
describe_node $base [join "$path $kid" /] $visibility
|
|
}
|
|
} msg]} {
|
|
clientput "WARNING: $msg"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
proc describe_obj {obj} {
|
|
# make a json description out of a SICS object.
|
|
set result [list]
|
|
set hp [get_obj_path $obj]
|
|
describe_node $hp ""
|
|
set cfgfile [find_config [cfg_files] $obj]
|
|
if {[llength $cfgfile] == 0} {
|
|
error "can not find config file for $obj"
|
|
}
|
|
if {[llength $cfgfile] > 1} {
|
|
clientput "WARNING: ambiguous config file for $obj: $cfgfile"
|
|
lassign $cfgfile cfgfile
|
|
}
|
|
set params [join $result ",\n "]
|
|
return [format {["%s",%s"%s", {"base": "%s", "params": [%s]}]} $cfgfile "\n" $obj $hp "\n $params\n"]
|
|
}
|
|
|
|
proc describe_all {} {
|
|
set objs [list]
|
|
foreach obj [obj_list items] {
|
|
if {![string match _* $obj] && ![string match addon_* $obj]} {
|
|
if {[catch {
|
|
lappend objs [describe_obj $obj]
|
|
} msg]} {
|
|
clientput "WARNING: $msg"
|
|
}
|
|
}
|
|
}
|
|
set descr [list]
|
|
lappend descr [format {"%s.config": "%s"} [result device name] [result deviceDesc]]
|
|
set stick_name [result device stick_name]
|
|
if {$stick_name ne ""} {
|
|
lappend descr [format {"%s.stick": "%s"} $stick_name [result stickDesc]]
|
|
}
|
|
foreach addon [addon_list items] {
|
|
lappend descr [format {"%s.addon": "%s"} $addon [findDesc ${addon}.addon addonDesc]]
|
|
}
|
|
return [format {[{%s}, [%s]]} [join $descr ", "] [join $objs ",\n"]]
|
|
}
|
|
|
|
proc get_param_values {hp} {
|
|
lassign [split [hinfo $hp] ,] type nkids length
|
|
if [catch {
|
|
# trigger notify event
|
|
hupdate $hp [hval $hp]
|
|
} msg] {
|
|
if {$type ne "none"} {
|
|
clientput [format "_E /%s %s" $hp $msg] warning
|
|
}
|
|
set type none
|
|
}
|
|
if {$nkids > 0} {
|
|
foreach kid [hlist $hp] {
|
|
get_param_values $hp/$kid
|
|
}
|
|
}
|
|
}
|
|
|
|
proc check_or_do {doit service cfgs} {
|
|
# result: 1: no change needed, 0: change needed, "ERROR:...": failure
|
|
set result 1
|
|
set config ""
|
|
set stick ""
|
|
set addons [list]
|
|
|
|
foreach cfg $cfgs {
|
|
if {[regexp {(.*)\.addon} $cfg -> addon]} {
|
|
if {![addon_list exists $addon]} {
|
|
device makeitem frappy_u_addon 1
|
|
lappend addons $addon
|
|
}
|
|
} elseif {![regexp {(.*)\.config} $cfg -> config] && ![regexp {(.*)\.stick} $cfg -> stick]} {
|
|
error "what is $cfg?"
|
|
}
|
|
}
|
|
if {$config ne ""} {
|
|
device makeitem frappy_u_config 1
|
|
if {$config ne [hval /device/name]} {
|
|
if {$doit} {
|
|
if {[hval /device/confirmed] eq [hval /device/name]} {
|
|
set msg "do not allow frappy to change from [hval /device/name] to $config"
|
|
clientlog ERROR:$msg
|
|
return $msg
|
|
}
|
|
clientlog 0
|
|
clientlog TRANSACTIONFINISHED
|
|
samenv -q $config
|
|
} else {
|
|
device makeitem frappy_u_config 0
|
|
}
|
|
if {[hval /device/name] == "none"} {
|
|
return none
|
|
}
|
|
set result 0
|
|
}
|
|
}
|
|
if {$stick ne ""} {
|
|
device makeitem frappy_u_stick 1
|
|
if {$stick ne [hval /device/stick_name]} {
|
|
if {$doit} {
|
|
clientlog 0
|
|
clientlog TRANSACTIONFINISHED
|
|
addon stick $stick
|
|
} else {
|
|
device makeitem frappy_u_stick 0
|
|
}
|
|
if {[hval /device/name] == "none"} {
|
|
return nonestick
|
|
}
|
|
set result 0
|
|
}
|
|
}
|
|
foreach addon $addons {
|
|
if {$doit} {
|
|
clientlog 0
|
|
clientlog TRANSACTIONFINISHED
|
|
addon $addon
|
|
} else {
|
|
device makeitem frappy_u_addon 0
|
|
}
|
|
set result 0
|
|
}
|
|
device makeitem frappy_$service $cfgs
|
|
# return 1 when nothing has to be changed
|
|
return $result
|
|
}
|
|
|
|
proc frappy_config {service args} {
|
|
check_or_do 1 $service $args
|
|
}
|
|
|
|
proc check_config {service args} {
|
|
return [check_or_do 0 $service $args]
|
|
}
|
|
|
|
proc activate_stick {} {
|
|
set prev [hval /device/stick_label]
|
|
frappy_config stick secop.stick
|
|
# stick_label was changed - set it again
|
|
device stick_label $prev
|
|
}
|
|
|
|
proc activate_addon {} {
|
|
frappy_config addons secop.addon
|
|
}
|
|
|
|
proc sea_recorder {main stick addons} {
|
|
set defer 0
|
|
if {$main ne "0"} {
|
|
lassign [split $main /] uri name
|
|
if {$name eq ""} { set name $uri }
|
|
samenv none
|
|
cfg_env makeitem _secop $uri
|
|
frappy_config stick secop.config
|
|
device name_label "SECoP/$name"
|
|
set defer _secop
|
|
}
|
|
if {$stick ne "0"} {
|
|
lassign [split $stick /] uri name
|
|
if {$name eq ""} { set name $uri }
|
|
addon stick none
|
|
cfg_env makeitem _secopstick $uri
|
|
device stick_label "SECoP/$name"
|
|
if {$defer eq "0"} {
|
|
set defer _secopstick
|
|
frappy_config stick secop.stick
|
|
} else {
|
|
hsetprop /sics/$defer activate_stick 1
|
|
}
|
|
}
|
|
if {$addons ne "0"} {
|
|
lassign [split $addons /] uri name
|
|
addon delete secop
|
|
cfg_env makeitem _secopaddon $uri
|
|
# device addon_label $name
|
|
if {$defer eq "0"} {
|
|
frappy_config addons secop.addon
|
|
} else {
|
|
hsetprop /sics/$defer activate_addon 1
|
|
}
|
|
}
|
|
}
|
|
|
|
proc frappy_remove {service} {
|
|
set cfgs [silent "" result device frappy_$service]
|
|
set config ""
|
|
set addons [list]
|
|
foreach cfg $cfgs {
|
|
if {[regexp {(.*)\.addon} $cfg -> addon]} {
|
|
lappend addons $addon
|
|
} elseif {![regexp {(.*)\.config} $cfg -> config] && ![regexp {(.*)\.stick} $cfg -> stick]} {
|
|
error "what is $cfg?"
|
|
}
|
|
}
|
|
if {"$config" ne ""} {
|
|
samenv none
|
|
}
|
|
foreach addon $addons {
|
|
if {[addon_list exists $addon]} {
|
|
addon delete $addon
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
proc frappy_async_client {} {
|
|
protocol set json
|
|
hnotify /device/changetime 2
|
|
hnotify /device/frappy_main 2
|
|
hnotify /device/frappy_stick 2
|
|
hnotify /device/frappy_addons 2
|
|
}
|
|
|
|
proc get_all_param {args} {
|
|
foreach obj $args {
|
|
catch {
|
|
set hp [get_obj_path $obj]
|
|
hnotify $hp 1
|
|
get_param_values $hp
|
|
}
|
|
# todo: create error message on failure
|
|
}
|
|
}
|
|
|
|
proc error_update_script {hp} {
|
|
hupdate $hp/_read_error [silent "" hgetpropval $hp geterror]
|
|
}
|
|
|
|
proc register_node {hp} {
|
|
# register hipadaba path hp (and <hp>/is_running. if availabale)
|
|
# 0: not recursive
|
|
hnotify $hp 1 0
|
|
catch {
|
|
hfactory $hp/_read_error plain internal text
|
|
}
|
|
hsetprop $hp/_read_error visible false
|
|
set upd "error_update_script $hp"
|
|
if {[silent "" hgetpropval $hp updatescript] ne $upd} {
|
|
hscriptnotify $hp $upd
|
|
}
|
|
hnotify $hp/_read_error 1 0
|
|
if [catch {
|
|
# trigger notify event
|
|
hupdate $hp [hval $hp]
|
|
} msg] {
|
|
clientput [format "_E %s %s" $hp $msg] warning
|
|
}
|
|
catch {
|
|
# in case of sct drivable
|
|
hnotify $hp/is_running 1 0
|
|
}
|
|
}
|
|
|
|
proc put_secop_info {{path ""}} {
|
|
set newmodules [list "" $path]
|
|
set trigger [list]
|
|
while {[llength $newmodules]} {
|
|
set modulestodo $newmodules
|
|
set newmodules []
|
|
foreach {module modnode} $modulestodo {
|
|
set modlen [expr [string length $modnode] + 1]
|
|
set newnodes [list $modnode]
|
|
set keydict [dict create]
|
|
while {[llength $newnodes]} {
|
|
set nodelist $newnodes
|
|
set newnodes [list]
|
|
foreach node $nodelist {
|
|
set newmodule [silent "" hgetpropval $node secop_module]
|
|
if {$newmodule ne "" && $newmodule ne $module} {
|
|
hsetprop $node secop_module $newmodule
|
|
lappend newmodules $newmodule $node
|
|
} else {
|
|
lassign [split [hinfo $node] ,] type nkids size
|
|
foreach kid [hlist $node] {
|
|
lappend newnodes $node/$kid
|
|
}
|
|
if {$module eq ""} continue
|
|
switch $type {
|
|
float - int - text {
|
|
if {$node eq $modnode} {
|
|
set key value
|
|
} else {
|
|
set key [lindex [split $node /] end]
|
|
if {$node ne "$modnode/$key"} {
|
|
hsetprop $node secop_group [join [lrange [split $node /] [llength [split $modnode /]] end-1] .]
|
|
}
|
|
}
|
|
if {[dict exists $keydict $key]} {
|
|
set other [dict get $keydict $key]
|
|
if {[llength [split $other /]] eq [llength [split $node /]]} {
|
|
hsetprop $other secop_id ${module}:[string map {/ _} [string range $other $modlen end]]
|
|
dict unset keydict $key
|
|
}
|
|
set key [string map {/ _} [string range $node $modlen end]]
|
|
} else {
|
|
dict set keydict $key $node
|
|
}
|
|
hsetprop $node secop_id ${module}:$key
|
|
lappend trigger $node
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
foreach node $trigger {
|
|
if {[catch {hupdate $node [hval $node]}]} {
|
|
logsetup $node 0
|
|
logsetup $node clear
|
|
}
|
|
}
|
|
}
|
|
|
|
proc treatvars {} {
|
|
set vdict [dict create]
|
|
foreach data [hval /vars] {
|
|
lassign [split $data |] var unit label color
|
|
set key [string map {. __} $var]
|
|
dict set vdict $key [list $var $unit $label $color]
|
|
}
|
|
set keys [silent 0 hlist /graph_data]
|
|
if {$keys eq "0"} {
|
|
hfactory /graph_data plain spy text
|
|
set keys [list]
|
|
}
|
|
# disable unused curves
|
|
foreach key $keys {
|
|
if {![dict exists $vdict $key]} {
|
|
set data [lrange [hval /graph_data/$key] 1 end]
|
|
hupdate /graph_data/$key [concat 0 $data]
|
|
}
|
|
}
|
|
# loop over vars: enable curves and create curve metadata
|
|
foreach {key data} [dict get $vdict] {
|
|
set old [silent "" hval /graph_data/$key]
|
|
if {$old eq ""} {
|
|
hfactory /graph_data/$key plain spy text
|
|
lassign $data var
|
|
set secop_id [silent "" hgetpropval [string map {. /} $var] secop_id]
|
|
if {$secop_id eq ""} {
|
|
put_secop_info /$var
|
|
hsetprop /graph_data/$key secop_id "#GRAPH_$secop_id"
|
|
}
|
|
logsetup /graph_data/$key 0
|
|
}
|
|
hupdate /graph_data/$key [concat 1 $data]
|
|
}
|
|
}
|
|
|
|
hscriptnotify /vars treatvars
|
|
|
|
publishLazy describe_all Spy
|
|
publishLazy describe_all2 Spy
|
|
publishLazy get_all_param Spy
|
|
publishLazy register_node Spy
|
|
publishLazy get_param_values Spy
|
|
publishLazy frappy_async_client Spy
|
|
publishLazy frappy_config Spy
|
|
publishLazy frappy_remove Spy
|
|
publishLazy check_config Spy
|
|
publishLazy describe_obj Spy
|
|
publishLazy treatvars
|
|
publishLazy sea_recorder
|