Util::SW0Filename (version $)


package Util::SW0Filename;
##############################################################################
#
# DESCRIPTION: This class is the mission-specific filename generator for Swift.
#
# HISTORY:
# HISTORY: $Log: SW0Filename.pm,v $
# HISTORY: Revision 1.49  2014/08/15 09:41:45  apsop
# HISTORY: New functions filter_id_for_code and filter_code_for_id.
# HISTORY:
# HISTORY: Revision 1.48  2013/07/16 07:29:26  apsop
# HISTORY: New sub getNonGrismSkyImages.
# HISTORY:
# HISTORY: Revision 1.47  2007/07/25 20:16:09  apsop
# HISTORY: Write REPROC keyword if needed.
# HISTORY:
# HISTORY: Revision 1.46  2007/06/28 20:31:08  apsop
# HISTORY: Changes to shared repository to support files indexed by target number.
# HISTORY:
# HISTORY: Revision 1.45  2007/04/01 19:14:49  apsop
# HISTORY: Add version keyowrds to shared repository files before they are stored.
# HISTORY:
# HISTORY: Revision 1.44  2006/05/02 13:16:02  apsop
# HISTORY: Fix response to no repos file in fetch_from_repository.
# HISTORY:
# HISTORY: Revision 1.43  2006/04/03 16:02:46  apsop
# HISTORY: Fix bug in appending time index to repository file names.
# HISTORY:
# HISTORY: Revision 1.42  2006/02/07 16:39:24  apsop
# HISTORY: Allow for the parsing of gzipped files.
# HISTORY:
# HISTORY: Revision 1.41  2006/01/20 19:44:09  apsop
# HISTORY: Replace "met" flag with more descriptive "not_seqid" flag; Fix up repository file renaming.
# HISTORY:
# HISTORY: Revision 1.40  2006/01/18 16:39:27  apsop
# HISTORY: Add error message if no repository file found.
# HISTORY:
# HISTORY: Revision 1.39  2005/09/26 20:42:14  apsop
# HISTORY: Only sort repository files if there is more than one.  Allows use of nonindexed repository files.
# HISTORY:
# HISTORY: Revision 1.38  2005/07/15 16:15:32  apsop
# HISTORY: Bug fix for previous commit.
# HISTORY:
# HISTORY: Revision 1.37  2005/07/15 15:44:11  apsop
# HISTORY: Fix file globbing so that it only matches numeric indexes in the file names.
# HISTORY:
# HISTORY: Revision 1.36  2005/06/01 13:35:47  apsop
# HISTORY: Fix bugs in exporting of repository files.
# HISTORY:
# HISTORY: Revision 1.35  2005/02/08 14:30:52  apsop
# HISTORY: Fix method for detecting grism files.
# HISTORY:
# HISTORY: Revision 1.34  2004/11/30 21:21:29  apsop
# HISTORY: Changes to support test pipeline, which has an st prefix.
# HISTORY:
# HISTORY: Revision 1.33  2004/11/16 14:22:57  apsop
# HISTORY: Added method to return existing/regular files matching specs.
# HISTORY:
# HISTORY: Revision 1.32  2004/10/13 01:40:42  apsop
# HISTORY: Add in filter check to eliminate files with indexes when index==0
# HISTORY:
# HISTORY: Revision 1.31  2004/09/02 00:02:13  apsop
# HISTORY: Bug fix for handling indexed files with non-indexed files.
# HISTORY:
# HISTORY: Revision 1.30  2004/08/27 18:32:00  apsop
# HISTORY: Added methods for converting between UVOT filter codes and names.
# HISTORY:
# HISTORY: Revision 1.29  2004/07/06 20:03:26  apsop
# HISTORY: Keep track of calibration files and delete them at the end.
# HISTORY:
# HISTORY: Revision 1.28  2004/05/27 00:14:46  apsop
# HISTORY: Modified instrument-specific cal file code to accept index=0
# HISTORY:
# HISTORY: Revision 1.27  2004/05/06 19:58:41  dah
# HISTORY: Add version number back into the header comments.
# HISTORY:
# HISTORY: Revision 1.26  2004/04/16 20:20:37  dah
# HISTORY: Begin using embedded history records
# HISTORY:
#
# VERSION: $Revision: 1.49 $
#
#
##############################################################################

