#!/usr/bin/perl
#
my $scriptName = "interpretQC.pl";
my $VERSION = "1.1";
my $VERSION_DATE = "2012-08-15";
#
# Revision history
# ===================================================================
#
# Purpose: to interpret GTSPP QC code and QC test results
#
# Version 1.0 2011-09-08 Created (Norman Hall)
#
# Version 1.1 2012-08-15 (Charles Sun)
#   Modified to write output to a HTM file 
#

#
# Standard modules
#
use strict;
use Getopt::Long;
use POSIX;
#
#set path and environment variables first.
#
$ENV{PATH} = "/usr/bin:/bin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
#
# Interpret Command Line
#
my $O = ($0 =~ m:/([^/]+)$: ? $1 : $0);
my $command_line = "$0 @ARGV";

use vars qw($opt_h $opt_version $opt_v $opt_c $opt_r $opt_o $opt_htm);
GetOptions('h|help', 'version', 'v', 'c|code:s', 'r|result:s', 'o|output:s',
           'htm:s' );

my @stage_numbers = ('zero','1.1','1.2','1.3','1.4','1.5','1.6','2.1','2.2','2.3','2.4','2.5','2.6','2.7','2.8','2.9','2.10','3.1','3.2','3.3','3.4','4.1','5.1','5.2','2.11','2.12','3.5','N/A','N/A','N/A','N/A','N/A','N/A');

if ($opt_h) { &helpMenu; }
if ($opt_version) { print "<$scriptName $VERSION $VERSION_DATE>\n"; exit(0);}

my $output = "interpretQC.txt";
my $htmout;

if (defined($opt_o)) { $output = $opt_o; }

if (!(defined $opt_v)) {
   open(OUT,">$output") || die "${O}: unable to opend \"$output\": $!\n";
   select(OUT);
} else {
   select(STDOUT); $| = 1;            # unbuffered output
}

print "command line: ", $command_line, "\n"; 

if (defined($opt_htm)) {
   $htmout = $opt_htm;
   open(HTM,">$htmout") || die "${O}: unable to opend \"$htmout\": $!\n";
}
my ($code, $result);
my (@bin, @qclab, @qclab1, @qclab2, @hex, @dec);
my $qcn;
if ($opt_c) { 
   $code = $opt_c; 
   push(@hex,$code);
   push(@qclab,'TEST CODE');
   push(@qclab1,' Y/N');
   push(@qclab2,'  (1/0)');
   $qcn++;
}

if ($opt_r) { 
   $result = $opt_r;
   push(@hex,$result);
   push(@qclab,'TEST RESULT');
   push(@qclab1,' P/F');
   push(@qclab2,'  (0/1)');
   $qcn++;
}
for (my $q = 0; $q < $qcn; $q++)
{
  $bin[$q] = &hextobin($hex[$q]);
  $dec[$q] = unpack("N", pack("H8", substr("0" x 8 . $hex[$q], -8)));
  &interpretqc;
}
if (defined($opt_htm)) {
  close(HTM);
}
exit;

