package GTSPP::proc;

BEGIN
{
   use Exporter();
   @ISA = qw(Exporter);
   @EXPORT = qw(&ident_probe);
   $VERSION = 1.1;
}

sub ident_probe( )
{
   my $stn = shift;
   my $dbh = shift;
   
   my %hash = ( );
   %hash = (
      '001'=>1, '002'=>0, '011'=>0, '021'=>0, '031'=>1, '032'=>0, 
      '041'=>1, '042'=>0, '051'=>1, '052'=>0, '061'=>0, '071'=>0, 
      '201'=>1, '202'=>0, '211'=>1, '212'=>0, '221'=>1, '222'=>0,
      '231'=>0, '241'=>0, '251'=>1, '252'=>0, '261'=>0, '401'=>0, 
      '411'=>0, '421'=>0, '431'=>0, '441'=>0, '451'=>0, '461'=>1, 
      '462'=>0, '471'=>0, '481'=>0, '491'=>0, '501'=>0, '700'=>0, 
      '710'=>0, '720'=>0, '730'=>0, '741'=>0, '751'=>0, '761'=>0, 
      '800'=>0, '810'=>0, '820'=>0, '830'=>0, '831'=>0, '840'=>0, 
      '841'=>0, '842'=>0, '845'=>0, '846'=>0, '847'=>0, '850'=>0, 
      '851'=>0, '852'=>0 
   );

#
# define a status flag, $dpcFlag, for depth correction
#     $dpcFlag = 0: no depth correction
#     $dpcFlag = 1: depth correction done
   my $dpcFlag = 0; # don't need correction
#
# define the value, $dpcParm, of the surface code "DPC$"
#     $dpcParm = '01': known probe type, needs depth correction
#     $dpcParm = '02': known probe type, doesn't need depth correction
#     $dpcParm = '03': unknown probe type, no depth correction done
#     $dpcParm = '04': known probe type, depth correction done
#     $dpcParm = '05': unknown probe type, depth correction done
   my $dpcParm='03'; #default value, unknown probe type, no correction
                 
   my ($seq,$srfcCode,$srfcParm,$srfcQParm);
   my ($peqParm,$pfrParm,$prtParm);
   my $sql = "SELECT * FROM surfaceCodes WHERE station=$stn";
   my $sth = $dbh->prepare($sql); $sth->execute();
#
# perform the following test for every stations
#
      my $peqFlag = 0;
      my $pfrFlag = 0;
      my $prtFlag = 0;
      my $numProbeIDs = 0;
   while (my @array_ = $sth->fetchrow)
   {
      ($seq,$srfcCode,$srfcParm,$srfcQParm)=@array_[1..4];
      $_ = $srfcCode;
      SWITCH: {
         /PEQ\$/ && do {
         $numProbeIDs += 1;
         my $oldCode=$srfcParm;
         $oldCode =~ s/ //g;
         my $newCode='0'x3;
#
#Right Justified
#
         substr($newCode,-length($oldCode),length($oldCode))=$oldCode;
         $peqParm = $newCode;
         $peqFlag = $hash{$peqParm};
         last SWITCH;
         };

         /PFR\$/ && do {
         $pfrParm = substr($srfcParm,0,3);
         $numProbeIDs += 2;
         if ($pfrParm eq '001' || $pfrParm eq '031' || $pfrParm eq '041' 
          || $pfrParm eq '051' || $pfrParm eq '201' || $pfrParm eq '211' 
          || $pfrParm eq '221' || $pfrParm eq '251' || $pfrParm eq '461'){
            $pfrFlag = 1;}
            last SWITCH;
         };

         /PRT\$/ && do {
         $numProbeIDs += 4;
         $prtParm = $srfcParm;
         if ($prtParm =~ /UNKN/ || $prtParm =~ /\/\/\//){$prtFlag = 0;}
         if ($prtParm =~ /Deep Blue/i || $prtParm =~ /DB/i 
            || $prtParm =~ /T-04/ || $prtParm =~ /T-06/ 
            || $prtParm =~ /T-07/ || $prtParm =~ /T-4/ 
            || $prtParm =~ /T-6/ || $prtParm =~ /T-7/){
            $prtFlag = 1;}
            last SWITCH;
         };
      } #end of SWITCH: {
#
# determine the values of $dpcFlag and $dpcParm
#
# 
# No probe type information found 
#
      if ($numProbeIDs == 0) {
         $dpcParm='03'; $dpcFlag=0;
      } elsif ($numProbeIDs == 1) {
         $dpcFlag=0; $dpcParm='02';
         if($peqFlag){$dpcFlag=1; $dpcParm='04';}
      } elsif ($numProbeIDs == 2) {
         $dpcFlag=0; $dpcParm='02';
         if($pfrFlag){$dpcFlag=1; $dpcParm='04';}
         if($pfrParm =~ /\/\/\//){$dpcParm='03';}
      } elsif ($numProbeIDs == 3) {
         if($peqFlag == 1 && $pfrFlag == 1){$dpcFlag=1; $dpcParm='04';}
      } elsif ($numProbeIDs == 4) {
         $dpcFlag=0; $dpcParm='02';
         if($prtFlag){$dpcFlag=1; $dpcParm='04';}
         else {$dpcFlag=0; $dpcParm='02';}
      } elsif ($numProbeIDs == 5) {
         $dpcFlag=0; $dpcParm='02';
         if($peqFlag == 1 && $prtFlag == 1){$dpcFlag=1; $dpcParm='04';}
      } elsif ($numProbeIDs == 6) {
         $dpcFlag=0; $dpcParm='02';
         if($pfrFlag == 1 && $prtFlag == 1){$dpcFlag=1; $dpcParm='04';}
      } else {
         $dpcFlag=0; $dpcParm='02';
         if($peqFlag == 1 && $pfrFlag == 1 && $prtFlag == 1){
            $dpcFlag=1; $dpcParm='04';}
      }
#     print "$numProbeIDs,$peqFlag,$pfrFlag,$prtFlag,$dpcParm,$dpcFlag\n";

   } #end of while (my @array = $sth->fetchrow)
return $peqParm,$pfrParm,$prtParm,$dpcFlag,$dpcParm,$numProbeIDs;
}

return 1;
END { }