use Util::Filename;
use Util::FilenameInfo;
use Util::ShortTermRepository;
@ISA = ("Util::Filename");
use strict;


#########################
# constructor
#########################
sub new {

    my $proto=shift;
    my $self=$proto->SUPER::new(@_);

    $self->{GENERIC_ARGS}=["*","*","*","*","*"];

    ####################################
    # file name extensions
    ####################################
    $self->{INFO} = Util::FilenameInfo->new();

    ############################################
    # BAT shared repository
    ############################################
    if($self->jobpar()->read("use_repository") eq "yes" ) {
        my $dir = $self->procpar()->read("repository");
        $self->{REPOSITORY} = Util::ShortTermRepository->new($dir, $self);
    }


    ###############################################
    # cache of root names for sequence based files
    ###############################################
    $self->{CORRESPONDING_ROOT}={};

    $self->{CAL_FILES}=[];

    return $self;

}

############################################################################
# Converts a full instrument name into a single character instrument code
############################################################################
sub instrument_code {
    my $self = shift;
    my $name = shift;

    $name = lc($name);
    if(   $name eq "uvot" ) { return "u";   }
    elsif($name eq "xrt"  ) { return "x";   }
    elsif($name eq "bat"  ) { return "b";   }
    elsif($name eq "fom")   { return "f";   }
    elsif($name eq "swift") { return "s";   }
    elsif($name eq "proc" ) { return "p";   }
    elsif($name eq "all"  ) { return "*";   }
    else                    { return $name; }
}


############################################################################
# returns the full name of an instrument in lower case, given its one
# letter code. Returns "swift" for "s" and returns an empty string
# for an unknown instrument code
############################################################################
sub instrument_name {
    my $self = shift;
    my $inst = shift;


    if($inst eq "u") {return "uvot";}
    if($inst eq "x") {return "xrt";}
    if($inst eq "b") {return "bat";}
    if($inst eq "f") {return "fom";}
    if($inst eq "s") {return "swift";}
    if($inst eq "p") {return "proc";}
    if($inst eq "*") {return "all";}

    return "";
}

############################################################################
# returns the a list of uinstrument codes from a string which may contain
# globbing wildcards. Things like "*" and "[ux]" are supported.
############################################################################
sub instrument_list {
    my $self = shift;
    my $template = shift;

    if($template eq "*") {
        ########
        # any
        ########
        return ("u", "x", "b", "s", "f", "p");

    } elsif( $template =~ /^\[.*\]$/ ) {
        ###################################
        # handle a bracketed list of names
        ###################################
        my @instruments = $template =~ /\[(.)*\]/;
        return (@instruments);

    } else {
        #################
        # no wildcards
        #################
        return ($template);
    }

} # end of instrument list method



############################################################################
# returns true if the given type can have its filename constructed genericly
############################################################################
sub isGeneric {
    my $self=shift;
    my $type=shift;

    return $self->{INFO}->is_generic($type);
}

