#!/usr/bin/perl

use Time::Local;

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

$OUTDIR = "new";

if (@ARGV==0)
  { die "Usage: mkppol ppol.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)";

    # 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/)
          { $obsdd = substr($line,11,2);
            $obsmm = substr($line,14,2);
            $obsyy = "19" . substr($line,17,2);
            $date = "$obsyy-$obsmm-${obsdd}T";
            $start_day = $obsdd;
          }
        elsif ($line =~ /^TIME-OBS/)
          { $fobstime = substr($line,20,10);
            $d = $fobstime;
            $d = $d * 24.0;
            $hh = int($d);
            $d = ($d - $hh) * 60.0;
            $mm = int($d);
            $d = ($d - $mm) * 60.0;
            $ss = int($d + 0.5);
            $obs_time = sprintf "%s%02d:%02d:%02d",$date, $hh, $mm, $ss;
          }
        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 =~ /^OBSVTORY= '(.*)'/)
          { $observatory = $1;}
        elsif ($line =~ /^TELESCOP= '(.*)'/)
          { $telescope = $1;}
        elsif ($line =~ /^ELEV-OBS=\s+(\S+)\s+/)
          { $elevation = $1; }
        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);

    # 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;

#        if ($line =~ /^\s+$/)
#          { printf "$name.tab only has $i records, not $naxis2.\n";
#            $i = $naxis2;
#            $stop_time = $row_ut;  # from last pass
#            last;
#          }
        $rowdate  = substr($line, 0,8);
        $recnum   = substr($line, 9,2);
        $filter   = substr($line,12,4);
        $wavelen  = substr($line,17,4);
        $bandpass = substr($line,22,4);
        $poltype  = substr($line,27,2);
        $polar    = substr($line,30,5);
        $error    = substr($line,37,4);
        $posangle = substr($line,42,5);
        $errpa    = substr($line,48,4);
        $diaph    = substr($line,53,5);
        $rho      = substr($line,61,2);
        $theta    = substr($line,64,3);
        $inttime  = substr($line,68,4);
        $airmass  = substr($line,73,5);

        # Adjusting for a positioning problem in file ppol0079.tab:

        if ($name eq "ppol0079")
          { $rho     = substr($line,60,2);
            $theta   = substr($line,63,3);
            $inttime = substr($line,67,4);
            $airmass = substr($line,72,5);
          }

        # Add missing value flags:

        $filter   = "----"  if ($filter =~ /^\s*$/);
        $wavelen  = "-999"  if ($wavelen =~ /^\s*$/);
        $bandpass = "-999"  if ($bandpass =~ /^\s*$/);
        $error    = "-.99"  if ($error =~ /^\s*$/);
        $errpa    = "-9.9"  if ($errpa =~ /^\s*$/);
        $rho      = "-9"    if ($rho =~ /^\s*$/);
        $theta    = "-99"   if ($theta =~ /^\s*$/);
        $inttime  = "-999"  if ($inttime =~ /^\s*$/);
        $airmass  = "-.999" if ($airmass =~ /^\s*$/);

        # Convert the record date to UT.  Precision varies wildly in thes
        # records, so we try to preserve only as many significant digits as
        # we actually have:

        $rowdate =~ /^\s*([0-9]+)(\.[0-9]+)\s*$/;
        $row_day = $1;  
        $fraction = $2; 
        $digits = length($fraction) - 1;

        # Now we calculate time base on how many digits we got:

        if ($digits == 1)      # We know this digit is always zero
          { $row_time = "        "; }

        elsif ($digits == 2)   # Accurate to nearest 15 minutes
          { $d = $fraction * 24.0;
            $hh = int ($d);
            $d = ($d - $hh) * 60.0;
            $mm = int($d);
            $mm = int(($mm+7.5)/15) * 15;
            if ($mm == 60)
              { $mm = 0;
                $hh++;
              }
            $row_time = sprintf "%02d:%02d   ", $hh, $mm;
          }
 
        elsif ($digits == 3)   # Accurate to about a minute (actually, 1.4)
          { $d = $fraction * 24.0;
            $hh = int($d);
            $d = ($d - $hh) * 60.0;
            $mm = int($d + 0.5);
            if ($mm == 60)
              { $mm = 0;
                $hh++;
              }
            $row_time = sprintf "%02d:%02d   ", $hh, $mm;
          }

        elsif ($digits == 4)   # Accurate to about 10 seconds
          { $d = $fraction * 24.0;
            $hh = int($d);
            $d = ($d - $hh) * 60.0;
            $mm = int($d);
            $d = ($d - $mm) * 60.0;
            $ss = int($d);
            $ss = int(($ss+5)/10) * 10;
            if ($ss == 60)
              { $ss = 0;
                $mm++;
              }
            $row_time = sprintf "%02d:%02d:%02d", $hh, $mm, $ss;
          }

        else                   # 5 digits are accurate to about a second
          { $d = $fraction * 24.0;
            $hh = int($d);
            $d = ($d - $hh) * 60.0;
            $mm = int($d);
            $d = ($d - $mm) * 60.0;
            $ss = int($d + 0.5);
            if ($ss == 60)
              { $ss = 0;
                $mm++;
              }
            $row_time = sprintf "%02d:%02d:%02d",$hh, $mm, $ss;
          }

        # Figure out the right date for the row:

        if ($row_day == $obsdd)
          { $row_date = sprintf "%4d-%02d-%02dT", $obsyy, $obsmm, $obsdd; }
        elsif (abs($row_day - $obsdd) > 1)
          { $row_date = sprintf "%4d-%02d-%02dT", 
                        $obsyy, $obsmm-1, $row_day; }
        else
          { $row_date = sprintf "%4d-%02d-%02dT", $obsyy, $obsmm, $row_day; }

        # If the row time is null, we want to drop the "T" separator:

       if ($row_time eq "        ")
         { $row_date =~ s/T/ /; }

        $row_ut = $row_date . $row_time;
        if ($i == 0)
          { $start_time = $row_ut; }
        if ($i == $rows-1)
          { $stop_time = $row_ut; }

        if ($row_day != $start_day)
          { printf STDOUT "Start day ($start_day) doesn't match row ";
            printf STDOUT "day ($row_day) in $tabfile.\n";
          }

        # Now we can print out the reformatted record:

        printf NEW "$row_ut $recnum $filter $wavelen $bandpass ";
        printf NEW "$poltype $polar $error $posangle $errpa ";
        printf NEW "$diaph $rho $theta $inttime $airmass\r\n";

        # Next table row...
      }

