#!/usr/bin/perl -w
#
# gtsheaders_bufr.pl
#
# Convert BUFR messages into GTS bulletins.
#
# This version can optionally add the 19-byte WMO/GTS
# Flag Field Separator (FFS), Option #2:
# https://www.weather.gov/tg/fstandrd

#   ****LLLLLLLLLL****<LF>
#
# where LLLLLLLLLL is the 10-digit decimal length of the
# complete bulletin following the FFS.
#
# Example:
#
#   ****0000017473****
#   IUTJ14 KWSP 292359<CR><CR><LF>
#   BUFR...
#
# For STAR generated Spire, PlanetiQ, and COSMIC-2
#  GNOME-5 IUTM14 KWSP
#  GNOMS-4 IUTN14 KWSP
#  YAM-8   IUTO14 KWSP
#  Spire   IUTM14 KWSS
#  COSMIC2 IUTM14 KWBC 
##############################################################################

use strict;
use Getopt::Long;

sub usage
{
  print <<"END-OF-USAGE";
usage: gtsheaders_bufr.pl [--ffs] [--iph] [--noincrement] infile outfile T1T2A1A2[ii] CCCC [YYGGgg]

  where T1T2A1A2 is the product identifier (excluding sequence number)
     For RO data T1=I, T2=U or E, A1=T or G, A2=[A-L] or X
     and ii=14 or 01

  CCCC is the originating centre (ICAO location indicator)

  YYGGgg is optional day-of-month hour minute
     (otherwise uses Section 1 time)

  --ffs          Add the 19-byte WMO/GTS Flag Field Separator,
                 Option #2, before each bulletin.

  --iph          Include an Internet Protocol Header in the BUFR file.

  --noincrement  Do not increment the sequence number.

END-OF-USAGE

  exit 0;
}


##############################################################################
# Options
##############################################################################

my $ffs = 0;
my $iph = '';
my $noincrement = 0;

GetOptions (
    'ffs'         => \$ffs,
    'noincrement' => \$noincrement,
    'iph'         => \$iph
);


##############################################################################
# Variables
##############################################################################

my ($line, $len, $message, $messlen, $messlen4);
my ($outlen, $startline, $seq);
my ($char1, $char2, $char3);
my ($len1, $len2, $len3);
my ($line1);

my $recordcount = 0;
my $seqcount = 0;
my $startseq = 1;

my $lastddhhmn = "999999";
my $ddhhmn;


##############################################################################
# Read arguments
##############################################################################

my ($infile, $outfile, $t1t2a1a2, $cccc, $ddhhmn_arg) = @ARGV;

usage if (!defined $cccc);


##############################################################################
# YYGGgg
##############################################################################

if ($ddhhmn_arg) {
    $ddhhmn = $ddhhmn_arg;
}
else {
    $ddhhmn = "999999";
}


##############################################################################
# Check T1T2A1A2 and optional ii
##############################################################################

if (length($t1t2a1a2) == 6) {

    $startseq = substr($t1t2a1a2, 4, 2);
    $t1t2a1a2 = substr($t1t2a1a2, 0, 4);
}

die "Error: length of T1T2A1A2 is not 4 bytes\n"
    if (length($t1t2a1a2) != 4);

die "Error: length of CCCC is not 4 bytes\n"
    if (length($cccc) != 4);


##############################################################################
# Construct the WMO abbreviated heading
#
#   T1T2A1A2ii CCCC YYGGgg<CR><CR><LF>
#
# Example:
#
#   IUTJ14 KWSP 292359<CR><CR><LF>
#
# Length:
#
#   6 + 1 + 4 + 1 + 6 + 3 = 21 bytes
##############################################################################

my $header = $t1t2a1a2;
my $header2 = " " . $cccc . " " . $ddhhmn . "\015\015\012";


##############################################################################
# End of message
#
#   <CR><CR><LF><ETX>
#
# = 4 bytes
##############################################################################

my $endmess = "\015\015\012\003";
my $endmesslen = length($endmess);


##############################################################################
# Read BUFR records
##############################################################################

$/ = "BUFR";


open (IN, $infile) ||
    die "can't open $infile\n";

open (OUT, '>', $outfile) ||
    die "can't create $outfile\n";


# Go to start of first message
$line = <IN>;


##############################################################################
# Process each BUFR message
##############################################################################