#########################################################################
# generate a filename of a given type
#########################################################################
sub glob_template {
    my $self=shift;

    my $type =shift || '';
    my $inst =shift || 'proc';
    my $mode =shift || '';
    my $index=shift;

    #####################################################
    # convert the instrument to a single character code
    #####################################################
    $inst = $self->instrument_code($inst);

    ############################################
    # initialize an array to hold the templates
    ############################################
    my @list=();

    if( $self->isGeneric($type) ) {
        #####################################################
        # generic file names - this should handle most cases
        #####################################################
        my @templates;


	##########################################
	# force index to be at least two digits
	##########################################
	if( $index && $index =~ /\d+/ && length($index)<2 ) { $index = sprintf('%02d', $index); }

	#########################
	# default index
	#########################
	$index = '*' if $self->{'INFO'}->is_repository($type, $inst) eq 'TIME';
	$index = '*[0-9][0-9]' if ($index && $index eq '*');
	if( ! $index || $index eq '00' ){
	  $index = '';
	}else{
	  $index = '_' . $index;
	}

        foreach my $i ($self->instrument_list($inst) ) {

	  ###################################################
	  # make sure this instrument has files of this type
	  ###################################################
	  unless($self->{INFO}->is_valid_instrument($type, $i) ) { next; }

	  #########################
	  # TDRSS field
	  #########################
	  my $tdrss = '';
	  $tdrss = 'ms' if $self->{INFO}->is_tdrss($type, $i);

	  my $suffix_noindex = $self->{INFO}->ext($type, $i);

	  my $gaoff = '';
          $gaoff .= 'o[a-f0-9][a-f0-9][a-f0-9][a-f0-9]'
	    if ($self->{INFO}->is_offset($type, $i) && $mode!~/o[a-f0-9]{4}/);
          $gaoff .= 'g[a-f0-9][a-f0-9][a-f0-9][a-f0-9]'
	    if ($self->{INFO}->is_gain($type, $i) && $mode!~/g[a-f0-9]{4}/);

	  $suffix_noindex =~ s/(.*)\.(.*)/$1${gaoff}.$2/
	    if $gaoff;

	  my $suffix = $suffix_noindex;
	  $suffix =~ s/(.*)\.(.*)/$1${index}.$2/
	    if $index;

          my $root;
          if( $self->{'INFO'}->not_seqid($type, $i) || $self->{'INFO'}->is_repository($type, $i) ||
	      $self->{'INFO'}->is_tdrss($type, $i) ){
	    $root = 's[tw][t0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]';
	  }else{
	    $root = $self->sequence_specific();
	  }

	  push @list,  $root . $tdrss . $i . $mode . $suffix_noindex if $index eq '_*[0-9][0-9]';

	  push @list,  $root . $tdrss . $i . $mode . $suffix;

        } # end of loop over instruments

    } elsif( $type eq "telemetry" ) {
        ###################################################
        # telemetry mode is packet type and index is APID
        # note that these have overlapping meaning
        # instrument translates into a range of APIDs
        # That's handled in the filter method
        ###################################################
        push @list, ("swift_${mode}_".
          "[0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f]".
          "_[0-9a-f][0-9a-f][0-9a-f][0-9a-f]".
          "_${index}*.ccsds");

    } else {

        ########################################################
        # Check if this is an instrument cal file.  Prepend the
        # instrument name to the procpar param name
        # This code supports parameter names of the type
        # <inst>_<name>_<index>
        ########################################################
        my $procpar = $self->procpar();

        foreach ($self->instrument_list($inst)) {
	    my @cal_list;
            my $param = $self->instrument_name($_) . '_' . $type;
            $param .= "_$index" if(defined $index && $index ne "" && $index ne '*');

            push @cal_list, ($procpar->read($param))
            if $procpar->has($param);

            if(defined $index && $index eq '*') {

                open PARFILE, $procpar->name();
                foreach (<PARFILE>){
                    push @cal_list, ( $procpar->read($1)) if /^(($param)_\d+),/;
                }
                close PARFILE;
            }
	    push @list, @cal_list;
	    push @{$self->{CAL_FILES}}, @cal_list;
        }

        ####################################
        # inherit mission-independant stuff
        ####################################
        @list=($self->SUPER::glob_template($type,$inst,$index,$mode))
	  unless @list;
    }

    return @list;

} # end of glob_template method

