#!/usr/bin/env perl #======================================================================= # # NAME # # catver.pl # # DESCRIPTION # # This script compares the keyword values from a fits header to # the corresponding values in the database. It uses tables in # the keyword database to do the mapping. Any differences will be # put in a report. # # Note: keywords or fields that are not in the map file will not # not be compared. # # # INPUTS # # 1 - directory containing the fits files # 2 - archive class # 3 - mission # 4 - dataset name - optional; if missing all fits files in directory # # OPTIONS # # h - help; print usage # k - keyword server and database names # d - dads server and database names # s - name of the skip file # p - name of the precision file # # URL for User's Guide: http://www.ess.stsci.edu/projects/dads/db/catver.html # # HISTORY # # 07/03/03 49679 L Gardner Initial version # 09/19/06 56505 MSwam add field prefixes # 06/02/08 58753 MSwam handle STIS GO-WAVECALs # 06/12/08 60161 L Gardner Handle cos and wfc3 differences # 10/28/08 61112 L Gardner Do not lowercase directory path, get # dataset name from dir for cos, # Remove hardcoded imset ext list and # get it from kywd db instead. Rename # extList to suffixList. Remove all # references to cos_segments. # 01/27/09 61112 L Gardner Moving some of the subroutines # to get_kywd_and_fld_vals.pl # 06/22/09 61985 L Gardner Handle multiple kywd tables + foc/hrs # #======================================================================= use strict; use File::Basename; push ( @INC, dirname($0) ); # Assume other perl files in same directory use FileHandle; # Use a variable file handle use STScI::DBI; # Used to automatically login use Time::Local; # Used in comparing the time fields require 'getopts.pl'; # contains Getopts require 'db_access.pl'; # contains routines to access db require 'get_keyword_info.pl'; # contains routines to access keyword db require 'get_kywd_and_fld_vals.pl'; # contains routines to get keywords # from fits headers and database fields. require 'special_process.pl'; # subs in dads_keywords..special_process field use vars ( '$opt_k', '$opt_d', '$opt_s', '$opt_p', '$opt_t', '$opt_v', '$opt_h' ); #----------------------------------------------------------------------- # # Give the usage if requested or if missing inputs. # #----------------------------------------------------------------------- if ( $opt_h or !$ARGV[0] or !$ARGV[1] or !$ARGV[2] ) { print "Usage: $0\n", "\t\t[-k \n", "\t\t -d\n", "\t\t -s\n", "\t\t -p]\n", "\t\t\n", "\t\t\n", "\t\t\n", "\t\t[]\n"; print " Ex: $0 -kCATLOG..keyword -dCATLOG..dadsops -scatver_flds.skp \\\n", "\t\t -pcatver_precision.lis /local/files CAL HST n4k6miviq\n"; print "*** Exiting program.\n"; exit; } #----------------------------------------------------------------------- # # Save and/or process the options # The -t option is used for debugging purposes only. # #----------------------------------------------------------------------- &Getopts('d:k:s:p:t:h'); my $kywdInfo = $opt_k || 'CATLOG..keyword'; my $dadsInfo = $opt_d || 'CATLOG..dadsops'; my $skipFile = $opt_s || 'catver_flds.skp'; my $precFile = $opt_p || 'catver_precision.lis'; my ( $testKywd, $testFld ) = split( /,/, $opt_t ); my ( $kywdServer, $kywdDatabase ) = split( /\.\./, $kywdInfo ); my ( $dadsServer, $dadsDatabase ) = split( /\.\./, $dadsInfo ); #----------------------------------------------------------------------- # # Save the inputs. If a dataset name was supplied put that in the hash. # If only the directory name was supplied read the fits file names in the # directory and save off the dataset name in a hash. If the directory # name supplied was not a directory or no datasets are in the hash, # print out a message and exit the program. # #----------------------------------------------------------------------- my $fileDir = $ARGV[0]; my $archiveClass = uc $ARGV[1]; my $mission = uc $ARGV[2]; my $datasetName = uc $ARGV[3]; my %dsnList = (); if ( $datasetName ) { my @dsns = split(/,/,$datasetName); foreach my $dsn ( @dsns ) { $dsnList{$dsn} = 1; } } else { if ( -d $fileDir ) { opendir(DIR, $fileDir) || die "Can't open $fileDir: $!"; while ( my $datasetName = readdir(DIR) ) { # Skip files not ending in fits next unless $datasetName =~ /\.fits$/; # Do not process datasets that only have asn files # The reason for this is they do not populate the science # catalog and only generate confusing errors. Better to skip it. next if $datasetName =~ /_asn\.fits$/; # Remove the exention and suffix to get the dataset name $datasetName =~ s/_\w{3,}.fits$//; $datasetName = uc $datasetName; $dsnList{$datasetName} = 1; } closedir(DIR); } else { print "$fileDir is not a directory - Exiting program.\n"; exit; } } if ( ! keys %dsnList ) { print "No matching fits files in directory: $ARGV[0]\n-- Exiting program."; exit; } # Print out debugging info my @dsns = sort keys %dsnList; print "Using $kywdServer..$kywdDatabase/$dadsServer..$dadsDatabase\n"; print "Inputs: @dsns,$archiveClass,$mission,$fileDir\n"; print "Test inputs:$testKywd,$testFld\n"; #----------------------------------------------------------------------- # # Read in the skip file and the precision file. # - The skip file contains fields that should not be compared for a given # mission and instrument. Additional fields not to process will be added # to this hash when processing the map tables in the keyword database. # - The precision file contains the degree of precision for a given keyword, # mission and instrument when comparing the keyword to a # field. This is used for both float fields and date fields. # #----------------------------------------------------------------------- my %skipFld = (); # List of fields not populated by keywords my %precision = (); # List of keywords and their precision if ( -r $skipFile ) { open ( SKPFILE, "<$skipFile" ) or die "Couldn't open file $skipFile $!"; while ( my $line = ) { chop $line; next if $line =~ /^#/g; # Skip comment lines next if $line =~ /^\s*$/g; # Skip blank lines my ( $mission, $instr, $fldName ) = split( /\s+/, $line ); $skipFld{$mission}{$instr}{$fldName} = 1; } close( SKPFILE ); } if ( -r $precFile ) { open ( PRCFILE, "<$precFile" ) or die "Couldn't open file $precFile $!"; while ( my $line = ) { chop $line; next if $line =~ /^#/g; # Skip comment lines next if $line =~ /^\s*$/g; # Skip blank lines my ( $mission, $instr, $kywd, $prec ) = split( /\s+/, $line ); $precision{$mission}{$instr}{$kywd} = $prec; } close( PRCFILE ); } #----------------------------------------------------------------------- # # Some initial variables # #----------------------------------------------------------------------- # translation from first letter of dataset name to actual instrument my %instrConv = ( J => 'ACS', L => 'COS', F => 'FGS', O => 'STIS', N => 'NICMOS', I => 'WFC3', U => 'WFPC2', V => 'HSP', W => 'WFPC', X => 'FOC', Y => 'FOS', Z => 'HRS' ); # transmission source (last letter of dataset name) posibilities my $tsList = "JSQNPMTORX"; # A float pattern my $floatPattern = '^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$'; # The program's standard date pattern my $myDatePattern = '^(\d\d)\/(\d\d)\/(\d{4}) (\d\d):(\d\d):(\d\d)(\.\d{3})?$'; #----------------------------------------------------------------------- # # The keyword database contains the information on how to compare # the keywords to the fields. The hashes listed below must be filled # to process each of the datasets. The hashes are all filled by the # subroutines below and are stored based on mission and instrument at a minimum. # All the information for all missions and instruments are read in so that # we can process many different datasets during one run of this program. # # LIMITATION: Can only process one archive class during one run # of this program since many of the hashes are filled in based on # archive class and there is no way of determining the archive class # from the dataset name. # # The hashes are defined in get_kywd_and_fld_vals.pl. # #----------------------------------------------------------------------- my %acronyms = (); # Tablenames and their acronyms my %tableType = (); # Table type based on acronms and table names my %multFldMap = (); # Maps all fields in a table that has at least # one field populated by multiple keywords my %fldMapper = (); # Maps a field to a keyword my %kywdMapper = (); # Maps a keyword to a field my %primeKeys = (); # List of primary keys for each table my %unqFldList = (); # Last field in key that makes it unique # excluding dataset name or pso key my %validInstr = (); # List of valid instruments for each archive # class my %kywdList = (); # Not used but needed in call. my %updMapper = (); # Not used but needed in call. my %quoteIt = (); # Not used but needed in call. my $dbh = DBConnect ( $kywdServer, $kywdDatabase ); GetPrimeKeys( $dbh, # in $archiveClass, # in \%primeKeys, # out \%acronyms, # out \%tableType, # out \%unqFldList, # out \%validInstr, # out $testFld ); GetMappingTbls( $dbh, # in \%validInstr, # in \%kywdList, # Empty - not used \%kywdMapper, # out \%updMapper, # Empty - not used \%fldMapper, # out \%multFldMap, # out \%skipFld, # out \%quoteIt, # out $testKywd, $testFld ); # instr/kywd mapping to section names in files my %headerName = GetHeaderName( $dbh ); # List of suffixes in the order they should be opened my %suffixList = GetSuffixList( $dbh ); # List of imset extensions to look for in the headers my %imsetExtList = GetImsetExtList( $dbh ); # Disconnect from the keyword database $dbh->disconnect; #----------------------------------------------------------------------- # # In processing each dataset there are 7 steps: read keywords from # the fits files, read field information from the database, compare # the two, process table with multiple keywords, process left over fields, # process left over keywords and generate the reports. # # Note1: For stis wavecals in asssociations two of these steps have # to be repeated for the wavecal entries. # Note2: Tables that have fields that are populated by multiple keywords # are often refered to as OR tables or OR fields in the code and doc. # Note3: WC or wc refers to wavecal hashes in the code and documentation. # #----------------------------------------------------------------------- my $dbh = DBConnect ( $dadsServer, $dadsDatabase ); $dbh->func("LONG","_date_fmt"); foreach my $datasetName ( sort keys %dsnList ) { print "Processing $datasetName...\n"; my %delFlds = (); # Fields that have been compared my %delKywds = (); # Keywords that have been compared my %extSource = (); # Name of extension where keyword extracted from my %kywdVerVals = (); # List of keywords based on extension version my %wcExtSource = (); # Name of extension where wc kywd extracted from my %wcKywdVerVals = (); # List of wc keywords based on extension version my %fldRowVals = (); # List of field values based on field name my %stisCompared = (); # Stis keywords that were compared my @diffList = (); # List of kywd/fld pairs that differ my @matchList = (); # List of kywd/fld pairs that match my $fldLeftCnt = 0; # Number of fields without matching keywords my $fldsLeft = ''; # Rpt on flds that don't map to kywds my $kywdLeftCnt = 0; # Number of keywords without matching fields my $kywdsLeft = ''; # Rpt on kywds that don't map to flds my $orKywdLeftCnt = 0; # Number of OR keywords without matching fields my $orKywdsLeft = ''; # Rpt on OR kywds that don't map to flds my $wcKywdLeftCnt = 0; # Number of WC keywords without matching fields my $wcKywdsLeft = ''; # Rpt on WC kywds that don't map to flds # Determine the instrument to use to access the keyword database hashes. my $instr = $instrConv{substr($datasetName,0,1)}; # OMS does not use the conversion since the keyword hashes refer to it's # instrument as OMS. $instr = 'OMS' if $archiveClass eq 'OMS'; # There is only a trans source for exposures and not associations. my $ts = $datasetName =~ /[$tsList]$/ ? substr($datasetName,8,1) : ''; # Read in the keywords from the fits files my ( $processedFiles, $wavecal ) = GetFileKywdLists( $mission, # in $instr, # in $fileDir, # in $datasetName, # in \%suffixList, # in \%imsetExtList, # in \%kywdMapper, # in \%extSource, # out \%kywdVerVals, # out \%wcExtSource, # out \%wcKywdVerVals, # out $testKywd ); # If no files were processed write out a message and exit. if ( !$processedFiles ) { print "There were no files or files couldn't be read.\n", "No difference or matching file created for $datasetName.\n"; next; } # Get the association id if it exists my $asnId = $kywdVerVals{0}{ASN_ID} if $kywdVerVals{0}{ASN_ID} ne 'NONE'; # Read in the database values GetDbFldVals( $dbh, # in $mission, # in $instr, # in $datasetName, # in $archiveClass, # in $asnId, # in \%acronyms, # in \%primeKeys, # in \%skipFld, # in \%unqFldList, # in \%tableType, # in \%fldRowVals, # out $testFld ); # out # Compare keywords to fields CompareKywds2Flds( 'NORMAL', # in $mission, # in $instr, # in \%fldRowVals, # in \%kywdVerVals, # in \%fldMapper, # in \%kywdMapper, # in \%unqFldList, # in \%tableType, # in \%extSource, # in \%precision, # in \%stisCompared, # out \%delFlds, # out \%delKywds, # out \@matchList, # out \@diffList ); # out # SCA: Compare keywords to fields for wavecals if ( $mission eq 'HST' and $wavecal ) { CompareKywds2Flds( 'WAVECAL', # in $mission, # in $instr, # in \%fldRowVals, # in \%wcKywdVerVals, # in \%fldMapper, # in \%kywdMapper, # in \%unqFldList, # in \%tableType, # in \%wcExtSource, # in \%precision, # in \%stisCompared, # out \%delFlds, # out \%delKywds, # out \@matchList, # out \@diffList ); # out } # Compare OR table keywords to fields for assoc product or non # assoc exposures. This is really a combination of the compare # and process left over keywords. See the subroutine for an # explanation of what the OR table is. if ( ( $asnId and !$ts ) or !$asnId ) { ( $orKywdLeftCnt, $orKywdsLeft ) = CompareOrKywds( $mission, # in $instr, # in \%fldRowVals, # in \%kywdVerVals, # in \%multFldMap, # in \%kywdMapper, # in \%unqFldList, # in \%extSource, # in \%delFlds, # out \%delKywds, # out \@matchList, # out \@diffList ); # out } # Process any left over fields ( $fldLeftCnt, $fldsLeft ) = ProcessLeftOverFlds( $mission, # in $instr, # in \%delFlds, # in \%kywdVerVals, # in \%fldRowVals, # in \%fldMapper, # in \%kywdMapper, # in \%headerName ); # in # Process any left over keywords ( $kywdLeftCnt, $kywdsLeft ) = ProcessLeftOverKywds( 'NORMAL', # in $mission, # in $instr, # in $ts, # in \%delKywds, # in \%kywdVerVals, # in \%kywdMapper, # in \%fldMapper, # in \%unqFldList, # in \%extSource, # in \%stisCompared, # in \%skipFld, # in \%tableType ); # in # SCA: Process any left over wavecal keywords if ( $mission eq 'HST' and $wavecal ) { ( $wcKywdLeftCnt, $wcKywdsLeft ) = ProcessLeftOverKywds( 'WAVECAL', # in $mission, # in $instr, # in $ts, # in \%delKywds, # in \%wcKywdVerVals, # in \%kywdMapper, # in \%fldMapper, # in \%unqFldList, # in \%wcExtSource, # in \%stisCompared, # in \%skipFld, # in \%tableType ); # in } # Concat and add all left over keyword information $kywdLeftCnt += $orKywdLeftCnt + $wcKywdLeftCnt; $kywdsLeft .= $orKywdsLeft . $wcKywdsLeft; # Print the report for this datasetname. Two files are created for # each dataset processed: A matching file and a difference file. WriteRpts( $mission, # in $instr, # in $archiveClass, # in $datasetName, # in \@matchList, # in \@diffList, # in $fldsLeft, # in $fldLeftCnt, # in $kywdsLeft, # in $kywdLeftCnt ); # in } # Disconnect from the dads database $dbh->disconnect; exit; #----------------------------------------------------------------------- # # CompareKywds2Flds # Loop through each field name and unique field combination and try # tofind a keyword it maps to. If there is a mapping do any special # processing needed and compare the values. Report out all matches # and differences. # #----------------------------------------------------------------------- sub CompareKywds2Flds { my ( $hashType, $mission, $instr, $fldRowVals, $kywdVerVals, $fldMapper, $kywdMapper, $unqFldList, $tableType, $extSource, $precision, $stisCompared, $delFlds, $delKywds, $matchList, $diffList ) = @_; my %compared = (); # SCA: Fill in the ASN_MTYP kywd for stis products $kywdVerVals->{0}{ASN_MTYP} = 'PRODUCT' if $mission eq 'HST' and $instr eq 'STIS' and $kywdVerVals->{1}{ASN_MTYP} ne '~'; # COS kludge : Fill in the ASN_MTYP kywd for cos products $kywdVerVals->{0}{ASN_MTYP} = $kywdVerVals->{1}{ASN_MTYP} if $mission eq 'HST' and $instr eq 'COS' and $kywdVerVals->{1}{ASN_MTYP} ne '~'; foreach my $fldName ( sort keys %{$fldRowVals} ) { my $acronym = substr($fldName,0,3); # Keeps track of each version used to populate this field so # there it won't be used in future comparison's of different rows. my %extVerUsed = (); # SCA: The MEMBEXP table's obsnum doesn't really belong to any extension # so for each field put it in the 0 extension so it won't be processed # again. $extVerUsed{0} = 1 if $mission eq 'HST' and $instr eq 'STIS' and $fldName =~ /_obsnum$/ and $tableType->{$mission}{$instr}{$acronym} eq 'MEMBEXP' and $fldName !~ /^sij_sdb/; foreach my $unqFldVal ( sort keys %{$fldRowVals->{$fldName}} ) { # Don't bother comparing if compared before last if $compared{$fldName}{$unqFldVal}; # Get the field value and corresponding keyword my $fldVal = $fldRowVals->{$fldName}{$unqFldVal}; my $kywd = $fldMapper->{$mission}{$instr}{$fldName}; foreach my $extVer ( sort {$a <=> $b} keys %{$kywdVerVals} ) { # Get the keywords val for this version my $kywdVal = $kywdVerVals->{$extVer}{$kywd}; print "CompareKywds2Flds:0:fn=$fldName:uf=$unqFldVal:fv=$fldVal:", "kw=$kywd:ev=$extVer:kv=$kywdVal:\n" if $fldName eq $testFld; # Don't process field if compared before or no kywdVal next if $compared{$fldName}{$unqFldVal} or not defined $kywdVal; # Determine the unique value for this unique row. my $uniqueFldName = $unqFldList->{$mission}{$instr}{$acronym}; my $uniqueKywd = $fldMapper->{$mission}{$instr}{$uniqueFldName}; my $uniqueVal = $kywdVerVals->{$extVer}{$uniqueKywd}; if ( $uniqueFldName =~ /;/ ) { my @keyFlds = split( /;/, $uniqueFldName ); my @keyVals = ''; foreach my $unqFld ( @keyFlds ) { my $unqKywd = $fldMapper->{$mission}{$instr}{$unqFld}; push( @keyVals, $kywdVerVals->{$extVer}{$unqKywd} ); } $uniqueVal = join( ";", @keyVals ); } print "CompareKywds2Flds:1:$hashType,fn=$fldName*fv=$fldVal*", "un=$uniqueFldName*uf=$unqFldVal*ev=$extVer*", "kn=$kywd*kv=$kywdVal*uk=$uniqueKywd*uv=$uniqueVal*", "km=$kywdMapper->{$mission}{$instr}{$kywd}{$fldName}*", "c=$compared{$fldName}{$unqFldVal}*", "tt=$tableType->{$mission}{$instr}{$acronym}*", "kV=$kywdVerVals->{$extVer}{$uniqueKywd}*", "fM=$fldRowVals->{asm_member_type}{$unqFldVal}*", "ks=$extSource->{$extVer}{$kywd}*", "eu=$extVerUsed{$extVer}*ul=", "$unqFldList->{$mission}{$instr}{substr($fldName,0,3)}*\n" if $fldName eq $testFld; # SCA: For keywords in the primary header that are used to populate # exposure tables just use the db's field val as the kywd unique val if ( $mission eq 'HST' and ($instr eq 'STIS' or $instr eq 'OMS') ) { my $asnId = $kywdVerVals->{0}{ASN_ID} if $kywdVerVals->{0}{ASN_ID} ne 'NONE'; my $asnMtyp = $fldRowVals->{asm_member_type}{$unqFldVal}; my $tblType = $tableType->{$mission}{$instr}{$acronym}; my $suffix = $extSource->{$extVer}{$kywd}; print "CompareKywds2Flds:1.5:$hashType*$asnId*$asnMtyp*", "$tblType*$suffix*\n" if $fldName eq $testFld; # There are some primary header keywords that populate # exposure tables if ( $extVer == 0 and ( $tblType eq 'MEMBEXP' or $fldName eq 'asm_asn_id' ) ) { # Treat the original unique value as if it had been processed. # Next assume the keyword value is the same as # the field value. Have to do an additional check # to make sure that wavecal's use wavecal unique value # and non wavecals use the non wavecal unique value # Also only do if it came from a real file and # it's not an ASN_MTYP keyword. $delKywds->{$kywd}{$fldName}{$uniqueVal} = 1; $uniqueVal = $unqFldVal if ( ( ( $asnMtyp eq 'AUTO-WAVECAL' and $hashType eq 'WAVECAL' ) or ( $asnMtyp eq 'GO-WAVECAL' and $hashType eq 'WAVECAL' ) ) or ( $asnMtyp ne 'AUTO-WAVECAL' and $asnMtyp ne 'GO-WAVECAL' and $hashType ne 'WAVECAL' ) ) and $kywd ne 'ASN_MTYP' and $suffix; } # Don't process product tables for assoc wavecal entries next if $asnId and $tblType ne 'MEMBEXP' and $acronym ne 'asm' and $hashType eq 'WAVECAL'; } # Don't process if it's a multiple record field and the # unique field doesn't match. next if $unqFldList->{$mission}{$instr}{$acronym} and $unqFldVal ne $uniqueVal; # SCA: Skip comparison if processed this version before next if $instr eq 'STIS' and $extVerUsed{$extVer}; print "CompareKywds2Flds:2:fn=$fldName*fv=$fldVal*", "ev=$extVer*kn=$kywd*kv=$kywdVal*uv=$uniqueVal\n" if $fldName eq $testFld; # The keyword and fieldname are now considered compared. $delFlds->{$fldName}{$kywd}{$unqFldVal} = 1; $delKywds->{$kywd}{$fldName}{$unqFldVal} = 1; $stisCompared->{$fldName} = $kywd; # But don't compare them if they are to be ignored. IGNORE # keywords are used in other keyword special processing so # they will be compared. Another reason to skip the compare # is if there is only one record returned and we already # did the compare with it. next if $kywdMapper->{$mission}{$instr}{$kywd}{$fldName} =~ /IGNORE\(\)/ or ( defined $compared{$fldName}{$unqFldVal} and !$unqFldList->{$mission}{$instr}{$acronym}); print "CompareKywds2Flds:3:passed next(2)\n" if $fldName eq $testFld; # COS kludge: reset any faked extension numbers for printing # to the match or difference line. This is primarily for # segment keywords. my $printExtVer = $extVer; $printExtVer -= 1000 if $printExtVer > 999 and $extSource->{$extVer}{$kywd} =~ /_b$/; # Compare the keyword and field values my ( $matchLine, $diffLine ) = CompareVals( $printExtVer, $kywd, $extSource->{$extVer}{$kywd}, $kywdVal, $fldName, $fldVal, $unqFldVal, $kywdMapper->{$mission}{$instr}{$kywd}{$fldName}, $precision->{$mission}{$instr}, %{$kywdVerVals->{$extVer}} ) ; push( @$matchList, $matchLine ) if $matchLine; push( @$diffList, $diffLine ) if $diffLine; # This field has been compared. As apposed to considered # compared (see above). The difference is some keywords # aren't actually compared and are skipped. $compared{$fldName}{$unqFldVal} = 1; $extVerUsed{$extVer} = 1 unless $extVer == 0; print "CompareKywds2Flds:4:match*$fldName*$unqFldVal*", "$compared{$fldName}{$unqFldVal}*", "$extVerUsed{$extVer}\n" if $matchLine and $fldName eq $testFld; print "CompareKywds2Flds:4:diff*$fldName*$unqFldVal*", "$compared{$fldName}{$unqFldVal}*", "$extVerUsed{$extVer}\n" if $diffLine and $fldName eq $testFld; } } } } #----------------------------------------------------------------------- # # CompareVals # Takes keyword and field information. Makes any changes necessary # to the keyword to make it match the field and makes a comparison. # #----------------------------------------------------------------------- sub CompareVals { my ( $extVer, $kywd, $ext, $kywdVal, $fldName, $fldVal, $unqFldVal, $specProc, $precision, %kywdVerVals )= @_; my $matchLine = ''; my $diffLine = ''; # If there is special processing, get the function # name and parameters and make a call to the routine. # This should change the keyword to potentially match # what is in the field. if ( $specProc ) { my ( $func, $pattern ) = split( /\(/, $specProc ); $pattern =~ s/\)$//; no strict 'refs'; $kywdVal = $func->( $kywdVal, $pattern, %kywdVerVals ) if $func !~ /^OR$/; use strict 'refs'; print "CompareVals:1:$func*$pattern*\n" if $fldName eq $testFld; } my $kywdInfo = "$kywd($ext/$extVer)"; my $kywdLine = sprintf("%-25s %-s", $kywdInfo, $kywdVal ); my $fldInfo = $fldName; $fldInfo .= "($unqFldVal)" if $unqFldVal; my $fldLine = sprintf("%-25s %-s", $fldInfo, $fldVal ); print "CompareVals:2:$kywdVal*$fldVal*$kywdLine*$fldLine*\n" if $fldName eq $testFld; # Compare the values. Try a string compare first, a float # compare second and finally a date compare. If all fail, # save the difference info otherwise save the match info. # We use the precision for the float and date fields to # the deal with the machine storage differences if ( $kywdVal eq $fldVal ) { $matchLine = "$kywdLine\n$fldLine\n\n"; } elsif ( $kywdVal =~ /$floatPattern/ and $fldVal =~ /$floatPattern/ and abs( $kywdVal - $fldVal) <= $precision->{$kywd} ) { $matchLine = "$kywdLine\n$fldLine\n\n"; } elsif ( $kywdVal =~ /$myDatePattern/ and $fldVal =~ /$myDatePattern/ and abs(DateSecs($kywdVal)-DateSecs($fldVal)) <= $precision->{$kywd} ){ $matchLine = "$kywdLine\n$fldLine\n\n"; } elsif ( $kywdVal =~ /$myDatePattern/ and $fldVal =~ /$myDatePattern/ and $specProc =~ /^DATE_MJD/ and abs(DateSecs($kywdVal)-DateSecs($fldVal)) <= 0.005 ) { $matchLine = "$kywdLine\n$fldLine\n\n"; } else { $diffLine = "$kywdLine\n$fldLine\n\n"; } return ( $matchLine, $diffLine ); } #----------------------------------------------------------------------- # # CompareOrKywds # Loop through each field name and unique field combination in the # multiple fld Mapper. These are all the fields in tables that have # at least one field that may be filled by multiple keywords. I am # using my knowledge of the current database to hard code lots of # stuff. I know this is bad but it's not worth spending lots of time # on these tables. # Assumption: OR keywords are always in extVer = 0 # #----------------------------------------------------------------------- sub CompareOrKywds { my ( $mission, $instr, $fldRowVals, $kywdVerVals, $multFldMap, $kywdMapper, $unqFldList, $extSource, $delFlds, $delKywds, $matchList, $diffList ) = @_; my $kywdLeftCnt = 0; # Count of kywds that are missing a fld my $kywdsLeft = ''; # Rpt of kywds that are missing a fld my %compared = (); # Compared the field and unq field before my %kywdExists = (); # Processed this keyword before my %dbRecExists = (); # A record exists in the db for this table foreach my $fldName ( sort keys %{$multFldMap->{$mission}{$instr}} ) { my $acronym = substr($fldName,0,3); # MTP keywords shouldn't be compared for non moving targets next if $kywdVerVals->{0}{TAR_TYPE} ne 'MOVING TARGET' and $acronym eq 'mtp'; foreach my $unqFldVal ( sort keys %{$fldRowVals->{$fldName}} ) { $dbRecExists{$acronym} = 1; # Don't bother comparing if compared before last if $compared{$fldName}{$unqFldVal}; # Get the field value my $fldVal = $fldRowVals->{$fldName}{$unqFldVal}; print "CompareOrKywds:1:fn=$fldName*uf=$unqFldVal*fv=$fldVal*\n" if $fldName eq $testFld; # Process each possible keyword that can be in an OR table foreach my $kywd ( sort keys %{$multFldMap->{$mission}{$instr}{$fldName}} ) { # Get the keyword value for the 0 version my $kywdVal = $kywdVerVals->{0}{$kywd}; print "CompareOrKywds:2:kn=$kywd*kv=$kywdVal*", "c=$compared{$fldName}{$unqFldVal}*\n" if $fldName eq $testFld; # Don't process field if the field was compared before or # if there is no keyword in the header or if the keyword # was processed before next if $compared{$fldName}{$unqFldVal} or !$kywdVal or $kywdExists{$kywd}{$acronym}; print "CompareOrKywds:3:passed next\n" if $fldName eq $testFld; # Try to do a straight field vs. keyword match. Do not try # to match using the unique field or unique keyword. If something # does match write out a match line. If it doesn't try the # next potential keyword. There will never be diffs for OR # keywords. my $matchLine = ''; if ( $fldVal eq $kywdVal ) { my $kywdInfo = "$kywd($extSource->{0}{$kywd}/0)"; my $kywdLine = sprintf("%-25s %-s", $kywdInfo, $kywdVal ); my $fldInfo = $fldName; $fldInfo .= "($unqFldVal)" if $unqFldVal; my $fldLine = sprintf("%-25s %-s", $fldInfo, $fldVal ); $matchLine = "$kywdLine\n$fldLine\n\n"; push( @$matchList, $matchLine ); } else { next; } # Keep track of keywords that are processed $kywdExists{$kywd}{$acronym} = 1; print "CompareOrKywds:4:m=$matchLine" if $fldName eq $testFld; # The keyword and fieldname are now considered compared. $delFlds->{$fldName}{$kywd}{$unqFldVal} = 1; $delKywds->{$kywd}{$fldName}{$unqFldVal} = 1; # This field and unique field have can be considered compared. # Go to the next unique value $compared{$fldName}{$unqFldVal} = 1; last; } } # In processing this section loop through any potential keywords, # not the actual keywords, so there are certain cases that should # be skipped. foreach my $kywd ( sort keys %{$multFldMap->{$mission}{$instr}{$fldName}} ) { # Don't process if keyword processed before or the keyword is not # in the header or if there is no record in the database next if $kywdExists{$kywd}{$acronym} or !$kywdVerVals->{0}{$kywd} or !$dbRecExists{$acronym}; # Save the keyword information for the missing field. $kywdLeftCnt++; my $kywdInfo = "$extSource->{0}{$kywd}/0"; $kywdsLeft .= sprintf( "%-8s %-9s %-35s %-s\n", $kywd, $kywdInfo, $kywdVerVals->{0}{$kywd}, $fldName ); print "CompareOrKywds:5:$kywd*$kywdInfo*", "$kywdVerVals->{0}{$kywd}*$fldName*$dbRecExists{$acronym}*\n" if $fldName eq $testFld; } } return ( $kywdLeftCnt, $kywdsLeft ); } #----------------------------------------------------------------------- # # ProcessLeftOverFlds # Process each field from the database. Here are listed the fields # that map to keywords which should be in the headers but are not. # #----------------------------------------------------------------------- sub ProcessLeftOverFlds { my ( $mission, $instr, $delFlds, $kywdVerVals, $fldRowVals, $fldMapper, $kywdMapper, $headerName ) = @_; my $fldsLeft = ''; # Rpt of fields that are missing a kywd my $fldsLeftCnt = 0; # Count of fields that are missing a kywd # Create 2 section names starters. One for this kind of header and # one for the spt header. # Ex: For ACS, detector=SBC will have secName=ACS_SBC. # ACS has the HRC target acquisition header which should be excluded # when TARAQMOD = 2. # STIS num-mama and fuv-mama should be changed to STIS_MAMA. my $secName = "${instr}_$kywdVerVals->{1}{DETECTOR}"; if ( $instr eq 'ACS' and $kywdVerVals->{0}{TARAQMOD} ne '02' ) { $secName .= '_[^T]'; } elsif ( $instr eq 'STIS' and $secName =~ /MAMA/ ) { $secName = 'STIS_MAMA'; } my $specSecName = "${instr}_SPT"; foreach my $fldName ( sort keys %{$fldRowVals} ) { foreach my $unqFldVal ( sort keys %{$fldRowVals->{$fldName}} ) { my $kywd = $fldMapper->{$mission}{$instr}{$fldName}; # Skip keywords already compared next if $delFlds->{$fldName}{$kywd}{$unqFldVal}; # Get the kywd and use it to loop through each section associated # with the keyword and only treat the kywd as missing if it's # not in the proper header. my $shouldBeInHeader = 0; print "ProcessLeftOverFlds:1:$kywd*$secName*", "$instr*$kywd*$fldName*$unqFldVal*\n" if $fldName eq $testFld; foreach my $hdrName ( sort keys %{$headerName->{$mission}{$instr}{$kywd}} ) { if ( $hdrName =~ /^$secName/ or $hdrName =~ /^$specSecName/ ) { $shouldBeInHeader = 1; } } print "ProcessLeftOverFlds:2:$shouldBeInHeader*$kywd*$secName*\n" if $fldName eq $testFld; next if ! $shouldBeInHeader; print "ProcessLeftOverFlds:3:in header\n" if $fldName eq $testFld; # If there was no keyword and there is a default value compare # the field against the default value. If it matches don't # write out this field. my $defaultUsed = 0; if ( $kywdMapper->{$mission}{$instr}{$kywd}{$fldName}=~/^DEFAULT/ ){ # Compare the keyword and field values my ( $matchLine, $diffLine ) = CompareVals( 0, $kywd, '', '', $fldName, $fldRowVals->{$fldName}{$unqFldVal}, $unqFldVal, $kywdMapper->{$mission}{$instr}{$kywd}{$fldName}, (), () ) ; $defaultUsed = 1 if $matchLine; } print "ProcessLeftOverFlds:4:$defaultUsed*\n" if $fldName eq $testFld; next if $defaultUsed; # At this point the field's keyword is not in the file and it # should be so we save the information for the report. my $fieldVal = $fldRowVals->{$fldName}{$unqFldVal}; $fieldVal = '(null)' if $fieldVal eq '~'; $fldsLeftCnt++; $fldsLeft .= sprintf( "%-20s %-30s %-10s %-s\n", $fldName, $fieldVal, $fldMapper->{$mission}{$instr}{$fldName}, $unqFldVal ); } } return ( $fldsLeftCnt, $fldsLeft ); } #----------------------------------------------------------------------- # # ProcessLeftOverKywds # Process the keywords that did not match a field. This sub skips all # the possible reasons it's ok not to have matched. Anything that goes # through all the skipping is listed as a field not populated. # #----------------------------------------------------------------------- sub ProcessLeftOverKywds { my ( $hashType, $mission, $instr, $ts, $delKywds, $kywdVerVals, $kywdMapper, $fldMapper, $unqFldList, $extSource, $stisCompared, $skipFld, $tableType ) = @_; my $kywdLeftCnt = 0; # Count of kywds that are missing a fld my $kywdsLeft = ''; # Rpt of kywds that are missing a fld my %obsnumUsed = (); # Get the association id if there is one my $asnId = $kywdVerVals->{0}{ASN_ID} if $kywdVerVals->{0}{ASN_ID} ne 'NONE'; foreach my $extVer ( sort keys %{$kywdVerVals} ) { foreach my $kywd ( sort keys %{$kywdVerVals->{$extVer}} ) { print "ProcessLeftOverKywds:1:$extVer*$kywd*\n" if $kywd eq $testKywd; foreach my $fldName ( sort keys %{$kywdMapper->{$mission}{$instr}{$kywd}} ) { my $acronym = substr($fldName,0,3); # Get the unique value for this field my $uniqueFldName = $unqFldList->{$mission}{$instr}{$acronym}; my $uniqueKywd = $fldMapper->{$mission}{$instr}{$uniqueFldName}; my $uniqueVal = $kywdVerVals->{$extVer}{$uniqueKywd}; if ( $uniqueFldName =~ /;/ ) { my @keyFlds = split( /;/, $uniqueFldName ); my @keyVals = ''; foreach my $unqFld ( @keyFlds ) { my $unqKywd = $fldMapper->{$mission}{$instr}{$unqFld}; push( @keyVals, $kywdVerVals->{$extVer}{$unqKywd} ); } $uniqueVal = join( ";", @keyVals ); } print "ProcessLeftOverKywds:1.5:$fldName*$uniqueFldName*", "$uniqueKywd*$uniqueVal*", "$delKywds->{$kywd}{$fldName}{$uniqueVal}*", "$tableType->{$mission}{$instr}{$acronym}*\n" if $kywd eq $testKywd and $fldName eq $testFld; # Skip this keyword if it was compared or it's a field in a # table that is filled for this instrument but not for this # archive class. Ex: ssg is filled for stis but not for ac=cal. next if $delKywds->{$kywd}{$fldName}{$uniqueVal} or !$tableType->{$mission}{$instr}{$acronym}; print "ProcessLeftOverKywds:2:$fldName*", "$kywdMapper->{$mission}{$instr}{$kywd}{$fldName}*", "$skipFld->{$mission}{$instr}{$fldName}*", "$uniqueFldName*$uniqueKywd*$uniqueVal*", "$acronym*$stisCompared->{$fldName}*$instr*$ts*\n" if $kywd eq $testKywd and $fldName eq $testFld; # Ths group of nexts are conditions where it's ok # for the keyword to be missing a field. # Skip keywords that map to fields in the skip list next if $skipFld->{$mission}{$instr}{$fldName}; # Keywords that have special process = IGNORE have been compared # with their primary keyword. next if $kywdMapper->{$mission}{$instr}{$kywd}{$fldName} =~ /^IGNORE/; # Skip association tables for non associations next if !$asnId and ( $acronym eq 'ast' or $acronym eq 'asm' ); # Skip assoc_orphan if it's not there next if $acronym eq 'aso'; # Skip tables that have OR keywords in them. next if $acronym eq 'tak' or $acronym eq 'tsy' or $acronym eq 'mtp'; # SCP keywords shouldn't be compared if SCAN_TYP is C or D next if $kywdVerVals->{0}{SCAN_TYP} ne 'C' and $kywdVerVals->{0}{SCAN_TYP} ne 'D' and $acronym eq 'scp'; # FIT keywords shouldn't be compared for moving targets next if $kywdVerVals->{0}{MTFLAG} eq 'T' and $acronym eq 'fit'; # W3T should not be filled for WFC3/UVIS next if $kywdVerVals->{0}{CONFIG} eq 'WFC3/UVIS' and $acronym eq 'w3t'; # COS ACQs should not fill asm table next if $kywdVerVals->{0}{ASN_MTYP} =~ /^EXP-ACQ/ and $acronym eq 'asm'; # SCA: These are primary header keywords that map to member # tables which have already been compared. next if $acronym =~ /ss[abc]/ and $stisCompared->{$fldName}; # Skip non stis filling of idb for products next if $mission eq 'HST' and $instr ne 'STIS' and !$ts and $fldName =~ /^sij_idb/; # Skip non stis filling of sdb for exposures next if $mission eq 'HST' and $instr ne 'STIS' and $ts and $fldName =~ /^sij_sdb/; # SCA: Skip SIJ sdb keywords for image extension keywords next if $mission eq 'HST' and $instr eq 'STIS' and $extVer != 0 and $fldName =~ /^sij_sdb/; # SCA: Skip SIJ idb keyword for primary header keywords of assoc next if $mission eq 'HST' and $instr eq 'STIS' and $asnId and $extVer == 0 and $fldName =~ /^sij_idb/; # Skip oms_data extVer = 0 entries next if $acronym eq 'oms' and $extVer == 0; # Skip keywords in ext ver = 0 that are in exposure tables # COS Kludge: or if it's a *_b file then skip ext ver = 1000 # This is done since the extver = 1000 was artificially created # by adding 1000 for keywords gotten from *_b extensions. # It is really extver = 0. Same for next statement. next if $tableType->{$mission}{$instr}{$acronym} eq 'MEMBEXP' and ( $extVer == 0 or ( $extVer == 1000 and $extSource->{$extVer}{$kywd} =~ /_b$/ ) ); # Skip keywords in further extensions that are in product tables next if $tableType->{$mission}{$instr}{$acronym} ne 'MEMBEXP' and $extVer != 0 and ( $extVer != 1000 or $extSource->{$extVer}{$kywd} =~ /_b$/ ); # Back to regular processing... # Treat assoc_status like a product table here $tableType->{$mission}{$instr}{ast} = 'PRODEXP'; print "ProcessLeftOverKywds:3:$kywd*$fldName*$uniqueVal*", "$skipFld->{$mission}{$instr}{$fldName}*$uniqueFldName*", "$asnId*$ts*$acronym*", "$tableType->{$mission}{$instr}{$acronym}*", "$stisCompared->{$fldName}*\n" if $kywd eq $testKywd and $fldName eq $testFld; # For non association tables, if this dataset is a member of # a non stis association and it's not a sij entry then # if we're dealing with a product dataset then we want to exclude # keywords for exposure tables and vice versa. if ( $tableType->{$mission}{$instr}{$acronym} ne 'ASNTBL' and $asnId and $instr ne 'STIS' and $instr ne 'OMS' and $acronym !~ /^sij/ ) { if ( $ts ) { next if $tableType->{$mission}{$instr}{$acronym} eq 'PRODEXP'; } else { next if $tableType->{$mission}{$instr}{$acronym} eq 'MEMBEXP' } } # This pso key for this field is being printed. Used to # prevent multiple bogus versions being written to the report. $obsnumUsed{$fldName} = $kywdVerVals->{$extVer}{$kywd} if $kywd eq 'OBSERVTN' or $kywd eq 'OBSET_ID' or $kywd eq 'PROGRMID'; # Save the keyword information for the missing field. $kywdLeftCnt++; # COS kludge: reset any faked extension numbers for printing # to print out. This is primarily for segment keywords. my $printExtVer = $extVer; $printExtVer -= 1000 if $printExtVer > 999 and $extSource->{$extVer}{$kywd} =~ /_b$/; my $kywdInfo = "$extSource->{$extVer}{$kywd}/$printExtVer"; $kywdsLeft .= sprintf( "%-8s %-9s %-35s %-s\n", $kywd, $kywdInfo, $kywdVerVals->{$extVer}{$kywd}, $fldName ); print "ProcessLeftOverKywds:4:$kywd*$kywdInfo*", "$kywdVerVals->{$extVer}{$kywd}*$fldName\n" if $kywd eq $testKywd and $fldName eq $testFld; } } } return ( $kywdLeftCnt, $kywdsLeft ); } #----------------------------------------------------------------------- # # WriteRpts # Generate the matching and difference reports. The difference report # will contain the differences between keyword and fields as well as # fields with no keywords and keywords with no matching field filled in. # Write the totals to the difference report and standard out. # #----------------------------------------------------------------------- sub WriteRpts { my ( $mission, $instr, $archiveClass, $datasetName, $matchList, $diffList, $fldsLeft, $fldLeftCnt, $kywdsLeft, $kywdLeftCnt ) = @_; $archiveClass = 'AST' if $datasetName =~ /^F/; my $difFileName = lc "${datasetName}_$archiveClass.dif"; my $matFileName = lc "${datasetName}_$archiveClass.mat"; my $header = "Processing $datasetName/$archiveClass/$mission\n" . "Using $dadsInfo and files in directory $fileDir\n\n"; print "Output going to $difFileName, $matFileName\n"; open ( MAT, ">$matFileName" ); my $matchCnt = @{$matchList}; my $matchRpt = join( '', @{$matchList} ); print MAT $header; print MAT $matchRpt; close ( MAT ); open ( DIF, ">$difFileName" ); my $diffCnt = @$diffList; my $diffRpt = join( '', @$diffList ); print DIF $header; print DIF "Differences between keyword values and field values\n", "~ means the database field is null\n\n"; print DIF $diffRpt; print DIF "\n\nFields where the expected keyword is missing from all headers\n\n"; print DIF "Field Name Field Value ", "Keyword Unique Key\n"; print DIF "-------------------- ------------------------------ ", "---------- -------------------- \n"; print DIF $fldsLeft; print DIF "\n\nKeywords that could but are NOT populating fields\n\n"; print DIF "Keyword Extension Keyword Value "; print DIF " Field Name\n"; print DIF "-------- --------- -----------------------------------", " -------------------------\n"; print DIF $kywdsLeft; print DIF "\nNumber of keyword/field that matched: $matchCnt\n"; print DIF "Number of keyword/field differences : $diffCnt\n"; print DIF "Number of fields without keywords : $fldLeftCnt\n"; print DIF "Number of keywords without fields : $kywdLeftCnt\n"; print "Number of keyword/field that matched: $matchCnt\n"; print "Number of keyword/field differences : $diffCnt\n"; print "Number of fields without keywords : $fldLeftCnt\n"; print "Number of keywords without fields : $kywdLeftCnt\n"; close ( DIF ); } #----------------------------------------------------------------------- # # DateSecs # Converts the programs date format to seconds. This routine is # used in converting the date to seconds so that it can be compared # with the precision hash. # #----------------------------------------------------------------------- sub DateSecs { my ( $date ) = @_; my ($mon,$mday,$year,$hour,$min,$sec) = split(/[\/: ]/,$date); # timelocal can only handle dates greater than 1900. If the date # is less than that use a zero. # Also it can only handle seconds between 0 and 59. I can send in # seconds with milliseconds attached so take them off before the # call to timelocal and add them back on afterward. my $millisecs = $sec - int($sec); $sec = $sec - $millisecs; my $time = $year < 1900 ? 0 : timelocal($sec,$min,$hour,$mday,$mon-1,$year); $time += $millisecs; }