while ($line = <IN>)
{
    ##########################################################################
    # Get the actual BUFR message length from Section 0
    #
    # First 3 bytes after "BUFR" contain the total BUFR message length.
    ##########################################################################

    $char1 = substr($line, 0, 1);
    $char2 = substr($line, 1, 1);
    $char3 = substr($line, 2, 1);

    ($len1, $len2, $len3) =
        (ord($char1), ord($char2), ord($char3));

    $messlen =
          ord($char1) * 65536
        + ord($char2) * 256
        + ord($char3);

    # BUFR length includes the four-byte "BUFR" identifier
    $messlen4 = $messlen - 4;


    ##########################################################################
    # Extract complete BUFR message
    #
    # Continue reading if another "BUFR" occurs inside the record.
    ##########################################################################

    $len = length($line);

    while ($len < $messlen4)
    {
        die "end of file\n" if (not $line1 = <IN>);

        print "Warning: found embedded \"BUFR\", file could be corrupt\n";
        print "  current message length $len, expect $messlen4\n";

        $line = $line . $line1;
        $len = length($line);
    }

    $message = "BUFR" . substr($line, 0, $messlen4);


    ##########################################################################
    # Get Edition and Section 1 date if YYGGgg was not specified
    ##########################################################################

    if (!$ddhhmn_arg) {

        my $edition = ord(substr($message, 7, 1));

        my ($dayofmonth, $hour, $minute);

        if ($edition == 4) {

            $dayofmonth = ord(substr($message, 26, 1));
            $hour       = ord(substr($message, 27, 1));
            $minute     = ord(substr($message, 28, 1));

        }
        else {

            $dayofmonth = ord(substr($message, 22, 1));
            $hour       = ord(substr($message, 23, 1));
            $minute     = ord(substr($message, 24, 1));
        }

        $ddhhmn = sprintf(
            "%2.2d%2.2d%2.2d",
            $dayofmonth,
            $hour,
            $minute
        );

        $header2 = " " . $cccc . " " . $ddhhmn . "\015\015\012";
    }


    ##########################################################################
    # Increment sequence number
    ##########################################################################

    if ($noincrement || ($ddhhmn != $lastddhhmn)) {

        $seqcount = $startseq;
        $lastddhhmn = $ddhhmn;
    }

    $seq = sprintf("%2.2d", $seqcount);

    $recordcount++;

    $seqcount++;

    $seqcount = 1 if ($seqcount > 99);


    ##########################################################################
    # Construct the WMO/GTS heading
    #
    # The sequence number "ii" is inserted between T1T2A1A2 and CCCC.
    #
    # Example:
    #
    #   IUTJ + 14 + " " + KWSP + " " + 292359 + CR CR LF
    #
    ##########################################################################

    my $wmo_header =
          $header
        . $seq
        . $header2;


    ##########################################################################
    # Construct the complete bulletin
    #
    # IMPORTANT:
    #
    # The FFS length is the length of the COMPLETE BULLETIN after
    # the 19-byte FFS itself.
    #
    # Therefore:
    #
    #   bulletin =
    #       WMO header
    #       + BUFR message
    #    
    #   don't add   + end-of-message, UCAR BUFR data end of '7777' not <CR><CR><LF><ETX>
    #
    ##########################################################################

    my $bulletin =
          $wmo_header
        . $message ;
    #     . $endmess;  0d 0d 0a 03  "\015\015\012\003";


    ##########################################################################
    # Calculate bulletin length
    #
    # This is the number placed in:
    #
    #   ****LLLLLLLLLL****
    #
    ##########################################################################

    my $bulletin_len = length($bulletin);


    ##########################################################################
    # Check that the length fits in the 10-digit FFS field
    ##########################################################################

    die "Error: bulletin too long for 10-digit FFS length field\n"
        if ($bulletin_len > 9999999999);


    ##########################################################################
    # Construct 19-byte Option #2 FFS
    #
    # Format:
    #
    #   ****LLLLLLLLLL****<LF>
    #
    # Example:
    #
    #   ****0000017473****\n
    #
    # Length:
    #
    #   4 + 10 + 4 + 1 = 19 bytes
    ##########################################################################

    my $ffs_header =
          "****"
        . sprintf("%010d", $bulletin_len)
        . "****"
        . "\012";


    die "Internal error: FFS header is not 19 bytes\n"
        if (length($ffs_header) != 19);


    ##########################################################################
    # Write output
    ##########################################################################

    if ($ffs) {

        print "Adding 19-byte WMO/GTS FFS header\n";

        print OUT
            $ffs_header
            . $bulletin;

    }
    else {

        print "Adding WMO/GTS header\n";

        print OUT
            $bulletin;
    }
}


##############################################################################
# No BUFR records?
##############################################################################

if ($recordcount == 0) {

    print "Warning: no BUFR records found in $infile\n";
}


close (IN);
close (OUT);