#####
# USAGE OF interpretqc:
# Requires global $qcn = number of interpretable QC groups
# Requires global @qclab = array of labels (srfccode)
# Requires global @bin = array of QC codes as binary strings
# Prints chart with Stage number, Test description, HexChar/Bit, Values=0/1
# One column of values for each interpretable QC group
#
sub interpretqc {
  for (my $q = 0; $q < $qcn; $q++) {
  print "\n    INTERPRETATION OF QC $qclab[$q]: $hex[$q]"; } 
  print "\n";
  print "TEST STAGE  QUALITY CONTROL TEST        BYTE,  ";
  for (my $q = 0; $q < $qcn; $q++) { print $qclab1[$q],'    '; }
  print "\n";
  print "NO.                                     BIT  ";
  for (my $q = 0; $q < $qcn; $q++) { print $qclab2[$q],'  '; }
  print "\n";
  print "--- -----  ---------------------------  ------ ";
  for (my $q = 0; $q < $qcn; $q++) {print "-----";}
  print "\n";
  #
  my @line = ("zero",
  "   1.1   Platform Identification      1,1  1",
  "   1.2   Impossible Date/Time         1,2  2",
  "   1.3   Impossible Location          1,3  3",
  "   1.4   Position on Land             1,4  4",
  "   1.5   Impossible Speed             2,1  5",
  "   1.6   Impossible Sounding          2,2  6",
  "   2.1   Global Impossible Values     2,3  7",
  "   2.2   Regional Impossible Values   2,4  8",
  "   2.3   Increasing Depth             3,1  9",
  "   2.4   Profile Envelope             3,2 10",
  "   2.5   Constant Profile             3,3 11",
  "   2.6   Freezing Point               3,4 12",
  "   2.7   Spike                        4,1 13",
  "   2.8   Top and Bottom Spike         4,2 14",
  "   2.9   Gradient                     4,3 15",
  "   2.10  Density Inversion            4,4 16",
  "   3.1   Levitus Seasonal Statistics  5,1 17",
  "   3.2   Emery and Dewar Climatology  5,2 18",
  "   3.3   Asheville Climatology        5,3 19",
  "   3.4   Levitus Monthly Climatology  5,4 20",
  "   4.1   Waterfall                    6,1 21",
  "   5.1   Cruise Track                 6,2 22",
  "   5.2   Profiles                     6,3 23",
  "   2.11  Bottom                       6,4 24",
  "   2.12  Temperature Inversion        7,1 25",
  "   3.5   Levitus Annual Climatology   7,2 26",
  "   N/A   UNDEFINED                    7,3 27",
  "   N/A   UNDEFINED                    7,4 28",
  "   N/A   UNDEFINED                    8,1 29",
  "   N/A   UNDEFINED                    8,2 30",
  "   N/A   UNDEFINED                    8,3 31",
  "   N/A   UNDEFINED                    8,4 32");
  #0123456789012345678901234567890123456789012345

  # Loop through descriptive lines and test bits
  for (my $ln = 1; $ln <=32; $ln++) {
    my $test_no = sprintf sprintf "%.2d", $ln;
    print $test_no, substr($line[$ln], 0, 41);
    my $bit = substr($line[$ln], 42, 2);
    # Loop through interpretable groups (as binary strings)
    for (my $q = 0; $q < $qcn; $q++) {
      print "     ", substr($bin[$q], 32-$bit, 1);
    }
    print "\n";
  }
  print "--- -----  ---------------------------  ---";
  for (my $q = 0; $q < $qcn; $q++) {print "  -----";}
  if ($opt_c) {
  print "\nY=1: Test Performed  ";
  print "N=0: Test Not Performed\n";
  }
  if ($opt_r) {
  print "\nP=0: Test Passed  ";
  print "F=1: Test Failed\n";
  }

  my @test_names= ("zero",
  "Platform Identification",
  "Impossible Date/Time",
  "Impossible Location",
  "Position on Land ",
  "Impossible Speed",
  "Impossible Sounding",
  "Global Impossible Values",
  "Regional Impossible Values",
  "Increasing Depth",
  "Profile Envelope",
  "Constant Profile",
  "Freezing Point",
  "Spike",
  "Top and Bottom Spike",
  "Gradient",
  "Density Inversion",
  "Levitus Seasonal Statistics",
  "Emery and Dewar Climatology",
  "Asheville Climatology",
  "Levitus Monthly Climatology",
  "Waterfall",
  "Cruise Track",
  "Profiles",
  "Bottom",
  "Temperature Inversion",
  "Levitus Annual Climatology",
  "UNDEFINED",
  "UNDEFINED",
  "UNDEFINED",
  "UNDEFINED",
  "UNDEFINED",
  "UNDEFINED");
if (defined($opt_htm)) {
  my ($byte,$new_byte,$old_byte);
  $old_byte = 9;
  my $bit = 0;
  for (my $q = 0; $q < $qcn; $q++) {
# print "\n    INTERPRETATION OF QC $qclab[$q]: $hex[$q]"; } 
  print HTM '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">',"\n";
  print HTM '<html><body><table border="1"><tbody>',"\n";
  print HTM '<tr><td colspan="5">';
  print HTM 'Interpretation of QC Test ';
  if ($opt_c) {
    print HTM 'Code'; 
  }
  if ($opt_r) {
    print HTM 'Result';
  }
  print HTM ' in Hexadecimal Form:  ',uc(sprintf("%.8x",$hex[$q]));
  print HTM "</td></tr>\n";
  print HTM '<tr><td colspan="5">';
  if ($opt_c) {
    print HTM 'Test Code ';
  } 
  if ($opt_r) {
    print HTM 'Test Result '
  }
  print HTM 'in Decidecimal Form:',$dec[$q];
  print HTM "</td></tr>\n";
  print HTM '<tr><td colspan="5">';
  if ($opt_c) {
    print HTM 'Test Code ';
  }
  if ($opt_r) {
    print HTM 'Test Result ';
  }
  print HTM 'in Binary Form:',$bin[$q];
  print HTM "</td></tr>\n";
  print HTM '<tr><td colspan="5">';
  my $rev_bin = reverse $bin[$q];
  if ($opt_c) { print HTM "Test Code "; }
  if ($opt_r) { print HTM "Test Result "; }
  print HTM "in the Reversed Binary Form:";
  print HTM substr($rev_bin,0,4),' ',substr($rev_bin,4,4),' ',
  substr($rev_bin,8,4),' ',substr($rev_bin,12,4),' ',substr($rev_bin,16,4),' ',
  substr($rev_bin,20,4),' ',substr($rev_bin,24,4),' ',substr($rev_bin,28,4),"\n";
  print HTM "</td></tr>\n";
  print HTM '<tr><td colspan="5">';
  if ($opt_c) {
    print HTM 'Bit: Y=1: Test Performed; '; 
    print HTM 'N=0: Test Not Performed';
  } 
  if ($opt_r) {
    print HTM 'Test Bit: P=1: Test Passed; ';
    print HTM 'F=1: Test Failed';
  }
  print HTM "</td></tr>\n";
  print HTM "<tr><th>";
  print HTM "Test Number";
  print HTM "</td>\n";
  print HTM "<th>Stage Number</td>\n";
  print HTM "<th>Quality Control Test Name</td>\n";
  print HTM "<th>Test Index Number</td>\n";
  if ($opt_c) {
    print HTM "<th>Y/N (1/0)</td></tr>\n";
  }
  if ($opt_r) {
    print HTM "<th>P/F (0/1)</td></tr>\n";
  }
  # Loop through descriptive lines and test bits
    for (my $ln = 1; $ln <=32; $ln++) {
      my $test_no = sprintf sprintf "%.2d", $ln;
      my $index = 2**($ln-1);
#     print HTM $test_no,',',$test_names[$ln],',',$index,',',"\n";
      $byte = floor(($ln-1)/4);
      print HTM "<tr>\n";
      print HTM '<td align="center">',$test_no,'</td>';
      print HTM '<td align="center">',$stage_numbers[$ln],'</td>';
      print HTM '<td>',$test_names[$ln],'</td>';
      print HTM '<td align="right">',$index,'</td>';
      print HTM '<td align="center">',substr($rev_bin,$ln-1,1),'</td>';
#     print HTM $test_no,',',$test_names[$ln],',',$index,',';
#     if ($byte ne $old_byte) {
#       print HTM substr($hex[$q],7-$byte,1),',',$byte+1,',';
#     } else {
#       print HTM ',',$byte+1,',';
#     }
#     if ($bit <=3) {
#        $bit++;
#     } else {
#        $bit = 1;
#     }
#     print HTM $bit,',';
#     print HTM substr($bin[$q], 32-$ln, 1),"\n";
        $old_byte = $byte;
      print HTM "</tr>\n";
    }
  }
  print HTM " </tbody> </table> </body> </html>\n";
}
}

#####
sub hextobin {
  my $hex = $_[0];
  $hex =~ s/^ +//;
  $hex =~ s/ +$//;
  my $bin32 = sprintf("%032b", oct("0x".$hex));
  return $bin32;
}

sub helpMenu
{
print <<EOT;
Usage: $scriptName -v -code QC_Code [| -restult QC_Result] [-o output |-htm output]
       where  
       -v display output to user's screen
       -ccode QC_Code = a eight-byte hexadecimal number of QC test code.
       -result QC_Result = a eight-byte hexadecimal number of QC test result.
       -o output = write output to a file (default = interpretQC.txt)
       -htm output = write output to a HTML file
EOT
   exit(0);
}
