SICS-841: Add a oneshot callback facility for scriptcontext drivers.

site_ansto/instrument/util/eventutil.tcl

@@ -64,3 +64,62 @@ proc ::batch::call_cleanup {} {
 }
 publish ::batch::call_cleanup user
 scriptcallback connect exe BATCHEND ::batch::call_cleanup
+
+##
+# @brief Call a command assigned to an hdb property when the given event occurs.
+# This is meant to be called from the read command on an hdb node. It must be
+# called everytime the node is polled so that the oneshot callback can be
+# removed if the given event fails to occur within the allowed time.
+# @param hpath hdb path to a node which regularly calls this procedure.
+# @param event an event which may trigger a callback.
+# @param args is a list of arguments which will be passed to the callback.
+# @return state: -2 = fatal error, -1 = timer expired, 0 = callback triggered, 1 = waiting for event
+# remaining before expiry.
+proc call_oneshot {hpath event args} {
+  if [hpropexists $hpath oneshot_cb] {
+    set start_time [hgetpropval $hpath oneshot_start_time]
+    set timeout [hgetpropval $hpath oneshot_timeout]
+    set useby [expr {$start_time + $timeout}]
+    set currtime [hgetpropval $hpath read_time]
+    set trigger [hgetpropval $hpath oneshot_trigger]
+
+    if {$event == $trigger} {
+      set oneshot_cmd [hgetpropval $hpath oneshot_cb]
+      hdelprop $hpath oneshot_cb
+      hsetprop $hpath oneshot_state 0
+      eval "$oneshot_cmd $hpath $args"
+      return 0
+    } elseif {$event == "fatal_error"} {
+      hdelprop $hpath oneshot_cb
+      hsetprop $hpath oneshot_state -2
+      return -2
+    } elseif {$timeout >= 0} {
+      if {$currtime > $useby} {
+        hdelprop $hpath oneshot_cb
+        hsetprop $hpath oneshot_state -1
+        return -1
+      } else {
+        hsetprop $hpath oneshot_state 1
+        return 1
+      }
+    }
+  }
+}
+
+##
+# @brief Assign a oneshot callback to which is triggered by the given event.
+# 
+# @param hpath hdb path to a node which regularly calls "call_oneshot"
+# @param cb_proc name of the callback procedure
+# @param trigger event for callback
+# @param timeout the callback is removed when the timeout expires.
+# If timeout = 0 the callback will only be called if the trigger event occurs
+# the first time the node is polled. If timeout < 0 then the callback will be
+# called if the trigger event occurs and then it is removed.
+proc set_oneshot {hpath cb_proc event {timeout 60}} {
+  hsetprop $hpath oneshot_cb $cb_proc
+  hsetprop $hpath oneshot_timeout $timeout
+  hsetprop $hpath oneshot_start_time [hgetpropval $hpath read_time]
+  hsetprop $hpath oneshot_trigger $event
+}
+publish set_oneshot user