From f0973c61961cd43adc16bb897cc7289f53581203 Mon Sep 17 00:00:00 2001 From: Ferdi Franceschini Date: Wed, 1 Oct 2008 14:10:50 +1000 Subject: [PATCH] Restored file collection feature from 2.0 branch r2718 | ffr | 2008-10-01 14:10:50 +1000 (Wed, 01 Oct 2008) | 2 lines --- .../config/nexus/nxscripts_common_1.tcl | 186 ++++++++++++++---- .../config/source/source_common.tcl | 4 + site_ansto/instrument/util/utility.tcl | 64 +++++- 3 files changed, 215 insertions(+), 39 deletions(-) diff --git a/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl b/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl index 0933b205..3a36a95b 100644 --- a/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl +++ b/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_datatype $type + ::nexus::process_filetype_policy $param(-filetype) filetype_spec + 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"} { - error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller" + if {$caller != $valid_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] - eend [sicstime] - start_seconds [clock seconds] + estart [lindex [sicstime] 1] + eend [lindex [sicstime] 1] + 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 - ::nexus::set_plotdata_info - ::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) } else { - eend [sicstime] - timestamp [expr {[clock seconds] - [SplitReply [start_seconds]]}] - ::nexus::nxreopenfile + eend [lindex [sicstime] 1] + timestamp [expr {[clock seconds] - $start_seconds_array($data_label)}] + 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"} { - error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller" + if {$caller != $valid_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"} { - error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller" + if {$caller != $valid_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 { diff --git a/site_ansto/instrument/config/source/source_common.tcl b/site_ansto/instrument/config/source/source_common.tcl index 6c2832ee..93901546 100644 --- a/site_ansto/instrument/config/source/source_common.tcl +++ b/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 diff --git a/site_ansto/instrument/util/utility.tcl b/site_ansto/instrument/util/utility.tcl index 0ff710ac..c1f1b5d9 100644 --- a/site_ansto/instrument/util/utility.tcl +++ b/site_ansto/instrument/util/utility.tcl @@ -1,7 +1,7 @@ # Some useful functions for SICS configuration. -# $Revision: 1.17 $ -# $Date: 2008-09-24 22:47:12 $ +# $Revision: 1.18 $ +# $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.