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.
# pod included at end of file
use strict;
use Getopt::Long;
use Pod::Usage qw(pod2usage);
use constant 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 pod2usage(-verbose => 0);
# User asked for help
pod2usage(-verbose => 1) if $option{help};
# Make sure there is at least one input file
pod2usage(-verbose => 0) 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}) {
$ENV{BUFR_TABLES} = DEFAULT_TABLE_PATH;
}
# ECMWF software requires trailing '/' in bufrpath
$ENV{BUFR_TABLES} .= '/' if substr($ENV{BUFR_TABLES},-1) ne '/';
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`;
die if $?; # Reason for bufrdump failing should have been printed to STDERR
# 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;
}
=pod
=head1 SYNOPSIS
bufrdump.pl <bufr file(s)>
[--filter <filter file>]
[--param <parameter file>]
[--lon1 x1]
[--lat1 y1]
[--lon2 x2]
[--lat2 x2]
[--tablepath <path to BUFR tables>]
[--help]
=head1 DESCRIPTION
Extracts BUFR messages from BUFR file(s) and prints section 4 as
"parameter=value" lines. Calls the Fortran program bufrdump
internally, so this program must be installed at the location set in
variable $BUFRDUMP in source code.
Execute without arguments for Usage, with option C<--help> for some
additional info. See also L</https://wiki.met.no/bufr.pm/start> for
examples of use.
=head1 OPTIONS
--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
Options may be abbreviated, e.g. --h for --help.
To avoid having to use the C<--tablepath> option, you are adviced to
set the invironment variable BUFR_TABLES to the directory where your
BUFR tables are located (unless the default path provided by
bufrdump.pl works for you).
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.
Another example: the simple filter file (starting with a blank line!)
wmonr > 0
will print only those observations containing a wmonr (skipping
ships).
=head1 AUTHOR
Pål Sannes E<lt>pal.sannes@met.noE<gt>
=head1 COPYRIGHT
Copyright (C) 2010 met.no
=cut