Download

package StampKeywords;
use strict;
use English;
use Carp;
use vars
  qw(@ISA $VERSION $name $author $date $version @instList $numberOfStreams);
@ISA = qw(Module);
use ModuleResources;

# Declare identity, version, author, date, etc.
$name    = __PACKAGE__;
$VERSION = '2.08';
$version = $VERSION;
$author  = 'Richard West,Dean Hinshaw,Duncan John Fyfe,Duncan Law-Green,Ed Chapin, Jose V Perea';
$date    = '2016-07-26';

#
# ChangeLog
# =========
#
# Version 2.08 - 2016-07-26 (JVP)
# ------------
#
# + MTFLAG keyword included in all FITS products if the observation is processed in the target reference frame ( SSO: --sso_object )
#
# Version 2.07 - 2013-06-11 (EC)
# ------------
#
# + Merge changes from SOC version.
#
# version 2.06 - 2010-07-13 DLG
# ------------
#
# + Modify comment on SASVERS re SCR300.
#
# version 2.06B - 2010-05-17 DLG
# ------------
#
# + SLEW ONLY: ***DISABLED*** Take out of flow control, StampKeywords absorbed into slew Finalize pro tem. 
#
# version 2.06A - 2010-05-13 DLG
# ------------
#
# + SLEW ONLY: Modify module flow control for slew pipeline to insert StampKeywords between SlewProcess and Finalize
#
# version 2.05 - 2007-03-11 DJF
# ------------
#
# + Add filter to avoid applying addattribute to ACDS files. We really really really want to avoid running addattribute on ACDS products.
#   This can happen if we restart a post ACDS sequence at a pre ACDs stage and apply --acds_magic=1
#
# version 2.04 - 2006-08-11 DJF
# ------------
#
# + Add ODFVER keyword, value ==  ODF_VERSION 
#
# version 2.03 - 2005-11-21 IMS
# ------------
#
# + TEMPORARILY! commented out the requirement that ReceiveACDS be complete before this module is started. This in an attempt to generate the ppssumm thingies for the screeners.
#
# version 2.02 - 2005-11-21 IMS
# ------------
#
# + Added RGSMakeFluxed to evaluateRules.
#
# version 2.01 - 2005-08-02 IMS
# ------------
#
# + Added test on EPICSourceProducts to evaluateRules.
#
# version 2.00 - 2005-05-09 DJF
# ------------
#
# + Add explicit perl module headers.  Previously these were supplied
#   at compile time.  This will make debugging and extending the modules
#   through additional perl libraries easier.
#
# + Code layout made more uniform with perltidy
# + Standerdized date format (ccyy-mm-dd)
# + Standerdized author list to use comma separator
# + Make use of perl $VERSION magic.  Now $Version = version = ''
##
# Version 1.13 - 2004-03-18 (DJF)
# ------------
#
# + Removed extra quotes around PROCREV comment text which were having undesirable side effects.
#
# Version 1.12 - 2003-12-10 (DJF)
# ------------
#
# + Adapted doCommand to use anonymous lists for list parameters.
#
# Version 1.11 - 2003-06-25 (DJF)
# ------------
#
# + Version number increased to ease configuration control.
#   No functional changes made.
#
# Version 1.10 - 2001-10-31 (DJF)
# ------------
#
# + Chage evaluateRules.  Added dependance on OMFastAnalyse
#
# Version 1.09 - 2001-10-31 (DJF)
# ------------
#
# + Amended start conditios to take account of new module OMMosaic
#
# Version 1.08 - 2001-08-23 (DJF)
# ------------
#
# + Spelling correction.  ODSSVER => ODSVER
#
# Version 1.07 - 2001-08-20 (DJF)
# ------------
#
# + Added keywords ODVSER and REVOLUT
#
# Version 1.06 - 2001-05-03 (DH)
# ------------
#
# + Use new functionality of addattribute to add all
#   the keywords to a file in one go.
#
# Version 1.05 - 2001-03-16 (DH)
# ------------
#
# + Print out version number in performAction() for
#   tracking purposes.
#
# Version 1.04 - 2001-03-09 (DH)
# ------------
#
# + DAL bug fixed, so write keywords into 'cat' products
#   again.
#
# Version 1.03 - 2001-01-09 (DH)
# ------------
#
# + Rewrite evaluateRules to account for some modules being
#   ignored, and remove redundancies.
#
# Version 1.02 - 2000-12-19 (DH)
# ------------
#
# + Don't write keywords into 'cat' products, due to
#   DAL bug.
#
# Version 1.01 - 2000-12-12 (DH)
# ------------
#
# + First production version.
#
# Declare list of instruments this module is interested in
@instList = qw(all);

# Number of streams
sub numberOfStreams
{
    return 1;
}

