Add a writeTree capability for writing hdb trees and properties

r3477 | dcl | 2012-03-21 13:36:09 +1100 (Wed, 21 Mar 2012) | 1 line

site_ansto/instrument/util/utility.tcl

@@ -6,6 +6,8 @@ source util/extra_utility.tcl
 source util/eventutil.tcl
 source util/motor_utility.tcl
 source util/command.tcl
+source util/write_tree.tcl
+
 namespace eval environment { }
   # @brief Return the number of sensors for a given environment object
   proc ::environment::getnumsensors {sobj} {

site_ansto/instrument/util/write_tree.tcl

@@ -0,0 +1,41 @@
+  proc ::utility::writeNode {tc_root { do_props 0 } { level 0 }} {
+    set space [string repeat "  " $level]
+    set val [hval $tc_root]
+    set nam [lindex [split $tc_root "/"] end]
+    if {"$val" == ""} {
+      set line "$nam ([hinfo $tc_root])"
+    } else {
+      set line "$nam ([hinfo $tc_root]) = $val"
+    }
+    clientput "$space* $line"
+    if {"[string tolower "$do_props"]" == "-prop"} {
+      set props [hlistprop $tc_root]
+      #clientput "<<$props>>"
+      foreach prop $props {
+        #clientput "prop: $prop"
+        set flds [split $prop "="]
+        #clientput "flds: $flds"
+        if {[llength $flds] > 1} {
+          set fld0 [lindex $flds 0]
+          #clientput "fld0: $fld0"
+          if {[hpropexists $tc_root $fld0]} {
+            set rst [hgetprop $tc_root $fld0]
+            set nam [lindex [split [lindex $rst 0] "."] 1]
+            set rst [join [lrange [split $rst " "] 1 end] " "]
+            clientput "$space    - $nam $rst"
+          }
+        }
+      }
+    }
+    foreach node [hlist $tc_root] {
+      ::utility::writeNode $tc_root/$node "$do_props" [expr {$level + 1}]
+    }
+  }
+
+  proc writeTree {tc_root {do_props 0}} {
+    clientput "$tc_root"
+    ::utility::writeNode $tc_root $do_props 1
+    return "Done"
+  }
+publish writeTree user
+