#########################################################################
#
#########################################################################
sub filter {
    my $self = shift;
    my $list = shift;

    my $type =shift || '';
    my $inst =shift || '';
    my $mode =shift || '';
    my $index=shift;

    $inst = $self->instrument_code($inst);

    my @files = @{$list};

    if( $self->isGeneric($type) ) {

      #######################################################
      # In order for $index='*' to work as a glob, must test
      # for existence of file with no index.
      #######################################################
      shift @files if( $index && $index eq '*' && @files && ! -f $files[0] );

      @files = (grep !/_\d+\./, @files) if (defined $index && ($index =~ /^0+$/));

      return @files unless @files;

      #####################################
      # eliminate any duplicate file names
      #####################################
      if( @files> 1 ){
	my %files;
	foreach (@files) { $files{$_}=1; }
	@files = keys %files;
      }

      ##############################################################################
      # Check for files that got wrongly associated with this type because they have
      # the same suffix as the this type.
      #########################################################################
      foreach my $i ($self->instrument_list($inst) ) {
	my $inst_info = $self->{'INFO'}->{$i};
	if( $inst_info->{$type}->{'anti'} ){
	  ##########################################################################
	  # The type has anti-types.  Hopefully this is not true very often, so that
	  # this part of the code is only executed occasionally
	  ##########################################################################
	  my @bad;
	  my $ext = $inst_info->{$type}->{'ext'};
	  foreach my $atype (@{$inst_info->{$type}->{'anti'}}) {
	    my $aext = $inst_info->{$atype}->{'ext'};
	    unless( $aext eq $ext ){
	      my ($qaext, $gaoff) = ($aext, '');
	      $gaoff .= '(o[a-f0-9]{4})?' if $self->{'INFO'}->is_offset($atype, $i);
	      $gaoff .= '(g[a-f0-9]{4})?' if $self->{'INFO'}->is_gain($atype, $i);

	      $qaext =~ s/(.*)\.(.*)/${1}${gaoff}_?\\d*\\.${2}/;
	      push @bad, grep(/${qaext}$/, @files);
	    }else{
	      ######################################################################
	      # If the extensions for the two types are the same, then there must
	      # be some other distinguishing factor
	      ######################################################################
	      my $atdrss = $self->{'INFO'}->is_tdrss($atype, $i);
	      my $tdrss = $self->{'INFO'}->is_tdrss($type, $i);
	      if( $atdrss && !$tdrss ){
		push @bad, grep(/^s[tw]\d+ms/, @files);
	      }elsif( !$atdrss && $tdrss ){
		push @bad, grep(!/^s[tw]\d+ms/, @files);
	      }

	      my $gain = $self->{'INFO'}->is_gain($atype, $i);
	      my $offset = $self->{'INFO'}->is_offset($atype, $i);
	      if( $gain && !$offset ){
		push @bad, grep( (/g[a-f0-9]{4}[_\.]/ && !/o[a-f0-9]{4}g/), @files );
	      }elsif( $offset && !$gain ){
		push @bad, grep(/o[a-f0-9]{4}[_\.]/, @files);
	      }elsif( $offset && $gain ){
		push @bad, grep(/o[a-f0-9]{4}g[a-f0-9]{4}[_\.]/, @files);
	      }
	    }
	  }

	  ####################################
	  # Remove 'bad' files from the list
	  ###################################
	  my %bad;
	  foreach (@bad){ $bad{$_}=1; }
	  @files = grep !$bad{$_}, @files;
	}
      }

      ###########################################
      # Special treatment of repository files
      ###########################################
      if( $self->{'INFO'}->is_repository($type, $inst) && @files > 1) {
	my $best_time = 0;
	my $best_file;
	foreach (@files) {
	  if( /_([^_.]*)\./ && $1>$best_time && $1<=$index ){
	    $best_file = $_;
	    $best_time = $1;
	  }
	}
	return ($best_file);
      }

      return @files;

    } elsif($type eq "telemetry") {
        #####################################################
        # telemetry files. Instrument gets translated into
        # a range in APIDs.
        #####################################################
        if($inst eq "*") { return @files; }

        my @instruments = $self->instrument_list($inst);

        my @list=();
        foreach (@files) {
            ##########################################
            # get the instrument for the current file
            ##########################################
            my $file = $self->remove_path($_);
            my ($i, $dum2, $dum3) = $self->parse($file, $type);

            ########################################################
            # check if the instrument is among the ones we asked for
            ########################################################
            if(grep { $_ eq $i } @instruments ) { push @list, ($_); }
        }
        return @list;

    } else {
        ########################################################
        # for anything else we inherit the superclass behavior
        # which does no filtering
        ########################################################
        return ($self->SUPER::filter($list, $type,$inst,$index,$mode));
    }

} # end of filter method

#########################################################################
#
#########################################################################
sub fetch_from_repository {
    my $self = shift;
    my $type = shift;
    my @args = @_;
    my $log = $self->log();

    if($self->{REPOSITORY} ) {
        ######################################
        # Truncate time to the nearest second
        ######################################
        $args[2] = sprintf '%f', $args[2];
        $args[2] =~ s/\..*$//;

        my $file = $self->{REPOSITORY}->fetch($type, @args);
	# $log->entry("File name returned from repository is $file .");
	unless($file && -f $file){
	  $log->entry("No file returned from repository, type $type, index $args[2]");
	  return () unless -f $file;
	  return $file;
	}

	###################################################
	# Remove time index from file name
	###################################################
	my $new_name = $file;
        $new_name =~ s/_[^_.]*\././;
	rename $file, $new_name;

	return ($new_name) if wantarray();
	return $new_name;
    } else {
        $log->entry("Not using shared repository");
        return $self->get($type, @args);
    }

}

