#!/usr/bin/perl

use Time::Local;

# Routine to make PDS labels and reformatted data tables from the 
# FITS headers and tables of the original IRPH submission.
#
# Format: % mkirph header
#
#   where "header" is the name of the FITS header file.  Data segments
#         must be in the same directory.
#
# 08 May 2006, A.C.Raugh
#=======================================================================

$OUTDIR = "new";

if (@ARGV==0)
  { die "Usage: mkirph irph.hdr\n"; }

foreach $file (@ARGV)
  { if ($file !~ /\.hdr/)
      { printf STDERR "$file is not a FITS header file, is it?\n";
        next;
      }

    # Find and open files:

    $name = $file;
    $name =~ s/\.hdr//;

    $lblfile = "$name.lbl";
    $tabfile = "$name.tab";

    $TABFILE = $tabfile;
    $TABFILE =~ tr/a-z/A-Z/;

    open(HDR,$file) || die "Could not open $file for reading ($!)";

    # Constants:

    $target    = "1P/HALLEY 1 (1682 Q1)";
    $stop_time = "\"UNK\"";

    # We'll completely parse the FITS header first:

    $cc = 0;
    read HDR, $line, 80;
    $lc = 1;
    while ($line !~ /^TFIELDS/)
      { if ($line =~ /^NAXIS2/)
          { $rows   = substr($line,27,3); }
        elsif ($line =~ /^FILE-NUM/)
          { $filenum = substr($line,24,6); }
        elsif ($line =~ /^DATE-OBS/)
          { $dd = substr($line,11,2);
            $mm = substr($line,14,2);
            $yy = substr($line,17,2);
            $date = "19$yy-$mm-${dd}T";
          }
        elsif ($line =~ /^TIME-OBS/)
          { $d = substr($line,20,10);
            $d = $d * 24.0;
            $hh = int($d);
            $d = ($d - $hh) * 60.0;
            $mm = int($d + 0.5);
            $time = sprintf "%02d:%02d",$hh, $mm;
          }
        elsif ($line =~ /^LONG-OBS/)
          { $dd = substr($line,11,3);
            $mm = substr($line,15,2);
            $ss = substr($line,18,2);
            $val = ($dd * 1.0) + ($mm / 60.0) + ($ss / 3600.0);
            $obs_long = sprintf "%8.4f",$val;
          }
        elsif ($line =~ /^LAT--OBS/)
          { $s  = substr($line,11,1);
            $dd = substr($line,12,2);
            $mm = substr($line,15,2);
            $ss = substr($line,18,2);
            $val = ($dd * 1.0) + ($mm / 60.0) + ($ss / 3600.0);
            $obs_lat = sprintf "%s%07.4f",$s,$val;
          }
        elsif ($line =~ /^SYSTEM/)
          { $system = substr($line,11,8); }
        elsif ($line =~ /^OBSERVER/)
          { $line =~ /'(.*)'\s+$/;
            $observer = $1;
          }
        elsif ($line =~ /^INSTRUME/)
          { $instrument = substr($line,11,60);
            $instrument =~ s/'\s+$//;
          }
        elsif ($line =~ /^OBSVTORY/)
          { $observatory = substr($line,11,60);
            $observatory =~ s/'\s+//;
          }
        elsif ($line =~ /^LOCATION/)
          { $location = substr($line,11,60);
            $location =~ s/'\s+//;
          }
        elsif ($line =~ /^TELESCOP/)
          { $telescope = substr($line,11,60);
            $telescope =~ s/'\s+//;
          }
        elsif ($line =~ /^COMMENT/)
          { $val = substr($line,10,70);
            $val =~ s/\s+$//;
            $val =~ s/"/''/g;
            $comment[$cc] = "  $val";
            $cc++;
          }
        elsif ($line =~ /^HISTORY/)
          { $val = substr($line,10,70);
            $val =~ s/\s+$//;
            $comment[$cc] = "  $val";
            $cc++;
          }

        # Next line:

        read HDR,$line,80;
        $lc++;
      }

    # Done with the HDR file.

    close(HDR);
    $start_time = $date . $time;
    $obs_time   = $date . $time;

    # Next, we'll prepare the new data table:

    open(OLD,$tabfile) || die "Could not open $tabfile for reading ($!)";
    open(NEW,"> new/$tabfile") || die "Could not open new table ($!)";

    # Loop through records:

    for ($i = 0; $i < $rows; $i++)
      { read OLD, $line, 80;
        $filter = substr($line,1,5);
        $flag   = substr($line,7,1);
        $mag    = substr($line,8,6);
        $err    = substr($line,15,4);
        $aper   = substr($line,21,4);
        $uthh   = substr($line,26,2);
        $utmm   = substr($line,28,2);
        $exps   = substr($line,31,4);
        $airm   = substr($line,36,5);
        $chdist = substr($line,42,3);
        $chdir  = substr($line,46,2);
        $bmoff  = substr($line,51,4);
        $bmpa   = substr($line,57,5);
        $origin = substr($line,64,1);
        $flttab = substr($line,67,2);
        $notes  = substr($line,70,2);

        # Make sure character fields are left-justified and
        # insert missing constants as needed:

        $filter = format_char($filter,5,"-");
        $flag   = format_char($flag,1," ");
        $chdir  = format_char($chdir,2,"--");
        $notes  = format_char($notes,2,"-");
        $origin = format_char($origin,1,"-");

        # Similarly for integer fields:

        $exps   = format_int($exps,4,"-999");
        $chdist = format_int($chdist, 3, "-99");
        $flttab = format_int($flttab, 2, "-9");

        # And real numbers:

        $mag    = format_real($mag,6,3,"-9.999");
        $err    = format_real($err,5,3,"-.999");
        $aper   = format_real($aper,5,1,"-99.9");
        $airm   = format_real($airm,5,3,"-.999");
        $bmoff  = format_real($bmoff,4,1,"-9.9");
        $bmpa   = format_real($bmpa,5,1,"-99.9");

        # And finally, UT:

        if ($uthh =~ /^\s+$/)
          { $ut = "99:99"; }
        else
          { $ut = sprintf "%02d:%02d", $uthh, $utmm; }

        # Now we can print out the reformatted record:

        printf NEW "$filter $flag$mag $err $aper $ut $exps $airm ";
        printf NEW "$chdist $chdir $bmoff $bmpa $origin $flttab $notes\r\n";

        # If this is the first record and we have both a UT and an
        # exposure time, we can calculate a better start time:

        if ($i==0  &&  $uthh !~ /^\s+$/  &&  $exps ne "-999")
          { $year = substr($date,0,4);
            $mon  = substr($date,5,2) - 1;
            $day  = substr($date,8,2);
            $calctime = timelocal(0,$utmm,$uthh,$day,$mon,$year);
            $calctime -= ($exps/2);
            ($sec,$min,$hour,$mday,$mon,$year) = localtime($calctime);
            $year += 1900;
            $mon++;
            $date = sprintf "%4d-%02d-%02dT", $year, $mon, $day;
            $time = sprintf "%02d:%02d", $hour, $min;
            $start_time = $date . $time;
          }

        # If this is the last record and we have both a UT and an
        # exposure time, we can calculate a stop time:

        if ($i==($rows-1)  &&  $uthh !~ /^\s+$/  &&  $exps ne "-999")
          { $year = substr($date,0,4);
            $mon  = substr($date,5,2) - 1;
            $day  = substr($date,8,2);
            $calctime = timelocal(0,$utmm,$uthh,$day,$mon,$year) + ($exps/2);
            ($sec,$min,$hour,$mday,$mon,$year) = localtime($calctime);
            $year += 1900;
            $mon++;
            $date = sprintf "%4d-%02d-%02dT", $year, $mon, $day;
            $time = sprintf "%02d:%02d", $hour, $min;
            $stop_time = $date . $time;
          }

        # Next table row...
      }

    # Done with the table files:

    close(OLD);
    close(NEW);

    # Now we write the new PDS label:

    open(LBL,"| ppodl -p >new/$lblfile") || 
        die "Could not open new/$lblfile for writing ($!)";

    printf LBL "PDS_VERSION_ID = PDS3\n\n";
    printf LBL "RECORD_TYPE = \"FIXED_LENGTH\"\n";
    printf LBL "RECORD_BYTES = 70\n";
    printf LBL "FILE_RECORDS = $rows\n\n";
    printf LBL "DATA_SET_ID = \"IHW-C-IRPHOT-3-EDR-HALLEY-V2.0\"\n";
    printf LBL "PRODUCT_ID = \"$name\"\n";
    printf LBL "PRODUCT_NAME = \"IHW IR PHOTOMETRY $filenum\"\n";
    printf LBL "PRODUCT_CREATION_TIME = 2006-05-06\n";
    printf LBL "\n";
    printf LBL "INSTRUMENT_HOST_NAME = \"IHW INFRARED STUDIES NETWORK\"\n";
    printf LBL "INSTRUMENT_HOST_ID = \"IRSN\"\n";
    printf LBL "INSTRUMENT_NAME = \"IHW INFRARED PHOTOMETRY DATA\"\n";
    printf LBL "INSTRUMENT_ID = \"IRPHOT\"\n";
    printf LBL "TARGET_NAME = \"$target\"\n";
    printf LBL "TARGET_DESC = \"$target_desc\"\n" if ($target_desc);
    printf LBL "START_TIME = $start_time\n";
    printf LBL "STOP_TIME = $stop_time\n";
    printf LBL "OBSERVATION_TIME = $obs_time\n";
    printf LBL "OBSERVATION_ID = \"$filenum\"\n";
    printf LBL "OBSERVER_FULL_NAME = \"$observer\"\n";
    printf LBL "\n";
    printf LBL "DESCRIPTION = \"\n";
    printf LBL "System code: $system\n";
    printf LBL "Observatory Info\n";
    printf LBL "            Name: $observatory\n";
    printf LBL "        Location: $location\n";
    printf LBL "  East Longitude: $obs_long\n";
    printf LBL "  North Latitude: $obs_lat\n";
    printf LBL "       Telescope: $telescope\n";
    printf LBL "      Instrument: $instrument\n";
    printf LBL "\n";
    printf LBL "Comments from the FITS header:\n";
    printf LBL "\n";
    for ($i=0; $i<$cc; $i++)
      { printf LBL "$comment[$i]\n"; }
    printf LBL "\"\n";
    printf LBL "\n";
    if ($start_time eq $obs_time)
      { printf LBL "NOTE = \"\n";
        printf LBL "  The START_TIME listed is actually the OBSERVATION_TIME,\n";
        printf LBL "  i.e., the midpoint of the observation.  Exposure times\n";
        printf LBL "  were not reported, so it was not possible to determine\n";
        printf LBL "  the actual starting time of the observation.  However, \n";
        printf LBL "  START_TIME is a keyword used to search for data across\n";
        printf LBL "  large sections of the PDS archives, so the midpoint \n";
        printf LBL "  time has been repeated as the START_TIME to prevent \n";
        printf LBL "  these data being lost for want of a more accurate\n";
        printf LBL "  value.\n";
        printf LBL "  \"\n";
        printf LBL "\n";
      }
    printf LBL "^TABLE       = \"$TABFILE\"\n";
    printf LBL "\n";
    printf LBL "OBJECT = TABLE\n";
    printf LBL "INTERCHANGE_FORMAT = \"ASCII\"\n";
    printf LBL "ROW_BYTES = 70\n";
    printf LBL "ROWS = $rows\n";
    printf LBL "COLUMNS = 15\n";
    printf LBL "\n";
    open(COL,"column.fmt") || die "Could not open 'column.fmt'";
    while ($line=<COL>)
      { printf LBL $line; }
    close(COL);
    printf LBL "\n";
    printf LBL "END_OBJECT = TABLE\n";
    printf LBL "\n";
    printf LBL "END\n";

    # Done with the label:

    close(LBL);

    # Next file:

  }

