This is an old revision of the document!

#!/usr/bin/perl -w

# (C) Copyright 2010, met.no
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301, USA.

# Extract BUFR messages from bufr file(s) using the Fortran program
# bufrdump and print the data as 'parameter=value' lines. See
# usage_verbose for explanation of the options allowed.

# Author: P. Sannes met.no 2010

use strict;
use Getopt::Long;

my $DEFAULT_TABLE_PATH = '/usr/local/lib/bufrtables';
my $BUFRDUMP = '/metno/local/bin/bufrdump';

# Parse command line options
my %option = ();

GetOptions(
           \%option,
           'help',
           'tablepath=s', # Set BUFR table path
           'filter=s',    # Decode observations meeting criteria in <filter file> only
           'param=s',     # Decode the parameters in <parameter file> only
           'lon1=i',
           'lat1=i',
           'lon2=i',
           'lat2=i',
       ) or die "Wrong option(s), execute $0 without arguments for Usage\n";

# User asked for help
usage_verbose() if $option{help};

# Make sure there is at least one input file
usage() unless @ARGV;

# Prevent ECMWF software from printing table info
$ENV{PRINT_TABLE_NAMES} = 'false';

# Set BUFR table path environment variable used by bufrdump
if ($option{tablepath}) {
    # Command line option --tablepath overrides all
    $ENV{BUFR_TABLES} = $option{tablepath};
} elsif (!$ENV{BUFR_TABLES}) {
    # Use the libemos bufrtables
    $ENV{BUFR_TABLES} = $DEFAULT_TABLE_PATH;
}

my $filter = $option{filter} ? "--filter $option{filter}" : '';
my $lon1 = $option{lon1} ? "--lon1 $option{lon1}" : '';
my $lat1 = $option{lat1} ? "--lat1 $option{lat1}" : '';
my $lon2 = $option{lon2} ? "--lon2 $option{lon2}" : '';
my $lat2 = $option{lat2} ? "--lat2 $option{lat2}" : '';

my $criteria_ref = [];
if ($filter) {
    $criteria_ref = read_filter_file($option{filter})
}

my $forced_params_ref;
my $params_ref;
if ($option{param}) {
    ($forced_params_ref, $params_ref)
        = read_param_file($option{param});
}

# Loop for processing of BUFR input files
foreach my $inputfname (@ARGV) {

    # Dump the content of the BUFR file using the Fortran program $BUFRDUMP
    my $dump = `$BUFRDUMP $filter $lon1 $lat1 $lon2 $lat2 $inputfname`;

    # Then process the output from the dump
    my @lines = split /\n/, $dump;

    if (!$option{param} && !@$criteria_ref) {
        # Same output as from bufrdump, except that spaces after '=' are removed
        foreach my $line (@lines) {
            $line =~ s/=\s+/=/;
            print $line, "\n";
        }
    } else { # Options has been used which the Fortran program doesn't
             # handle, so special massaging is necessary

        # Skip first(blank) line
        shift @lines;

        my @lines_to_print;
        my %message; # Hash with parameter name as key, parameter value as value

      LINE:while (defined(my $line = shift @lines)) {
            # Each new message starts with a blank line
            if ($line !~ /^\s*$/) {
                # Build up the message to be (possibly) printed
                push @lines_to_print, $line;
                my ($name, $value) = ($line =~ /^(.+)=\s*(.*)$/);
                $message{$name} = $value;
            }

            if ($line =~ /^\s*$/ or @lines == 0) {
                # A full message has been completed. Should it be printed?
                if ($filter && filter_obs(\%message, $criteria_ref)) {
                    # Skip this message
                    @lines_to_print = ();
                    %message = ();
                    next LINE;
                }
                # Print the message
                print "\n";
                if ($option{param}) {
                    # Print the params in @$params_ref if exists in
                    # message, in same order as in @$params_ref
                    foreach my $name (@$params_ref) {
                        if (exists $message{$name}) {
                            print "$name=$message{$name}\n";
                        } elsif ($forced_params_ref->{$name}) {
                            print "$name=-32767\n";
                        }
                    }
                } else {
                    foreach my $line2 (@lines_to_print) {
                        $line2 =~ s/=\s+/=/;
                        print $line2, "\n";
                    }
                }
                @lines_to_print = ();
                %message = ();
            }
        }
    }
}


sub read_param_file {
    my $parameter_file = shift;

    open my $PARAM, '<', $parameter_file
        or die "Cannot open $parameter_file: $!";

    my %forced_params;
    my @params;
    while (my $name = <$PARAM>) {
        chomp $name;
        if ($name =~ /^!/) {
            $name = substr $name, 1;
            $forced_params{$name} = 1;
        }
        push @params, $name;
    }
    close $PARAM or die "Cannot close $parameter_file: $!";

    return \%forced_params, \@params;
}