#########################################################################
#
#########################################################################
sub export_to_repository {
    my $self = shift;
    my $type = shift;
    my $inst = shift;
    my @files = @_;

    my $log = $self->log();
    my $jobpar   = $self->jobpar();
    my $procpar  = $self->procpar();

    $inst = $self->instrument_code($inst);

    my $repos_type = $self->{'INFO'}->{$inst}->{$type}->{'repository'};
    delete $self->{'INFO'}->{$inst}->{$type}->{'repository'};
    @files=$self->get($type, $inst, '*', '*') unless(@files);
    $self->{'INFO'}->{$inst}->{$type}->{'repository'} = $repos_type;

    if( $self->{REPOSITORY} && @files && $files[0] ) {
        $log->entry("Exporting the following files to the shared repository: ".
                    join ' ', @files );

	my $soft_version = $jobpar->read('softver');
	my $cal_version = $jobpar->read('caldbver');
	my $proc_version = $procpar->read('version');
	my $seq_num = int($jobpar->read('seqprocnum'));
	my $reprocess = $jobpar->read('reprocess');

	############################################
	# Rename the files to have the proper index
	############################################
	my @new_files;
	foreach my $file (@files){
	  my $newname = $file;
	  my $fitsfile = Util::FITSfile->new($file, 0);

	  $fitsfile->begin_many_keywords();
	  $fitsfile->keyword('SOFTVER', $soft_version, 'HEASOFT and Swift versions');
	  $fitsfile->keyword('CALDBVER', $cal_version, 'CALDB index versions used');
	  $fitsfile->keyword('PROCVER', $proc_version, 'Processing script version' );
	  $fitsfile->keyword('SEQPNUM', $seq_num, 'Number of times the dataset processed' );
	  $fitsfile->keyword('REPROC', 'T', 'Is this from a bulk reprocessing run?') if $reprocess eq 'yes';
	  $fitsfile->end_many_keywords();

	  my $index;
	  if($repos_type eq 'OBSID'){
	    #########################
	    # Index by target number
	    #########################
	    $fitsfile->ext(0);
	    $index = $fitsfile->keyword('OBS_ID');
	    $index =  substr($index, 2, 8);
	    $index =~ s/^0+//;
	  }elsif($repos_type eq 'TIME'){
	    ###############################
	    # Index by time.
	    ###############################
	    $fitsfile->ext(1);
	    $index = $fitsfile->keyword('TSTART');
	    ######################################
	    # Truncate time to the nearest second
	    ######################################
	    $index =~ s/\..*$//;
	    unless($index){
	      $log->error(1, "File $file does not have proper TSTART.  Will not put in respository.");
	      next;
	    }
	  }else{
	    $log->error(2, "Repository type $repos_type not recognized.");
	  }
	  $newname =~ s/^([^\.]+)\.(.*)$/${1}_${index}.${2}/;
          rename $file, $newname;
          push @new_files, $newname;
	}
        $self->{REPOSITORY}->export($type, @new_files);
	unlink @new_files;
    }

}


