initial commit

tcl/drivers/seaclient.tcl

@@ -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