Added code and filetype spec for data file policy

Added  environment controller save and sdsinfo commands.
Dynamically set histogram memory rank and dimensions for data file

r2165 | ffr | 2007-09-26 16:21:23 +1000 (Wed, 26 Sep 2007) | 4 lines

site_ansto/instrument/config/nexus/nxscripts_common_1.tcl

@@ -39,6 +39,120 @@ namespace eval nexus {
   # @brief Records the current Nexus file state.
   variable state
 
+  ##
+  # @brief Specifies the save policy with an optional list of data link sources.
+  #
+  # NOTE: The ::histogram_memory::horizontal_axis and ::histogram_memory::vertical_axis are aliases which
+  # must be set by the instrument specific histogram memory configuration.
+  variable filetype_spec {
+    BEAM_MONITOR {
+      link {axis 1 ::data::gumtree_save_par_run_number}
+      link {data_set ::monitor::count_fb_counts}
+      save_policy {include @all exclude {hmm hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
+    }
+    HISTOGRAM_XYT {
+      link {axis 1 ::data::gumtree_save_par_run_number}
+      link {axis 2 ::histogram_memory::horizontal_axis}
+      link {axis 3 ::histogram_memory::vertical_axis}
+      link {axis 4 ::histogram_memory::time_channel}
+      link {data_set hmm}
+      save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
+    }
+    HISTOGRAM_XY {
+      link {axis 1 ::data::gumtree_save_par_run_number}
+      link {axis 2 ::histogram_memory::horizontal_axis}
+      link {axis 3 ::histogram_memory::vertical_axis}
+      link {data_set hmm_xy}
+      save_policy {include @all exclude {hmm hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
+    }
+    HISTOGRAM_XT {
+      link {axis 1 ::data::gumtree_save_par_run_number}
+      link {axis 2 ::histogram_memory::horizontal_axis}
+      link {axis 3 ::histogram_memory::time_channel}
+      link {data_set hmm_xt}
+      save_policy {include @all exclude {hmm_xy hmm hmm_yt hmm_x hmm_y hmm_t}}
+    } 
+    HISTOGRAM_YT {
+      link {axis 1 ::data::gumtree_save_par_run_number}
+      link {axis 2 ::histogram_memory::vertical_axis}
+      link {axis 3 ::histogram_memory::time_channel}
+      link {data_set hmm_yt}
+      save_policy {include @all exclude {hmm_xy hmm_xt hmm hmm_x hmm_y hmm_t}}
+    } 
+    HISTOGRAM_X {
+      link {axis 1 ::data::gumtree_save_par_run_number}
+      link {axis 2 ::histogram_memory::horizontal_axis}
+      link {data_set hmm_x}
+      save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm hmm_y hmm_t}}
+    } 
+    HISTOGRAM_Y {
+      link {axis 1 ::data::gumtree_save_par_run_number}
+      link {axis 2 ::histogram_memory::vertical_axis}
+      link {data_set hmm_y}
+      save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm hmm_t}}
+    } 
+    HISTOGRAM_T {
+      link {axis 1 ::data::gumtree_save_par_run_number}
+      link {axis 2 ::histogram_memory::time_channel}
+      link {data_set hmm_t}
+      save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm}}
+    }
+  }
+
+  proc ::nexus::process_filetype_policy {filetype filetype_spec} {
+    upvar $filetype_spec ft_spec
+    array set ft_spec_arr $ft_spec
+    if {[info exists ft_spec_arr($filetype)] == 0} {
+      error "$filetype is invalid, should be one of [array names ft_spec_arr]"
+    }
+    set ft_policy $ft_spec_arr($filetype)
+    ::nexus::data clear
+    foreach {pol_type policy} $ft_policy {
+      switch $pol_type {
+        "link" {
+          ::nexus::data $policy
+        }
+        "save_policy" {
+          clientput "save_policy is $policy"
+          foreach {save_action action_list} $policy {
+            switch $save_action {
+              "include" {
+                if {$action_list == "@all"}  {
+                  ::hdb::set_save / true
+                } else {
+                  foreach item $action_list {
+                    if {[getatt $item type] == ""} {
+                      error "ERROR: Unknown $item specified for inclusion in the data file"
+                    }
+                    ::hdb::set_save [getatt $item hdb_path] true
+                  }
+                }
+              }
+              "exclude" {
+                if {$action_list == "@all"}  {
+                  ::hdb::set_save / false
+                } else {
+                  foreach item $action_list {
+                    if {[getatt $item type] == ""} {
+                      error "ERROR: Unknown $item specified for exclusion from the data file"
+                    }
+                    ::hdb::set_save [getatt $item hdb_path] false
+                  }
+                }
+              }
+              default {
+                error "ERROR: Unknown save action $save_action specified in the save policy"
+              }
+            }
+          }
+        }
+        default {
+          error "$pol_type is invalid, should be one of 'link' 'save_policy'"
+        }
+      }
+    }
+  }
+
   set exports [list newfile closefile save data]
   eval namespace export $exports
   if 0 {datafilename}