sub read_filter_file {
    my $filter_file = shift;
    my @allowed_operators =
        ('=',
         '<',
         '<=',
         '>',
         '>=',
         '!=',
     );
    my @criteria;

    open my $FILTER, '<', $filter_file
        or die "Cannot open $filter_file: $!";
    # Skip the criteria meant for Fortran parsing, i.e. proceed to
    # first line following a blank line
    while (<$FILTER>) {
        last if $_ =~ /^\s*$/;
    }

    # Read the filter criteria meant for Perl parsing, skipping blank
    # lines and comment lines
    if (not eof) {
        while (my $line = <$FILTER>) {
            push @criteria, $line
                if $line !~ /^\s*$/ && $line !~ /^\s*#/;
        }
    }

    # Check that the criteria are properly formatted
    foreach my $criterium (@criteria) {
        my $op = (split / +/, $criterium)[1];
        if (!defined($op) or not grep(/^$op$/, @allowed_operators) ) {
            print "Error in $filter_file, line $. is badly formatted:\n$criterium";
            exit 1;
        }
    }
    return \@criteria;
}

# Return true (1) if observation is to be filtered, i.e. does not
# comply with at least one of the <param> <operator> <value> filter
# criteria in filter file
sub filter_obs {
    my $message_ref = shift;
    my $criteria_ref = shift;

    my @ascii_params = qw(DDDD icao_id name obstime type);

    foreach my $criterium (@$criteria_ref) {
        my ($f_param, $f_operator, $f_value) = split / +/, $criterium, 3;
        chomp $f_value;
        if ($f_operator eq '=') {
            return 1 unless exists $message_ref->{$f_param};
            if (grep {$_ eq $f_param} @ascii_params) {
                $message_ref->{$f_param} =~ s/\s*$//;
                return 1 unless $message_ref->{$f_param} eq $f_value;
            } else {
                return 1 unless $message_ref->{$f_param} == $f_value;
            }
        } elsif ($f_operator eq '<') {
            return 1 unless (exists $message_ref->{$f_param}
                             and $message_ref->{$f_param} < $f_value);
        } elsif ($f_operator eq '<=') {
            return 1 unless (exists $message_ref->{$f_param}
                             and $message_ref->{$f_param} <= $f_value);
        } elsif ($f_operator eq '>') {
            return 1 unless (exists $message_ref->{$f_param}
                             and $message_ref->{$f_param} > $f_value);
        } elsif ($f_operator eq '>=') {
            return 1 unless (exists $message_ref->{$f_param}
                             and $message_ref->{$f_param} >= $f_value);
        } elsif ($f_operator eq '!=') {
            return 1 unless exists $message_ref->{$f_param};
            if (grep {$_ eq $f_param} @ascii_params) {
                $message_ref->{$f_param} =~ s/\s*$//;
                return 1 unless $message_ref->{$f_param} ne $f_value;
            } else {
                return 1 unless $message_ref->{$f_param} != $f_value;
            }
        }
    }

    # All filter conditions have been fullfilled
    return 0;
}

sub usage {
    print <<"EOF";
Usage: $0 <bufr file(s)>
        [--filter <filter file>]
        [--param <parameter file>]
        [--lon1 x1]
        [--lat1 y1]
        [--lon2 x2]
        [--lat2 x2]
        [--tablepath <path to BUFR tables>]
        [--help]
EOF
    exit 0;
}

sub usage_verbose {
    print <<"EOF";

Usage: $0 <bufr file(s)> [options]

Will print section 4 in BUFR messages in <bufr file(s)> as "parameter=value" lines.

Options (may be abbreviated, e.g. --h for --help) are:

        --filter <filter file>
                        Decode observations meeting criteria in <filter file> only
        --param <parameter file>
                        Print parameters in <parameter file> only, in same order
                        as they occur in <parameter file>
        --lon1 x1       Decode observations with longitude >= x1 only
        --lat1 y1       Decode observations with latitude >= y1 only
        --lon2 x2       Decode observations with longitude <= x2 only
        --lat2 y2       Decode observations with latitude <= y2 only
                        x1,y1,x2,y2 should be decimal degrees
        --tablepath <path to BUFR tables>
                        Set path to BUFR tables (overrides ENV{BUFR_TABLES})
        --help          Print this Usage


You should probably set
        export BUFR_TABLES=$DEFAULT_TABLE_PATH
or use the --tablepath option.

The lines in <parameter file> should be name of the parameters you
want to be printed. For example, if you want only station
identification and temperature to be printed for a BUFR SYNOP file,
the <parameter file> should look like this:

wmonr
DDDD
TA

If you want "parameter=value" to be printed also when value is missing
in BUFR message, precede the parameter name with an exclamation mark
(e.g. '!TA').  Missing values will then be displayed as -32767.

Using --filter will decode only those observations that meet at least
one of the BUFR descriptor criteria and all of the parameter criteria
in <filter file>, where the BUFR descriptor criteria should come first
in filter file followed by a blank line, then comes the parameter
criteria which should match <param> <operator> <value> where operator
is one of =, !=, <, <=, > and >=. An example filter file is

D: 001001 I2.2
01
D: 001001 I2.2 001002 I3.3
03 895
06 252
D: 001011 A9
LDWR

NN != 0
TA >= 5
TA < 9.5

which decodes all observations with block number 01, two other
specific wmo stations and one specific ship, having cloud cover
different from 0 (but NN must be part of the message) and temperature
between 5 and 9.5 degrees Celsius. Comment lines starting with #
will be ignored.

EOF
    exit 0;
}