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}) { # 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`; 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