#!/bin/perl -w

# Script to decode (very partially) a BUOY (ZZYY) report
# For possible convenience, the return list is the same as for
# a SYNOP, even though many will be nulls.
# Only decode the initial and first sections. The others relate
# to stuff that doesn't fit easily into our current formats.
#
# Note that a null is returned if some serious error occurs.
#
# WMC: 07/97 - original
#
# This script comes with no warranty of its fitness for any purpose.
# In fact, I guarantee that there are bugs in it somewhere.
# Use it non-commercially as you will; but don't come back and complain about problems.
#
# - W. M. Connolley July 1997.

require "guess_mon_year.pl";

sub decode_buoy {
  my(@GROUPS)=split(' ',$_[0]);
  my($TYPE,$NAME,$YEAR,$MON,$DAY,$HOUR,$LA,$Q,$LO,$T,$TOTAL_CLOUD,$DIR,$SPD,$IW,%IWs,$ICE,$DEWT,$PSTA);
  my($PTND,$PTND_code,$PTND_value,$PPN,$PPN_code,$PPN_value);
  my($H,$Ir,$Ix,$CLOUD_H,$VV);
  my($WW,$W1,$W2,$WEATHER);
  my($NH,$CL,$CM,$CH,$CLOUD);
  my($V,@VALUES);
# Added for Buoys:
  my($QC,$Qd,$Qx,$YEAR1,$MON1);
  
# Get type - ZZYY. Return null if not.
  $TYPE=shift @GROUPS;
  if ($TYPE !~ /^(ZZYY)$/) { if ($DEBUG) { print " * [decode_buoy] reject: wrong TYPE\n"}; return '' };

# Get identifier
  if (length($GROUPS[0]) != 5) { if ($DEBUG) { print " * [decode_buoy] reject: id ($GROUPS[0]) length != 5\n"}; return '' };
  $NAME=shift @GROUPS;

# Get date (day, month and digit of year)
  if (length($GROUPS[0]) != 5) { if ($DEBUG) { print " * [decode_buoy] reject: ddmmy group length != 5\n"}; return '' };
  $DAY=substr($GROUPS[0],0,2);
  $MON=substr($GROUPS[0],2,2);
  $YEAR=substr(shift @GROUPS,4,1);

# Get hour, minute and wind indicator. We don't care about the minute.
  if (length($GROUPS[0]) != 5) { if ($DEBUG) { print " * [decode_buoy] reject: hhmmw group length != 5\n"}; return '' };
  $IW=substr($GROUPS[0],4,1);
  $HOUR=substr($GROUPS[0],0,2);
  $MIN=substr(shift @GROUPS,2,2);
  %IWs=(0, "m/s -> kts (estimated)", 1, "m/s -> kts (anemometer)", 3, "kts (estimated)", 4, "kts (anemometer)");
  $IW=$IWs{$IW};

# Now guess the year and month, based on the current date. These should tally with what we know
# (unless of course we are decoding an old archived message...).
  ($MON1,$YEAR1)=guess_mon_year($DAY);
  if ($MON1 != $MON) { warn "oh dear: month is odd: $MON, $MON1: going with the one from the message ($MON), full message: <$_[0]>" };
  if ($YEAR1 % 10 != $YEAR) { warn "oh dear: year digit is odd: $YEAR, $YEAR1: going with the one from the message ($YEAR)" };
#  $YEAR+=90;   /11/02/2000
  $YEAR=$YEAR1;
  if ($MON < 1 or $MON > 12) { if ($DEBUG) { print " * [decode_buoy] reject $NAME: month junk: $MON\n" }; return '' };

# Only get lat (from lat in 1000's and quadrant)
  if (length($GROUPS[0]) != 6) { if ($DEBUG) { print " * [decode_buoy] reject $NAME: qlllll group length != 6... ($GROUPS[0])\n"}; return '' };
  $QC=substr($GROUPS[0],0,1);
  $LA=substr(shift @GROUPS,1,5)/1000;
  if ($QC==3 or $QC==5) { $LA=-$LA };
 
# Get longitude.
  if (length($GROUPS[0]) != 6) { if ($DEBUG) { print " * [decode_buoy] reject $NAME: llllll group length != 6... ($GROUPS[0])\n"}; return '' };
  $LO=(shift @GROUPS)/1000.;
  if ($QC==5 or $QC==7) {$LO=-$LO};

# Get 6 QI Qt / / group
  if (length($GROUPS[0]) != 5 or substr($GROUPS[0],0,1)!=6) { if ($DEBUG) { print " * [decode_buoy] reject $NAME: 6qiqt// group ($GROUPS[0])... \n"}; return '' };
# Insist position quality is "unchecked" (=0) or "good" (=1). Most are 1's.
# There are a few 3's (bad). See code table 3334.
  if (substr($GROUPS[0],1,1)>1) { if ($DEBUG) { print " * [decode_buoy] reject $NAME: position quality not ok ($GROUPS[0])... " }; return '' };
# Ditto from time (same code table)
  if (substr($GROUPS[0],2,1)>1) { if ($DEBUG) { print " * [decode_buoy] reject $NAME: time quality not ok ($GROUPS[0])... " }; return '' };

# 111QdQx
# regulations for QdQx are a touch complex (18.3.3). 
# So, lets just check Qd for being 1 - that should serve for now.
# This may throw away a bit of data but not much.
  ($GROUP_ID,$Qd,$Qx)=(shift(@GROUPS) =~ /(...)(.)(.)/);
# Rest of section 1 is decoded but will be thrown away if Qd != 1

# This stuff (down to 5appp) is ripped straight from decode_synop.pl
#
# 0ddff [is Nddff in SYNOP]
#
# Wind group. Note conversion to kts if in m/s based on IW (30/4/97)
#

  ($GROUP_ID,$DIR,$SPD)=(shift(@GROUPS) =~ /(.)(..)(..)/);
  if ($DIR == 990) {undef $DIR};
  if ($DIR > 360) {$DIR.=" (really???)"};
  $SPD=substr(shift @GROUPS,3,2);
  if ($SPD !~ /\d{2}/) {undef $SPD};
  if ($IW =~ /m\/s/) {$SPD=int($SPD*10/0.5148+0.5)/10.}

# 1sTTT
#
# Get temperature (checking leading digit is a 1)
#
  ($GROUP_ID,$S,$T)=(shift(@GROUPS) =~ /(.)(.)(...)/);
  if ($GROUP_ID eq "1") {
    if ($T =~ /\d{3}/ and $S =~ /0|1/) {
      $T=$T/10.;
      if ($S) { $T=-$T } 
    } else {
      undef $T 
    }
  } else {
    unshift(@GROUPS,$GROUP_ID.$S.$T); undef $T
  };

# 2sTTT
#
# Get dew temperature (checking leading digit is a 2. If it isn't, return it to the list)
#
  ($GROUP_ID,$S,$DEWT)=(shift(@GROUPS) =~ /(.)(.)(...)/);
  if ($GROUP_ID eq "2") {
    if ($DEWT =~ /\d{3}/ and $S =~ /0|1/) { 
      $DEWT=$DEWT/10.;
      if ($S) { $DEWT=-$DEWT } 
    } else {
      undef $DEWT
    }
  } else {
    unshift(@GROUPS,$GROUP_ID.$S.$DEWT); undef $DEWT 
  };

# 3PPPP
#
# Get station pressure group (checking leading digit is a 3. If it isn't, return it to the list)
#
  $PSTA=shift @GROUPS;
  if (substr($PSTA,0,1) eq "3") { $PSTA=substr($PSTA,1,4)/10.; if ($PSTA<400) { $PSTA+=1000 } }
  else { unshift(@GROUPS,$PSTA); undef $PSTA };

# 4PPPP
#
# Get MSLP pressure group (4) (checking leading digit is a 4. If it isn't, return it to the list)
#
  $PRED=shift @GROUPS;
  if (substr($PRED,0,1) eq "4") {
    $PRED=substr($PRED,1,4);
    if ($PRED !~ /\d{4}/) {
      undef $PRED
    } else {
      $PRED/=10.;
      if ($PRED<400) { $PRED+=1000 } 
    }
  } else { 
    unshift(@GROUPS,$PRED); undef $PRED 
  };

# 5aPPP
#
# Get P tendency group (5)
#
  $PTND=shift @GROUPS;
  if (substr($PTND,0,1) eq "5") { 
    $PTND_code=substr($PTND,1,1)." (code table 200)";
    $PTND_value=substr($PTND,2,3);
    if ($PTND_value !~ /\//) {$PTND_value/=10.};
  } else { unshift(@GROUPS,$PTND); undef $PTND };

# Throw away section 1 if Qd is not 1 (OK)
  if ($Qd != 1) { undef $DIR,$SPD,$IW,$T,$DEWT,$PSTA,$PRED,$PTND_code,$PTND_value };

# Return
if ($DEBUG) { print " * [decode_buoy] Accept: $NAME $YEAR,$MON,$DAY,$HOUR,$LA,$LO\n" };
@VALUES=($NAME,$YEAR,$MON,$DAY,$HOUR,$LA,$LO,$T,$DIR,$SPD,$IW,$TOTAL_CLOUD,$ICE,$DEWT,$PSTA,$PRED,$PTND_code,$PTND_value,$PPN_code,$PPN_value,$ST_TYPE,$WW,$W1,$W2,$NH,$CL,$CM,$CH,$CLOUD_H);
foreach $V (@VALUES) { if ( ($V=~/^\/+$/) or (!$V and $V !~ /0/) ) { $V="null" } };
return @VALUES

};

1;