@@ -48,7 +162,8 @@ namespace eval nexus {
   proc init {} {
     variable state
     variable nexusdic
-    array set state {file,new "true" file,open "false" file,type "data" file,format "hdf"}
+    array set state {file,new "true" file,open "false" file,namestyle "data"\
+              file,format "hdf" file,type "@none"}
     set nexusdic "nexus.dic"
   }
 
@@ -69,7 +184,7 @@ namespace eval nexus {
     set file_format [SplitReply [SicsDataPostFix]]
     array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml]
     set nxdict_path [::nexus::gen_nxdict $nexusdic]
-    if {$state(file,type) == "scratch"} {
+    if {$state(file,namestyle) == "scratch"} {
       dataFileName [format "scratch.%s" $file_format]
     } else {
       sicsdatanumber incr
@@ -81,20 +196,47 @@ namespace eval nexus {
     set state(file,new) false
   }
 
+variable filetypes
+set filetypes [list BEAM_MONITOR HISTOPERIOD_XYT TOTAL_HISTOGRAM_XY TOTAL_HISTOGRAM_XT TOTAL_HISTOGRAM_YT TOTAL_HISTOGRAM_X TOTAL_HISTOGRAM_Y TOTAL_HISTOGRAM_T ]
+##
+# @brief Checks if the given file type is defined.
+#
+# @return 1 on success, 0 on failure
+proc isValidFileType {type} {
+  variable filetypes
+  if {[lsearch $filetypes $type] == -1} {
+    return 0
+  } else {
+    return 1
+  }
+}
   ##
   # @brief Setup file state info for writing a new file.
   #
-  # @param type 
+  # @type data file type as defined in config/nexus/datafiletype.tcl or clear
+  # @param namestyle scratch or data, default=data\n
+  # If namestyle=data, the save command will create numbered files using the ANSTO
+  # file naming convention.\n
+  # If namestyle=scratch, the save command will create scratch files.
   #
   # postconditions:
   # state(file,open) true state(file,new) false
   # /data/currentfiletype == UNKNOWN
-proc newfile {{type data}} {
+proc newfile {type {namestyle data}} {
+    variable filetype_spec
     variable state
 
-    set state(file,type) $type
+    set state(file,namestyle) $namestyle
     set state(file,new) true
     hsetprop /data currentfiletype UNKNOWN
+    if {$type == "clear"} {
+      ::nexus::data clear
+      ::hdb::set_save / false
+      hsetprop /data currentfiletype UNKNOWN
+      hsetprop /data datatype UNKNOWN
+    } else {
+      ::nexus::process_filetype_policy $type filetype_spec
+    }
   }
 
 ##
@@ -128,13 +270,6 @@ proc newfile {{type data}} {
   proc save {{point 0}} {
     variable state
 
-if 0 {
-    if {$args == ""} {
-      set point 0
-    } else {
-      set point [lindex $args 0]
-    }
-}
     if {[string is integer $point] == 0} {
       error_msg "save index must be an integer"
     } elseif {$point < 0} {
@@ -147,6 +282,9 @@ if 0 {
     set currFileType [::utility::hgetplainprop /data currentfiletype]
     set currDataType [::utility::hgetplainprop /data datatype]
     set dataTypeChanged [expr {$currFileType != $currDataType}]
+    if {$currDataType == "UNKNOWN"} {
+      error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' "
+    }
 
     if {$isNewFile || $dataTypeChanged} {
       set state(file,new) true
@@ -205,34 +343,47 @@ if 0 {
 # Clears all link targets and sets the data type identifier to unknown
 # data alias <name>, remove alias <name>
 # data alias <name> <target>, set <name> as an alias for <target> unless it has already been defined.
-  proc data {args} {
+  proc ::nexus::data {args} {
     variable state
+    if {[llength $args] == 1} {
+      set arguments [lindex $args 0]
+    } else {
+      set arguments $args
+    }
 
       set dpath /data
-      set opt [lindex $args 0]
+      set opt [lindex $arguments 0]
-      set arglist [lrange $args 1 end]
+      set arglist [lrange $arguments 1 end]
 
       switch $opt {
         "axis" {
           debug_msg "'axis' case of switch"
-            set axnum [lindex $args 1]
+          set link_target [lindex $arguments 2]
+          set axnum [lindex $arguments 1]
           if {[string is integer $axnum] == 0} {
             error "ERROR: [info level -1]->data, index for data axis should be an integer, not $axnum"
           }
-          set hp $dpath/axis_$axnum
+          if {[getatt $link_target type] == ""} {
-            if {[::utility::hgetplainprop $hp link] == "@none"} {
+            error "Unknown link target $link_target"
-              hsetprop $hp link [getatt [lindex $args 2] id]
-                hsetprop $hp long_name [getatt [lindex $args 2] long_name]
           }
+          set hp $dpath/axis_$axnum
+#          if {[::utility::hgetplainprop $hp link] == "@none"} {
+            hsetprop $hp link [getatt [lindex $arguments 2] id]
+            hsetprop $hp long_name [getatt [lindex $arguments 2] long_name]
+#          }
         }
         "data_set" {
           debug_msg "'data_set' case of switch"
+          set link_target [lindex $arguments 1]
+          if {[getatt $link_target type] == ""} {
+            error "Unknown link target $link_target"
+          }
           hsetprop $dpath datatype [lindex [info level -1] 0]
           set hp $dpath/data_set
-            if {[::utility::hgetplainprop $hp link] == "@none"} {
+#          if {[::utility::hgetplainprop $hp link] == "@none"} {
-              hsetprop $hp link [getatt [lindex $args 1] id]
+            hsetprop $hp link [getatt $link_target id]
-                hsetprop $hp long_name [getatt [lindex $args 1] long_name]
+            hsetprop $hp long_name [getatt $link_target long_name]
-            }
+#          }
         }
         "clear" {
           debug_msg "'clear' case of switch"
@@ -306,7 +457,6 @@ if 0 {
       nxscript putattribute $data_set_alias axes [join $axes_list :]
     }
     ::nexus::nxclosefile
-      ::nexus::data clear
   }
 
   ##
@@ -440,6 +590,10 @@ if 0 {
       sicslist setatt $sobj savecmd ::nexus::singlecounter::save
       sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo
     }
+    foreach sobj [sicslist type environment_controller] {
+      sicslist setatt $sobj savecmd ::nexus::environment_controller::save
+      sicslist setatt $sobj sdsinfo ::nexus::environment_controller::sdsinfo
+    }
     foreach sobj [sicslist kind script] {
       sicslist setatt $sobj savecmd ::nexus::script::save
       sicslist setatt $sobj sdsinfo ::nexus::script::sdsinfo
@@ -449,7 +603,7 @@ if 0 {
 
 namespace eval ::nexus::histmem {}
 namespace eval ::nexus::motor {}
-namespace eval ::nexus::evcontroller {}
+namespace eval ::nexus::environment_controller {}
 namespace eval ::nexus::sicsvariable {}
 namespace eval ::nexus::singlecounter {}
 namespace eval ::nexus::script {}
@@ -485,28 +639,35 @@ proc ::nexus::hdb2nx_type {dtype} {
 #
 # @see set_sobj_attributes 
 proc ::nexus::histmem::save {hm nxalias data_type args} {
-  set dim0 [SplitReply [$hm configure dim0]]
+  set rank [SplitReply [$hm configure rank]]
-    set dim1 [SplitReply [$hm configure dim1]]
+
-    set dim2 [SplitReply [$hm configure dim2]]
+  set datalen 1
-    nxscript updatedictvar padim0 $dim0
+  set indStartList [lindex $args 1]
-    nxscript updatedictvar padim1 $dim1 
+  set indLenList [list 1]
-    nxscript updatedictvar padim2 $dim2 
+  for {set i 0} {$i < $rank} {incr i} {
+    lappend indStartList 0
+    set dim$i [SplitReply [$hm configure dim$i]]
+    lappend indLenList [set dim$i]
+    set datalen [expr $datalen * [set dim$i]]
+    nxscript updatedictvar padim$i [set dim$i]
+  }
   set data_start 0
-    set datalen [expr {$dim0 * $dim1 * $dim2}]
   set bank 0
-    if {[lindex $args 0] == "point"} {
+  nxscript putslab $nxalias $indStartList $indLenList $hm $data_start $datalen $bank
-      set index [lindex $args 1]
-        nxscript putslab $nxalias [list $index 0 0 0] [list 1 $dim0 $dim1 $dim2] $hm $data_start $datalen $bank
-    } else {
-    }
 }
+
+# TODO Get rank from /data
 proc ::nexus::histmem::sdsinfo {hm data_type args} {
   array set param $args
   array set hm_prop [attlist $hm]
+  set rank [SplitReply [$hm configure rank]]
+
+  for {set i 0} {$i < $rank} {incr i} {lappend dimstr "\$(padim$i)"}
+  set dimstr [join $dimstr ,]
   if {$param(mutable) == true} {
-      return " -type NX_INT32 -LZW -rank 4 -dim {-1,\$(padim0),\$(padim1),\$(padim2)}"
+    return " -type NX_INT32 -LZW -rank [expr $rank+1] -dim {-1,$dimstr}"
   } else {
-      return " -type NX_INT32 -LZW -rank 3 -dim {\$(padim0),\$(padim1),\$(padim2)}"
+    return " -type NX_INT32 -LZW -rank $rank -dim {$dimstr}"
   }
 }
 
@@ -538,7 +699,7 @@ proc ::nexus::motor::sdsinfo {motor data_type args} {
     }
 }
 
-proc ::nexus::evcontroller::save {evc nxalias data_type args} {
+proc ::nexus::environment_controller::save {evc nxalias data_type args} {
   if {[lindex $args 0] == "point"} {
     set index [lindex $args 1]
       nxscript_data clear
@@ -548,7 +709,7 @@ proc ::nexus::evcontroller::save {evc nxalias data_type args} {
     nxscript putfloat $nxalias [SplitReply [$evc]]
   }
 }
-proc ::nexus::evcontroller::sdsinfo {evc data_type args} {
+proc ::nexus::environment_controller::sdsinfo {evc data_type args} {
   array set param $args
     array set evc_prop [attlist $evc]
     set dtype [::nexus::hdb2nx_type $data_type]
@@ -641,7 +802,7 @@ proc ::nexus::script::sdsinfo {script data_type args} {
 
 set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}]
 set nx_content_release_tag [lindex $tmpstr [expr [llength $tmpstr] - 1]]
-set tmpstr [string map {"$" ""} {$Revision: 1.29 $}]
+set tmpstr [string map {"$" ""} {$Revision: 1.30 $}]
 set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
 
 namespace eval data {