SICS-601: Provide a command to get the textstatus list from the histogram server.

site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl

@@ -12,7 +12,6 @@
 #
 #@see ::histogram_memory::ic_initialize
 
-
 source $cfPath(hmm)/hmm_object.tcl
 namespace eval histogram_memory {
   # Common config variables
@@ -1778,6 +1777,68 @@ Publish SAT_TABLE user
       return -code error "([info level 0]) $message"
     }
   }
+
+  # Make controller for histmem textstatus. Used by hmstat proc
+  set host [dict get $::HISTMEM_HOSTPORT HMMSTAT HOST]
+  set port [dict get $::HISTMEM_HOSTPORT HMMSTAT PORT]
+  MakeSctController sct_hmm astvelsel $host:$port
+
+  proc ::histogram_memory::hmstat {args} {
+    set startIndex -1
+    # Try three times to get at least some data following the HTTP header.
+    # Usually we get all the data but sometimes we just get the header.
+    for {set i 0} {$i < 3 && $startIndex == -1} {incr i} {
+      set req "GET /admin/textstatus.egi HTTP/1.1\r\nAuthorization: Basic bWFuYWdlcjphbnN0bw==\r\n"
+      set textstatus [sct_hmm transact $req]
+      set lTextStatus [split $textstatus \n]
+      set startIndex [lsearch -glob $lTextStatus HM-Host*]
+    }
+    # Throw away HTTP header
+    set lTextStatus [lrange $lTextStatus $startIndex end]
+
+    # Create text status array
+    foreach l $lTextStatus {
+      if {[string length $l] == 0} {
+        continue
+      }
+      set v [split $l ':']
+      set key [lindex $v 0]
+      set val [lindex $v 1 0]
+      if [string is double $val] {
+        set hmarr($key) $val
+      } else {
+        set hmarr($key) '$val'
+      }
+    }
+
+    # Return requested values to user
+    set argc [llength $args]
+    switch $argc {
+      0 {
+        set keys [array names hmarr]
+        foreach k [lrange $keys 0 end-1] {
+          lappend d "'$k': $hmarr($k),"
+        }
+        set k [lindex $keys end]
+        lappend d "'$k': $hmarr($k)"
+        return [join $d]
+      }
+      1 {
+        return $hmarr($args)
+      }
+      default {
+        foreach k [lrange $args 0 end-1] {
+          lappend d "'$k': $hmarr($k),"
+        }
+        set k [lindex $args end]
+        lappend d "'$k': $hmarr($k)"
+        return [join $d]
+      }
+    }
+  }
+  # Poll to keep HTTP connection alive
+  sicspoll add ::histogram_memory::hmstat script 30 ::histogram_memory::hmstat
+
 namespace eval ::histogram_memory {
 #TODO Create GumTree commands to setup, start and stop the histmem
   ##
@@ -1796,6 +1857,7 @@ namespace eval ::histogram_memory {
   #command stop_condition {text:immediate,period condition} 
 }
 
+
   ##
   # @brief Convenience command providing user interface to histogram control
   #
@@ -1856,6 +1918,9 @@ namespace eval ::histogram_memory {
         "status" {
           set reply [::histogram_memory::hmm_status]
         }
+        "textstatus" {
+          set reply [eval "::histogram_memory::hmstat $args"]
+        }
         "loadconf" {
           # Loads configuration tables (OAT, FAT, ...) to histogram server
           if {$args == ""} {