153 lines
3.2 KiB
Tcl
153 lines
3.2 KiB
Tcl
namespace eval seaclient {
|
|
}
|
|
|
|
proc stdConfig::seaclient {} {
|
|
variable node
|
|
variable ctrl
|
|
variable name
|
|
|
|
if {[controller seaclient 60]} {
|
|
controllerDesc "seaclient connection"
|
|
}
|
|
set node $node/tasks
|
|
prop start seaclient::start
|
|
prop sync "seaclient::sync /$name"
|
|
|
|
obj sea -text wr
|
|
prop write seaclient::write
|
|
prop check seaclient::check
|
|
prop read seaclient::watch
|
|
prop commerror seaclient::commerror
|
|
prop delay 60
|
|
prop mode 1
|
|
prop mode_values "0: disconnect after delay, 1: keep connected, 2: reconnect on write after delay"
|
|
prop lastresponse [clock seconds]
|
|
prop connected 1
|
|
prop cmd ""
|
|
return "SeaClient"
|
|
}
|
|
|
|
proc seaclient::start {} {
|
|
sct send "instrument"
|
|
sct ntry 3
|
|
return seaclient::start2
|
|
}
|
|
|
|
proc seaclient::start2 {} {
|
|
sct lastresponse [clock seconds]
|
|
if {[string match "ERROR: Bad login*" [sct result]]} {
|
|
sct send "seamanager seager"
|
|
return "seaclient::start2"
|
|
}
|
|
if {[sct result] eq "Login OK"} {
|
|
return unpoll
|
|
}
|
|
if {[string match "instrument =*" [sct result]]} {
|
|
return unpoll
|
|
}
|
|
sct ntry [expr [sct ntry] - 1]
|
|
if {[sct ntry] <= 0} {
|
|
clientput "Can not login to [sct parent]"
|
|
return unpoll
|
|
}
|
|
sct send "instrument"
|
|
return "seaclient::start2"
|
|
}
|
|
|
|
proc seaclient::sync {path} {
|
|
[sct controllerName] queue $path write
|
|
return start
|
|
}
|
|
|
|
proc seaclient::watch {} {
|
|
hdelprop [sct] geterror
|
|
set now [clock seconds]
|
|
set mode [sct mode]
|
|
switch $mode {
|
|
0 { # disconnect after delay
|
|
if {[sct connected]} {
|
|
if {$now > [sct lastresponse] + [sct delay]} {
|
|
[sct controllerName] disconnect
|
|
sct connected 0
|
|
}
|
|
}
|
|
}
|
|
1 { # keep connected
|
|
if {![sct connected]} {
|
|
[sct controllerName] reconnect
|
|
sct lastresponse $now
|
|
sct connected 1
|
|
} elseif {$now > [sct lastresponse] + [sct delay]} {
|
|
sct send Poch
|
|
return seaclient::getpoch
|
|
}
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc seaclient::getpoch {} {
|
|
sct connected 1
|
|
sct lastresponse [clock seconds]
|
|
return idle
|
|
}
|
|
|
|
proc seaclient::commerror {} {
|
|
# clientlog "seaman communication failed - ignore"
|
|
[sct controllerName] poll [sct tasksPath] 1 start sync
|
|
return idle
|
|
}
|
|
|
|
proc seaclient::write {} {
|
|
# before last command, "fulltransact" has to inserted
|
|
set cmd [sct cmd]
|
|
if {$cmd eq ""} {
|
|
return idle
|
|
}
|
|
set ntry [sct ntry]
|
|
incr ntry -1
|
|
sct ntry $ntry
|
|
if {$ntry <= 0} {
|
|
clientput "too many tries"
|
|
sct cmd ""
|
|
}
|
|
set last [lindex $cmd end]
|
|
set cmd [lrange $cmd 0 end-1]
|
|
lappend cmd "fulltransact _tcl $last"
|
|
sct send [join $cmd "\n"]
|
|
return seaclient::response
|
|
}
|
|
|
|
proc seaclient::response {} {
|
|
sct cmd ""
|
|
sct lastresponse [clock seconds]
|
|
sct update [sct target]
|
|
return idle
|
|
}
|
|
|
|
proc seaclient::check {} {
|
|
set now [clock seconds]
|
|
if {![sct connected]} {
|
|
[sct controllerName] reconnect
|
|
sct connected 1
|
|
sct lastresponse $now
|
|
} elseif {[sct mode] == 2} {
|
|
if {$now > [sct lastresponse] + [sct delay]} {
|
|
[sct controllerName] reconnect
|
|
sct connected 1
|
|
sct lastresponse $now
|
|
}
|
|
}
|
|
set cmd [sct cmd]
|
|
lappend cmd [sct target]
|
|
sct cmd $cmd
|
|
sct ntry 3
|
|
}
|
|
|
|
|
|
proc seamanager args {
|
|
return "not OK"
|
|
}
|
|
|
|
publishLazy seamanager
|