#    # Read another row to see if the NAXIS2 value is too small:
#
#    read OLD, $line, 80;
#    if ($line !~ /^\s+$/)
#      { printf "$name.tab has more records that NAXIS2 ($naxis2)\n"; }

    # 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 = 88\n";
    printf LBL "FILE_RECORDS = $rows\n\n";
    printf LBL "DATA_SET_ID = \"IHW-C-PPOL-3-RDR-HALLEY-V2.0\"\n";
    printf LBL "PRODUCT_ID = \"$name\"\n";
    printf LBL "PRODUCT_NAME = \"IHW POLARIMETRY $filenum\"\n";
    printf LBL "PRODUCT_CREATION_TIME = 2006-06-20\n";
    printf LBL "\n";
    printf LBL "INSTRUMENT_HOST_NAME = \"IHW PHOTOMETRY AND POLARIMETRY NETWORK\"\n";
    printf LBL "INSTRUMENT_HOST_ID = \"PPN\"\n";
    printf LBL "INSTRUMENT_NAME = \"POLARIMETRY DATA\"\n";
    printf LBL "INSTRUMENT_ID = \"PPOL\"\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_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 "  East Longitude: $obs_long\n";
    printf LBL "  North Latitude: $obs_lat\n";
    printf LBL "       Elevation: $elevation\n";
    printf LBL "       Telescope: $telescope\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";
    printf LBL "^TABLE       = \"$TABFILE\"\n";
    printf LBL "\n";
    printf LBL "OBJECT = TABLE\n";
    printf LBL "INTERCHANGE_FORMAT = \"ASCII\"\n";
    printf LBL "ROW_BYTES = 88\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:

  }

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