Restored file collection feature from 2.0 branch

r2718 | ffr | 2008-10-01 14:10:50 +1000 (Wed, 01 Oct 2008) | 2 lines

site_ansto/instrument/config/nexus/nxscripts_common_1.tcl

@@ -6,12 +6,12 @@
 MakeNXScript
 sicsdatafactory new nxscript_data
 #mkVar name   type  access long_name  nxsave  klass  control data
-::utility::mkVar start_seconds int user start_seconds false entry false false
 ::utility::mkVar estart Text user start_time true entry false true
 ::utility::mkVar eend Text user end_time true entry false true
 ::utility::mkVar timestamp int user time_stamp true entry false true
 ::utility::mkVar data_run_number int user run_number true instrument false true
 ::utility::mkVar nexus_datatype text user DataType true data false true
+::utility::mkVar file_set_list Text user file_set true experiment true true
 sicslist setatt data_run_number mutable true
 sicslist setatt timestamp mutable true
 sicslist setatt timestamp units seconds
@@ -20,7 +20,7 @@ sicslist setatt nexus_datatype mutable false
 namespace eval nexus {
   variable data_gp_path "/data"
   nexus_datatype "UNKNOWN"
-  set exports [list newfile closefile save data]
+  set exports [list newfile closefile save data newfile_collection save_collection]
   eval namespace export $exports
   if 0 {datafilename}
 
@@ -191,9 +191,16 @@ proc newFileName {postfix} {
   proc ::nexus::init {} {
     variable state
     variable nexusdic
+    variable currFilename
+    variable start_seconds_array
+    variable links_and_plotinfo_notdone
+
     array set state {file,new "true" file,open "false" file,namestyle "data"\
               file,format "hdf" file,type "@none"}
     set nexusdic "nexus.dic"
+    array set currFilename ""
+    array set start_seconds_array ""
+    array set links_and_plotinfo_notdone ""
   }
 
   ##
@@ -205,6 +212,8 @@ proc newFileName {postfix} {
     variable nexusdic
     variable state
     variable data_gp_path
+    variable currFilename
+
     if [ catch {
       if {$state(file,open) == "true"} {
           error_msg "Can't create a new file because the current file is still open"
@@ -215,14 +224,16 @@ proc newFileName {postfix} {
       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,namestyle) == "scratch"} {
-        dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format]
-      } else {
-        sicsdatanumber incr
-        dataFileName [newFileName $file_format]
-      }
       hsetprop $data_gp_path currentfiletype [::utility::hgetplainprop $data_gp_path datatype]
-      nxscript $nxmode($file_format) [SplitReply [dataFileName]] $nxdict_path
+      if {$state(file,fileset) == true} {
+        foreach flabel $state(file,labels) {
+          dataFileName $currFilename($flabel)
+          nxscript $nxmode($file_format) $currFilename($flabel) $nxdict_path
+        }
+      } else {
+        dataFileName $currFilename(@singlefile)
+        nxscript $nxmode($file_format) $currFilename(@singlefile) $nxdict_path
+      }
       set state(file,open) false
       set state(file,new) false
     } message ] {
@@ -256,27 +267,74 @@ proc ::nexus::isValidFileType {type} {
   # state(file,open) true state(file,new) false
   # /data/currentfiletype == UNKNOWN
 proc ::nexus::newfile {type {namestyle data}} {
+    ::nexus::newfile_collection -filetype $type -savetype $namestyle 
+}
+
+##
+# @brief Let's make a collection of files (ie a file-set) or just one.
+#
+# @param -label L or {L1 L2 ..}, optional. A list of labels which identify a file-set
+# If you don't specify a list of labels then only one file is created
+proc ::nexus::newfile_collection {args} {
   variable filetype_spec
   variable state
   variable data_gp_path
+  variable currFilename
 
+  set valid_options [list "-labels" "-filetype" "-savetype"]
+  set required_options [list "-filetype" "-savetype"]
   if [ catch {
-    set state(file,namestyle) $namestyle
+    ::utility::check_valid_options $args $valid_options
+    ::utility::check_required_options $args $required_options
+    array set param $args
+    set file_format [SplitReply [SicsDataPostFix]]
+    set state(file,namestyle) $param(-savetype)
+    file_set_list "UNKNOWN"
     set state(file,new) true
+    if [info exists param(-labels)] {
+      set state(file,fileset) "true"
+      set state(file,labels) $param(-labels)
+      if {$param(-savetype) == "scratch"} {
+        foreach fid $state(file,labels) {
+          set currFilename($fid) [format "%s/scratch_%s.%s" [::nexus::datapath] $fid $file_format]
+          lappend files $currFilename($fid)
+          sicsdatanumber incr
+        }
+      } else {
+        foreach fid $state(file,labels) {
+          set currFilename($fid) [newFileName $file_format]
+          lappend files $currFilename($fid)
+          sicsdatanumber incr
+        }
+      }
+      file_set_list [join $files ,]
+    } else {
+      set state(file,fileset) "false"
+      set state(file,labels) @singlefile
+      if {$param(-savetype) == "scratch"} {
+        set currFilename(@singlefile) [format "%s/scratch.%s" [::nexus::datapath] $file_format]
+        sicsdatanumber incr
+      } else {
+        set currFilename(@singlefile) [newFileName $file_format]
+        sicsdatanumber incr
+      }
+    }
     hsetprop $data_gp_path currentfiletype UNKNOWN
-    if {$type == "clear"} {
+    if {$param(-filetype) == "clear"} {
       ::nexus::data clear
       ::hdb::set_save / false
       hsetprop $data_gp_path currentfiletype UNKNOWN
       hsetprop $data_gp_path datatype UNKNOWN
       nexus_datatype "UNKNOWN"
     } else {
-      ::nexus::process_filetype_policy $type filetype_spec
+      ::nexus::process_filetype_policy $param(-filetype) filetype_spec
-      nexus_datatype $type
+      nexus_datatype $param(-filetype)
     }
   } message ] {
     if {$::errorCode=="NONE"} {return $message}
     return -code error $message
+  } else {
+    return OK
   }
 }
 
@@ -291,14 +349,16 @@ proc ::nexus::newfile {type {namestyle data}} {
 # @see ::nexus::savetree
 # @see ::nexus::save
   proc ::nexus::save_data {point} {
+    set valid_caller "::nexus::save_collection"
+
     debug_msg "save point $point in [dataFileName]"
     if [ catch {
       if {[info level]<2} {
         error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
       }
       set caller [namespace origin [lindex [info level -1] 0]]
-      if {$caller != "::nexus::save"} {
+      if {$caller != $valid_caller} {
-        error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
+        error "ERROR: [lindex [info level 0] 0] can only be called via the $valid_caller command, not by $caller"
       }
       foreach child [hlist /] {
         if {[::utility::hgetplainprop /$child data] == "true"} {
@@ -319,11 +379,31 @@ proc ::nexus::newfile {type {namestyle data}} {
 #
 # A new file will be created if the new file state has been set to true, or
 # if the current data type doesn't match the current file type.
-  proc ::nexus::save {{point 0}} {
+proc ::nexus::save {{point 0}} {
+  if [ catch {
+    ::nexus::save_collection -index $point
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  } 
+}
+
+##
+# @brief Save data in a file from a file-set
+  proc ::nexus::save_collection {args} {
     variable state
     variable data_gp_path
+    variable start_seconds_array
+    variable links_and_plotinfo_notdone
+    variable currFilename
 
+    set valid_options [list "-index" "-label"]
+    set required_options [list "-index"]
     if [ catch {
+      ::utility::check_valid_options $args $valid_options
+      ::utility::check_required_options $args $required_options
+      array set param $args
+      set point $param(-index)
       if {[string is integer $point] == 0} {
         error_msg "save index must be an integer"
       } elseif {$point < 0} {
@@ -341,24 +421,52 @@ proc ::nexus::newfile {type {namestyle data}} {
         error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' "
       }
 
+#TODO User must provide a -label if we are creating a file-set
+      if [info exists param(-label)] {
+        if {[lsearch -exact $state(file,labels) $param(-label)] == -1} {
+          error "ERROR: The label must be one of $state(file,labels)"
+        }
+        set data_label $param(-label)
+      } else {
+        if {$state(file,fileset) == "true"} {
+          error "ERROR: You must set -label when saving to a file-set"
+        }
+        set data_label @singlefile
+      }
       if {$isNewFile || $dataTypeChanged} {
         set state(file,new) true
         ::nexus::createfile
-        estart [sicstime] 
+        estart [lindex [sicstime] 1] 
-        eend [sicstime] 
+        eend [lindex [sicstime] 1] 
-        start_seconds [clock seconds]
+        array unset start_seconds_array
+        array unset links_and_plotinfo_notdone
+        set start_seconds [clock seconds]
+        foreach flabel $state(file,labels) {
+          set start_seconds_array($flabel) $start_seconds
+          set links_and_plotinfo_notdone($flabel) "true"
+        }
         timestamp 0
-        ::nexus::nxreopenfile
+        dataFileName $currFilename($data_label)
+        ::nexus::nxreopenfile $currFilename($data_label)
         ::nexus::save_data $point
-        ::nexus::makelinks
+        if $links_and_plotinfo_notdone($data_label) {
-        ::nexus::set_plotdata_info
+          ::nexus::makelinks
-        ::nexus::nxclosefile
+          ::nexus::set_plotdata_info
+          set links_and_plotinfo_notdone($data_label) "false"
+        }
+        ::nexus::nxclosefile $currFilename($data_label)
       } else {
-        eend [sicstime]
+        eend [lindex [sicstime] 1] 
-        timestamp [expr {[clock seconds] - [SplitReply [start_seconds]]}] 
+        timestamp [expr {[clock seconds] - $start_seconds_array($data_label)}] 
-        ::nexus::nxreopenfile
+        dataFileName $currFilename($data_label)
+        ::nexus::nxreopenfile $currFilename($data_label)
         ::nexus::save_data $point
-        ::nexus::nxclosefile
+        if $links_and_plotinfo_notdone($data_label) {
+          ::nexus::makelinks
+          ::nexus::set_plotdata_info
+          set links_and_plotinfo_notdone($data_label) "false"
+        }
+        ::nexus::nxclosefile $currFilename($data_label)
       }
     } message ] {
       ::nexus::nxclosefile
@@ -374,20 +482,22 @@ proc ::nexus::newfile {type {namestyle data}} {
 #
 # @see nxclosefile
 # @see ::nexus::save
-  proc ::nexus::nxreopenfile {} {
+  proc ::nexus::nxreopenfile {filename} {
     global cfPath
     variable state
     variable nexusdic
+    set valid_caller "::nexus::save_collection"
+
     if [ catch {
       if {[info level]<2} {
         error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
       }
       set caller [namespace origin [lindex [info level -1] 0]]
-      if {$caller != "::nexus::save"} {
+      if {$caller != $valid_caller} {
-        error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
+        error "ERROR: [lindex [info level 0] 0] can only be called via the $valid_caller command, not by $caller"
       }
       if {$state(file,open) == "false"} {
-        nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic
+        nxscript reopen $filename $cfPath(nexus)/$nexusdic
         set state(file,open) true
       }
     } message ] {
@@ -402,20 +512,22 @@ proc ::nexus::newfile {type {namestyle data}} {
 #
 # @see nxreopenfile
 # @see ::nexus::save
-  proc ::nexus::nxclosefile {} {
+  proc ::nexus::nxclosefile {filename} {
     variable state
+    set valid_caller "::nexus::save_collection"
+
     if [ catch {
       if {[info level]<2} {
         error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
       }
       set caller [namespace origin [lindex [info level -1] 0]]
-      if {$caller != "::nexus::save"} {
+      if {$caller != $valid_caller} {
-        error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
+        error "ERROR: [lindex [info level 0] 0] can only be called via the $valid_caller command, not by $caller"
       }
       if {$state(file,open) == "true"} {
         nxscript close
         set state(file,open) false
-        set flist [split [SplitReply [dataFileName]] "/"]
+        set flist [split $filename "/"]
         set fname [lindex $flist [expr [llength $flist] - 1] ]
         clientput "$fname updated" "event"
       }
@@ -1085,7 +1197,7 @@ proc ::nexus::script::sdsinfo {script data_type args} {
 namespace import ::nexus::*
 foreach expt $::nexus::exports {
   publish $expt user
-    sicslist setatt $expt privilege internal
+  sicslist setatt $expt privilege internal
 } 
 
 # TODO Return filename from nxcreatefile and call nxreopen nxclose etc
@@ -1099,7 +1211,7 @@ foreach expt $::nexus::exports {
 
 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.42 $}]
+set tmpstr [string map {"$" ""} {$Revision: 1.43 $}]
 set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
 
 #namespace eval data {

site_ansto/instrument/config/source/source_common.tcl

@@ -7,6 +7,7 @@ if {$sim_mode == "true"} {
 "CNS HELIUM INLET TEMPERATURE 6290_09:TI_100.PNT = 19.6426 (08-06-20 12:17:36)"
 "CNS H/E HELIUM OUTLET TEMPERATUR 6290_MB08:TI_712DCI.MEAS = 25.68 (08-06-20 12:17:36)"
 "CNS HELIUM FLOW 6290_09:FI1_106.PNT = 64.2064 (08-06-20 12:17:36)"
+"CG 1,2,3 HELIUM TEMPERATURE.CG 1,2,3 HELIUM TEMPERATURE 6090_08:TI_117.PNT = 31.7781 (08-09-26 14:42:38)"
     }
 		switch $status {
 			"CALIBRATED REACTOR POWER" {
@@ -20,6 +21,9 @@ if {$sim_mode == "true"} {
 			}
 			"CNS HELIUM FLOW" {
 				return [lindex $opal_status 3]
+      }
+      "CG 1,2,3 HELIUM TEMPERATURE" {
+				return [lindex $opal_status 4]
       }
 		  "list" {
 				return $opal_status

site_ansto/instrument/util/utility.tcl

@@ -1,7 +1,7 @@
 # Some useful functions for SICS configuration.
 
-# $Revision: 1.17 $
+# $Revision: 1.18 $
-# $Date: 2008-09-24 22:47:12 $
+# $Date: 2008-10-01 04:10:50 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
 # Last revision by $Author: ffr $
 
@@ -582,6 +582,66 @@ proc ::utility::callstack {} {
   }
 }
 
+##
+# @brief Raises an error if any options in arglist are not in the list of valid_options
+# or if an option is missing a value
+#
+# @param arglist, is the list of name value pairs passed to you procedure
+# @param valid_options, is a list of valid options eg [list "-opt1" "-opt2"]
+proc ::utility::check_valid_options {arglist valid_options} {
+  array set param ""
+
+  if [ catch {
+    foreach {opt val} $arglist {
+      if { [string index $val 0] == "-" || $val == "" } {
+        error "ERROR: argument for $opt is missing"
+      }
+      if [info exists param($opt)] {
+        error "ERROR: duplicate option $opt"
+      }
+      set opt_valid "false"
+      foreach valid_opt $valid_options {
+        if {$opt == $valid_opt} {
+          set opt_valid "true"
+          set param($opt) $val
+          break
+        }
+      }
+      if {$opt_valid == "false"} {
+        error "ERROR: $opt is an invalid option. It should be one of $valid_options"
+      }
+    }
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
+}
+
+##
+# @brief Raises an error if any of the required_options are not in the argument list arglist
+proc ::utility::check_required_options {arglist required_options} { 
+  if [ catch {
+    if {$arglist == ""} {
+      error "ERROR: You must provide the following options: [join $required_options {, }]"
+    }
+
+    foreach req_opt $required_options {
+      set option_missing "true"
+      foreach {opt val} $arglist {
+        if {$req_opt == $opt} {
+          set option_missing "false"
+          break
+        } 
+      }
+      if {$option_missing} {
+        error "ERROR: Required option $req_opt is missing"
+      }
+    }
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
+}
 ##
 # @brief Splits "args" list into a head and tail, useful for scripts
 # where the first argument is a subcommand followed by an argument list.