initial commit
This commit is contained in:
152
tcl/drivers/seaclient.tcl
Normal file
152
tcl/drivers/seaclient.tcl
Normal file
@ -0,0 +1,152 @@
|
||||
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
|
Reference in New Issue
Block a user