# Rules method
sub evaluateRules
{
    if ( $ENV{PCMS_ISSLEW} )
    {
        start()
    	if allComplete(module => 'Slewfoobar' );
    }
    else
    {
        start()
    #      if allComplete( module  => 'ReceiveACDS' )
    #      and allComplete( module => 'RGSProducts' )
    if allComplete(module => 'RGSProducts' )
          and allComplete( module => 'RGSMakeFluxed' )
          and allComplete( module => 'OMSourceCombine' )
          and allComplete( module => 'OMMosaic' )
          and allComplete( module => 'OMFastAnalyse' )
          and allComplete( module => 'EPICSourceProducts' )
	  and allComplete( module => 'LCMerge' )
    }
}

# Action method
sub performAction
{
    info("Module version number: $version");

    # Fetch list of product files
    my @list = findFile(
        class => 'product'
        , 'format' => 'FITS'
    );

	# We really really really want to avoid running addattribute on ACDS products.
    # This can happen if we restart a post ACDS sequence at a pre ACDs stage and apply --acds_magic=1
	@list = grep { $_ !~ /CAX000/} @list;

    return success() unless @list;

    # Fetch observation properties
    my $obs    = getObservationProperties();
    my $odsver = getOdsVer();
    my $odfver = getOdfVer();

    # Use any old file to get global properties (like seq id)
    my $info = fileInfo( class => 'product', name => $list[0] );
    my ( @name, @type, @value, @bool_value, @comment, @withcomment );

    ############################################################################
    #  DEBUG
    #
    # info("### ---------------------------------------------------");
    # foreach my $key1 (keys %$obs ){
    # info("### DEBUG ### getObservationProperties output = $key1  :  $$obs{$key1} ");
    # }
    # info("### ---------------------------------------------------");
    # foreach my $key (keys %$info ){
    # info("### DEBUG ### fileInfo output = $key  :  $$info{$key} ");
    # }
    # info("### ---------------------------------------------------");
    #
    ############################################################################


    # Set values of keywords
    push @name, 'SEQ_ID';
    push @type, 'string';
    push @value, $info->{sequence};
    push @comment, 'Pipeline sequence';
    push @withcomment, 'y';
    push @name, 'REVOLUT';
    push @type, 'string';
    push @value, $obs->{orbit};
    push @comment, 'Satellite Revolution Number';
    push @withcomment, 'y';
    push @name, 'PROCDATE';
    push @type, 'string';
    push @value, $obs->{procdate};
    push @comment, 'Processing date';
    push @withcomment, 'y';
    push @name, 'PROCREV';
    push @type, 'string';
    push @value, $obs->{procrevision};
    push @comment, 'Processing revision';
    push @withcomment, 'y';
    push @name, 'PPSVERS';
    push @type, 'string';
    push @value, $obs->{ppsversion};
    push @comment, 'PPS configuration';
    push @withcomment, 'y';
    push @name, 'SASVERS';
    push @type, 'string';
    push @value, $obs->{sasversion};
    push @comment, 'SAS version used in pipeline processing';
    push @withcomment, 'y';
    push @name, 'ODSVER';
    push @type, 'string';
    push @value, "$odsver";
    push @comment, 'ODS version';
    push @withcomment, 'y';
    push @name, 'ORIGIN';
    push @type, 'string';
    push @value, 'XMM-Newton/SOC';
    push @comment, 'Origin of FITS file';
    push @withcomment, 'y';

    push @name, 'ODFVER';
    push @type, 'string';
    push @value, sprintf('%03d',$odfver);
    push @comment, 'ODF_VERSION';
    push @withcomment, 'y';

    # MTFLAG keyword is only included if the
    # observation has been processed in the target reference frame ( SSO: --sso_object )
    if ($obs->{sso} =~ /1/ ){
    push @name, 'MTFLAG';
    push @type, 'boolean';
    push @bool_value, 'T';
    push @comment, 'Moving Target Flag; T if it is a moving target';
    push @withcomment, 'y';
    }

    # CONTENT keyword must be last in the list, as we set its value in
    # the loop
    push @name, 'CONTENT';
    push @type, 'string';
    push @comment, 'Contents of file';
    push @withcomment, 'y';

    # Loop over each file
    foreach my $file (@list)
    {
        next unless fileExists( file => $file );
        my $l_info = fileInfo( class => 'product', name => $file );

        # Set the other keywords
        doCommand(
            'addattribute', set => $file
            , attributename => [@name]
            , attributetype => [@type]
            , stringvalue => [ @value, uc( $l_info->{content} ) ]
	    , booleanvalue => [@bool_value]
            , attributecomment => [@comment]
          )
          or return exception();
    }

	# Compress all intermediate files we don't need to write to them anymore.
	compressIntermediates();

    # OK
    return success();
}
1;