#########################################################################
# parse the fields in a filename
#########################################################################
sub parse {
    my $self=shift;
    my $filename=shift;
    my $type=shift;

    if($self->isGeneric($type) ){
      ##################################################
      # first we have to pull out the instrument code
      ##################################################
      $filename =~ s/^s[tw]t?\d+//;
      my $tdrss;
      if(substr($filename,0,2) eq 'ms') {
	##########################################################
	# looks like there is a TDRSS field before the instrument
	##########################################################
	$filename =~ s/^ms//;
	$tdrss = 1;
      }

      ####################################################
      # get various parts from the FilenameInfo registry
      ####################################################
      my $inst = substr($filename, 0, 1);
      my ($pre_suffix, $post_suffix) = $self->{INFO}->ext($type, $inst) =~ /(\w*)\.(\w+)/;

      $pre_suffix .= 'o[a-f0-9]{4}' if $self->{INFO}->is_offset($type, $inst);
      $pre_suffix .= 'g[a-f0-9]{4}' if $self->{INFO}->is_gain($type, $inst);

      ###############################
      # now we can parse
      ###############################
      my @parts;
      if( $filename =~ /${pre_suffix}_\d+\./ ){
          ############################
          # there is an index field
          ############################
          @parts =
	    ( $filename =~ /^([spbxuf])(.*)${pre_suffix}_(\d+)\.${post_suffix}/ );
      }else{
          ###########################################
          # no index field in the filename -
          # so the "phantom index" defaults to 00
          ############################################
	  @parts = $filename =~ /([spbxuf])(.*)${pre_suffix}\.${post_suffix}/;
	  $parts[2]=0;
      }

      return (@parts);

    } elsif($type eq "telemetry") {
        ###################################
        # telemetry files
        ###################################
        my @fields = split /_/, $filename;
        my $mode =$fields[1];
        my $apid = $fields[4];
        $apid =~ s/\..*$//;
        my $inst = $self->instrument_for_apid($apid);
        return ($inst, $mode, $apid);


    } else {
        ################################
        # unknown type
        ###############################
        $self->SUPER::parse($filename,$type);
    }

} # end of parse method


#########################################################################
# returns the one character instrument name for a given APID
#########################################################################
sub instrument_for_apid {
    my $self = shift;
    my $apid = shift;

    if(                $apid <= 100 ) { return "s" }
    if($apid >= 289 && $apid <= 571 ) { return "b" }
    if($apid >= 576 && $apid <= 1151) { return "u" }
    if($apid >=1152 && $apid <= 1439) { return "x" }



    return "unknown";


} # end of instrument for apid method


#########################################################################
# Parse the path to see if this is a grism image
#########################################################################

sub is_grism {
	my ($self, $path, $type) = @_;

	my @parts = $self->parse($path, $type);

	my $grism = $parts[1] =~ /^g(u|v)$/;

	return $grism;
}


#########################################################################
# Return names of the sky image files, but not including the grism ones.
#########################################################################

sub getNonGrismSkyImages {

    my ($self) = @_;

    my @skyFiles = $self->get('filterimg', 'uvot', '*', '*');

    my @nonGrism;
    foreach my $skyFile (@skyFiles) {
	next if $self->is_grism($skyFile, 'skyimage');
	push(@nonGrism, $skyFile);
    }

    return @nonGrism;
}


############################################
# Convert between filter code and name or id
# as defined in UvotNames.pm
############################################

sub filter_name_for_code {

    my ($self, $code) = @_;

    my $codes = $Subs::UvotNames::filterCodes;
    my $names = $Subs::UvotNames::filterNames;

    for (my $i = 0; $i < @$codes; ++$i) {
        if ($codes->[$i] eq $code) {
            return $names->[$i];
        }
    }

    return 'UNKNOWN';
}


sub filter_code_for_name {

    my ($self, $name) = @_;

    my $codes = $Subs::UvotNames::filterCodes;
    my $names = $Subs::UvotNames::filterNames;

    for (my $i = 0; $i < @$names; ++$i) {
        if ($names->[$i] eq $name) {
            return $codes->[$i];
        }
    }

    return 'qq';
}


sub filter_id_for_code {

    my ($self, $code) = @_;

    my $codes = $Subs::UvotNames::filterCodes;
    my $ids   = $Subs::UvotNames::filterIDs;

    for (my $i = 0; $i < @$codes; ++$i) {
        if ($codes->[$i] eq $code) {
            return $ids->[$i];
        }
    }

    return 'UNKNOWN';
}


sub filter_code_for_id {

    my ($self, $id) = @_;

    my $codes = $Subs::UvotNames::filterCodes;
    my $ids   = $Subs::UvotNames::filterIDs;

    for (my $i = 0; $i < @$ids; ++$i) {
        if ($ids->[$i] eq $id) {
            return $codes->[$i];
        }
    }

    return 'qq';
}


######################################################
# Generate file names and only return those that exist
######################################################

sub getExisting
{
	my ($self, @args) = @_;
	my @gotten = $self->get(@args);
	my @exist;
	foreach my $name (@gotten) {
		if (-f $name) {
			push(@exist, $name);
		}
	}
	return @exist;
}


1;