#===========================================================================
#===========================================================================
#===========================================================================

sub format_char

# Format a character string to left-justify in a fixed-width field,
# inserting MISSING_CONSTANT as needed.

{ local ($fld,$size,$missing) = @_;  # string, fieldwidth and missing constant

  my $buff;

  # Remove blanks and rewrite the field left-justified:

  $fld = $missing if ($fld =~ /^\s*$/);
  $fld =~ s/\s+//g;
  return sprintf "%-*s",$size,$fld;
}

#---------------------------------------------------------------------------

sub format_int

# Format an integer to be right-justified in a fixed-width field,
# inserting MISSING_CONSTANT as needed.

{ local ($fld,$size,$missing) = @_;

  $fld = $missing if ($fld =~ /^\s+$/);
  return sprintf "%*d",$size,$fld;
}

#---------------------------------------------------------------------------

sub format_real

# Format a floating-point number to be decimal-aligned, inserting
# MISSING_CONSTANT as needed.

{ local ($fld,$size,$dec,$missing) = @_;

  my (@f,$int);

  $int = $size - $dec - 1;
  $fld = $missing if ($fld =~ /^\s+$/);
  $fld =~ s/\s+//g;

  @f = split(/\./,$fld);
  if ($f[0] eq "-")
    { return sprintf "-.%-*s",$dec, $f[1]; }
  else
    { return sprintf "%*s.%-*s", $int, $f[0], $dec, $f[1]; }
}