bufr.pm:bufrdump.pl_source

Differences

This shows you the differences between two versions of the page.

Link to this comparison view

Both sides previous revision Previous revision
Next revision 		Previous revision
bufr.pm:bufrdump.pl_source [2010-10-06 07:25:13]
pals 		bufr.pm:bufrdump.pl_source [2022-05-31 09:29:31] (current)
Line 1: Line 1:
-<code>+<code perl bufrdump.pl>
 #!/usr/bin/perl -w #!/usr/bin/perl -w
  
Line 26: Line 26:
  
 use constant DEFAULT_TABLE_PATH => '/usr/local/lib/bufrtables'; use constant DEFAULT_TABLE_PATH => '/usr/local/lib/bufrtables';
-my $BUFRDUMP = '/metno/local/bin/bufrdump';+my $BUFRDUMP = 'bufrdump'; # You should add path if bufrdump is 
 +                           # installed in a non-standard place
  
 # Parse command line options # Parse command line options
Line 34: Line 35:
            'help',            'help',
            'tablepath=s', # Set BUFR table path            'tablepath=s', # Set BUFR table path
-           'filter=s',    # Decode observations meeting criteria in <filter file> only +           'filter=s',    # Decode observations meeting the filter criteria specified only 
-           'param=s',     # Decode the parameters in <parameter file> only+           'param=s',     # Decode/print specified parameters only
            'csv',         # Use CSV format for printing            'csv',         # Use CSV format for printing
-           'sort',        # Sort on stationid (wmonr/call_sign/buoy_id)+           'delimiter=s', # Choose the delimiter for the CSV format 
 +           'sort',        # Sort on stationid (wmonr/nationalnr/call_sign/buoy_id/aircraft/icao_id/wigosid)
            'sort_on=s',   # Sort on specified parameter            'sort_on=s',   # Sort on specified parameter
 +           'station=s',   # Filter on list of stations
            'transform=s', # Do the transformations in <transformation file>            'transform=s', # Do the transformations in <transformation file>
            'lon1=i',            'lon1=i',
Line 44: Line 47:
            'lon2=i',            'lon2=i',
            'lat2=i',            'lat2=i',
 +           'obstype=s',   # Force observation type
        ) or pod2usage(-verbose => 0);        ) or pod2usage(-verbose => 0);
  
Line 54: Line 58:
 # --csv can only be used together with --param # --csv can only be used together with --param
 pod2usage(-verbose => 0) if $option{csv} && !$option{param}; pod2usage(-verbose => 0) if $option{csv} && !$option{param};
- 
-# --sort and --sort_on are exclusive 
-pod2usage(-verbose => 0) if $option{sort} && $option{sort_on}; 
  
 # Prevent ECMWF software from printing table info # Prevent ECMWF software from printing table info
Line 71: Line 72:
 $ENV{BUFR_TABLES} .= '/' if substr($ENV{BUFR_TABLES},-1) ne '/'; $ENV{BUFR_TABLES} .= '/' if substr($ENV{BUFR_TABLES},-1) ne '/';
  
-my $filter = $option{filter} ? "--filter $option{filter}" : '';+die "Directory for BUFR tables: $ENV{BUFR_TABLES} does not exist" 
 +    if ! -d $ENV{BUFR_TABLES}; 
 + 
 +my $obstype = $option{obstype} ? "--obstype $option{obstype}" : ''; 
 +my $filt = $option{filter} ? "$option{filter}" : '';
 my $lon1 = $option{lon1} ? "--lon1 $option{lon1}" : ''; my $lon1 = $option{lon1} ? "--lon1 $option{lon1}" : '';
 my $lat1 = $option{lat1} ? "--lat1 $option{lat1}" : ''; my $lat1 = $option{lat1} ? "--lat1 $option{lat1}" : '';
 my $lon2 = $option{lon2} ? "--lon2 $option{lon2}" : ''; my $lon2 = $option{lon2} ? "--lon2 $option{lon2}" : '';
 my $lat2 = $option{lat2} ? "--lat2 $option{lat2}" : ''; my $lat2 = $option{lat2} ? "--lat2 $option{lat2}" : '';
 +my $del = $option{delimiter} ? "$option{delimiter}" : ';';
 +my $delimiter = $option{delimiter} ? "--delimiter $del" : '';
  
-my $criteria_ref; +# Any filter criteria provided? 
-$criteria_ref = read_filter_file($option{filter}) if $filter;+my ($filter, $criteria_ref, $num_alt_ref) = get_filter_conditions($filt);
  
-my $param_file = $option{param} ? $option{param} : ''; +# Any specific stations requested? 
-my ($forced_params_ref, $params_ref); +my ($req_id, $req_stn_ref) = get_requested_stations($option{station}); 
-($forced_params_ref, $params_ref) + 
-    = read_param_file($param_file) if $param_file;+# Any specific parameters specified? 
 +my ($params_ref, $forced_params_ref) = get_params($option{param});
  
 my $csv = $option{csv} ? 1 : 0; my $csv = $option{csv} ? 1 : 0;
 # First line in CSV should be the parameters # First line in CSV should be the parameters
-print join(',', @$params_ref) . "\n" if $csv;+print join($del, @$params_ref) . "\n" if $csv;
  
 +# Any transformations of units specified?
 my $transform_file = $option{transform} ? $option{transform} : 0; my $transform_file = $option{transform} ? $option{transform} : 0;
-my $transform_ref; +my $transform_ref = read_transformation_file($transform_file);
-$transform_ref = read_transformation_file($transform_file) if $transform_file;+
  
 +# Any sorting requested?
 my $sort = $option{sort} ? 1 : 0; my $sort = $option{sort} ? 1 : 0;
 my $sort_on = $option{sort_on} ? $option{sort_on} : ''; my $sort_on = $option{sort_on} ? $option{sort_on} : '';
  
-# What kind of sorting is required? +# What kind of sorting is required (if any)? 
-my $sort_by; +($sort_on, my $by) = get_sort_method($sort_on, $sort);
-if ($sort_on) { +
-    my @ascii_params = qw(call_sign icao_id obstime name type); +
-    my $ascending_sort = 1; +
-    # A minus sign appended to the sort parameter means descending sort +
-    if ($sort_on =~ /-$/) { +
-        $ascending_sort = 0; +
-        chop $sort_on; +
-    } +
-    # Just in case someone adds a '+' to signify ascending sort +
-    if ($sort_on =~ /[+]$/) { +
-        $ascending_sort = 1; +
-        chop $sort_on; +
-    } +
-    if (grep {$_ eq $sort_on} @ascii_params) { +
-        if ($ascending_sort) { +
-            $sort_by = sub {$a cmp $b}; +
-        } else { +
-            $sort_by = sub {$b cmp $a}; +
-        } +
-    } else { +
-        if ($ascending_sort) { +
-            $sort_by = sub {$a <=> $b}; +
-        } else { +
-            $sort_by = sub {$b <=> $a}; +
-        } +
-    } +
-}+
  
 # Loop for processing of BUFR input files # Loop for processing of BUFR input files
Line 131: Line 113:
  
     # Dump the content of the BUFR file using the Fortran program $BUFRDUMP     # Dump the content of the BUFR file using the Fortran program $BUFRDUMP
-    my $dump = `$BUFRDUMP $filter $lon1 $lat1 $lon2 $lat2 $inputfname`;+    my $fortran_options = "$obstype $filter $lon1 $lat1 $lon2 $lat2"; 
 +    my $dump = `$BUFRDUMP $fortran_options $inputfname`;
     die if $?; # Reason for bufrdump failing should have been printed to STDERR     die if $?; # Reason for bufrdump failing should have been printed to STDERR
  
Line 138: Line 121:
     # Add an empty line to simplify processing     # Add an empty line to simplify processing
     push @lines, '';     push @lines, '';
-    my $station = '';+    my $stnid = '';
  
-    # Skip first(blank) line+    # Skip first (blank) line
     shift @lines;     shift @lines;
  
Line 146: Line 129:
     my %msg; # Hash with parameter name as key, parameter value as value     my %msg; # Hash with parameter name as key, parameter value as value
  
-  LINE:while (defined(my $line = shift @lines)) {+  LINE: 
 +    while (defined(my $line = shift @lines)) {
         # Each new message starts with a blank line         # Each new message starts with a blank line
         if ($line !~ /^\s*$/) {         if ($line !~ /^\s*$/) {
 +            # Skip error messages from libbufr, which should start with space(s)
 +            next LINE if $line =~ /^\s+/;
             # Build up the message to be (possibly) printed             # Build up the message to be (possibly) printed
-            my ($param, $value) = ($line =~ /^(.+)=\s*(.*)$/);+            my ($param, $value) = ($line =~ /^(.+)=\s*(.*?)\s*$/); 
 +            # Know only of one case where next check is necessary: if 
 +            # a CCITT IA5 value contains new line (\n) 
 +            next LINE if !defined $value;
             if ($transform_file && $transform_ref->{$param}) {             if ($transform_file && $transform_ref->{$param}) {
                 # Replace value with transformed value                 # Replace value with transformed value
Line 166: Line 155:
         if ($line =~ /^\s*$/ or @lines == 0) {         if ($line =~ /^\s*$/ or @lines == 0) {
             # A full message has been completed. Should it be printed?             # A full message has been completed. Should it be printed?
-            if ($filter && filter_obs(\%msg, $criteria_ref)) {+            if ($filt && filter_obs(\%msg, $criteria_ref, $num_alt_ref)) {
                 # Skip this message                 # Skip this message
 +            } elsif ($req_id && filter_station(\%msg, $req_id, $req_stn_ref)) {
 +                # Skip this station
             } else {             } else {
                 # Print the message (or if --sort or --sort_on: save the message)                 # Print the message (or if --sort or --sort_on: save the message)
                 my $txt = '';                 my $txt = '';
-                if ($param_file) {+                if ($params_ref) {
                     # Print the params in @$params_ref if exists in                     # Print the params in @$params_ref if exists in
                     # message, in same order as in @$params_ref                     # message, in same order as in @$params_ref
                     foreach my $name (@$params_ref) {                     foreach my $name (@$params_ref) {
                         if (exists $msg{$name}) {                         if (exists $msg{$name}) {
-                            $txt .= $csv ? $msg{$name} . ',' : "$name=$msg{$name}\n";+                            $txt .= $csv ? $msg{$name} . $del : "$name=$msg{$name}\n";
                         } elsif ($forced_params_ref->{$name}) {                         } elsif ($forced_params_ref->{$name}) {
-                            $txt .= $csv ? '-32767,' : "$name=-32767\n";+                            $txt .= $csv ? '-32767' . $del : "$name=-32767\n";
                         } elsif ($csv) {                         } elsif ($csv) {
-                            $txt .= ',';+                            $txt .= $del;
                         }                         }
                     }                     }
Line 189: Line 180:
                     }                     }
                 }                 }
-                chop $txt if $csv; # removes last ','+                if ($csv) { 
 +                    # Remove last $del 
 +                    for (1 .. length($del)) { 
 +                        chop $txt; 
 +                    } 
 +                }
                 if ($txt) {                 if ($txt) {
                     if ($sort) {                     if ($sort) {
-                        # Sort wmonr before call signs before buoy_id+                        # Sort wmonr before nationalnr before call sign before 
 +                        # buoy_id before aircraft before icaoid before wigosid
                         if ($msg{wmonr}) {                         if ($msg{wmonr}) {
-                            $station = '00_' . $msg{wmonr};+                            $stnid = '00_' . $msg{wmonr}; 
 +                        } elsif ($msg{nationalnr}) { 
 +                            $stnid = '10_' . $msg{nationalnr};
                         } elsif ($msg{call_sign}) {                         } elsif ($msg{call_sign}) {
-                            $station = '10_' . $msg{call_sign};+                            $stnid = '20_' . $msg{call_sign};
                         } elsif ($msg{buoy_id}) {                         } elsif ($msg{buoy_id}) {
-                            $station = '10_' . $msg{buoy_id};+                            $stnid = '30_' . $msg{buoy_id}; 
 +                        } elsif ($msg{aircraft}) { 
 +                            $stnid = '40_' . $msg{aircraft}; 
 +                        } elsif ($msg{icao_id}) { 
 +                            $stnid = '50_' . $msg{icao_id}; 
 +                        } elsif ($msg{wigosid}) { 
 +                            $stnid = '60_' . $msg{wigosid};
                         } else {                         } else {
                             # Skip observation if no station identification found                             # Skip observation if no station identification found
                             next LINE;                             next LINE;
                         }                         }
-                        $data_of{$station} = exists $data_of{$station} +                        if ($sort_on) { 
-                            ? $data_of{$station} . "$txt \n" : "$txt \n";+                            my $val = exists $msg{$sort_on} ? $msg{$sort_on} : ''; 
 +                            my $key = $stnid . '|' . $val; 
 +                            $data_of{$key} = exists $data_of{$key} 
 +                            ? $data_of{$key} . "$txt\n" : "$txt\n"; 
 +                        } else { 
 +                            $data_of{$stnid} = exists $data_of{$stnid} 
 +                            ? $data_of{$stnid} . "$txt\n" : "$txt\n"; 
 +                        }
                     } elsif ($sort_on) {                     } elsif ($sort_on) {
                         my $val = exists $msg{$sort_on} ? $msg{$sort_on} : '';                         my $val = exists $msg{$sort_on} ? $msg{$sort_on} : '';
                         $data_of{$val} = exists $data_of{$val}                         $data_of{$val} = exists $data_of{$val}
-                            ? $data_of{$val} . "$txt \n" : "$txt \n";+                        ? $data_of{$val} . "$txt\n" : "$txt\n";
                     } else {                     } else {
                         # No sorting. We can print the line immediately                         # No sorting. We can print the line immediately
Line 223: Line 235:
  
 # If sorting requested, we cannot print before now # If sorting requested, we cannot print before now
-if ($sort) {+if ($sort && $sort_on) { 
 +    for (sort $by keys %data_of) { 
 +        print $data_of{$_}; 
 +    } 
 +} elsif ($sort) {
     for (sort keys %data_of) {     for (sort keys %data_of) {
         print $data_of{$_};         print $data_of{$_};
Line 231: Line 247:
     my $data_of_missing_value = $data_of{''} || '';     my $data_of_missing_value = $data_of{''} || '';
     delete $data_of{''};     delete $data_of{''};
-    for (sort $sort_by keys %data_of) {+    for (sort $by keys %data_of) {
         print $data_of{$_};         print $data_of{$_};
     }     }
Line 238: Line 254:
  
  
-sub read_param_file { +# Read the filter conditions (if any). Return the filter option to be 
-    my $parameter_file = shift;+# used by bufrdump, the found criteria (if any) as well as the number 
 +# of succeeding alternatives for each criterium 
 +sub get_filter_conditions { 
 +    my $filt = shift; 
 +    return ('') if ! $filt;
  
-    open my $PARAM, '<', $parameter_file +    my $fortran_filter = ''; 
-        or die "Cannot open $parameter_file: $!";+    my @f; 
 +    if ($filt =~ /,/) { 
 +        # Argument to --filter is a comma separated list 
 +        @f = split /,/, $filt; 
 +    } else { 
 +        # Argument to --filter is a file 
 +        $fortran_filter = "--filter $filt"; 
 +        open my $FILTER, '<', $filt 
 +            or die "Cannot open $filt: $!"; 
 +        # Skip the criteria meant for Fortran parsing, i.e. proceed to 
 +        # first line following a blank line 
 +        while (<$FILTER>) { 
 +            last if $_ =~ /^\s*$/; 
 +        } 
 +        @f = <$FILTER>; 
 +        close $FILTER or die "Cannot close $filt: $!";; 
 +    } 
 +    return ($fortran_filter) if !@f; # BUFR descriptor criteria only
  
-    my %forced_params; +    my @allowed_operators = 
-    my @params; +        ('=', 
-    # Read the parameters into @params, those preceded by an +         '<', 
-    # exclamation mark also into %forced_params, skipping blank lines +         '<=', 
-    # and comment lines +         '>', 
-    while (my $name = <$PARAM>) { +         '>=', 
-        $name =~ s/^\s+//; +         '!=', 
-        $name =~ s/\s+$//; +         '=~', 
-        next if !$name || $name =~ /^#/; +         '!~', 
-        if ($name =~ /^!/) { +        ); 
-            $name = substr $name, 1; +    my @criteria; 
-            $forced_params{$name} = 1;+    my @num_alt; # Number of alternative criteria following this, 
 +                 # i.e. if line is '<cr1> | <cr2> | <cr3>' then 
 +                 # corresponding values in @num_alt will be 2,1,0 
 + 
 +    # Read the filter criteria meant for Perl parsing, skipping blank 
 +    # lines and comment lines 
 +  FILTERLINE: 
 +    foreach my $line (@f) { 
 +        $line =~ s/^\s+//; 
 +        $line =~ s/\s+$//; 
 +        next FILTERLINE if !$line || $line =~ /^#/; 
 +        my @crit = split /\|/, $line; 
 +        my $num = scalar @crit; 
 +        foreach my $criterium (@crit) { 
 +            $criterium =~ s/^\s+//; 
 +            $criterium =~ s/\s+$//; 
 +            if ($criterium ne '') { 
 +                push @criteria, $criterium; 
 +                push @num_alt, --$num; 
 +            }
         }         }
-        push @params, $name; 
     }     }
-    close $PARAM or die "Cannot close $parameter_file: $!";+    return ($fortran_filter) if !@criteria;
  
-    return \%forced_params, \@params;+    # Check that the criteria are properly formatted 
 +    foreach my $criterium (@criteria) { 
 +        # Naked parameter possibly preceded by '!' is ok 
 +        next if $criterium =~ /^!?\w+$/; 
 + 
 +        my $op = (split / +/, $criterium)[1]; 
 +        if (!defined($op) or grep(/[+*?\\]/, $op) 
 +            or !grep(/^$op$/, @allowed_operators) ) { 
 +            print "Error in $filt:\ncriterium is badly formatted" 
 +                . " or operator not supported:\n$criterium"; 
 +            exit 1; 
 +        } 
 +    } 
 +    return ($fortran_filter, \@criteria, \@num_alt);
 } }
 +
 +
 +# Read the parameters into @params, those preceded by an exclamation
 +# mark also into %forced_params, and return references to these two.
 +sub get_params {
 +    my $params = shift;
 +    return if ! $params;
 +
 +    my @params;
 +    my %forced_params;
 +
 +    if ($params =~ /,/) {
 +        # Argument to --params is a comma separated list
 +        my @p = split /,/, $params;
 +        foreach my $name (@p) {
 +            $name =~ s/^\s+//;
 +            $name =~ s/\s+$//;
 +            if ($name =~ /^!/) {
 +                $name = substr $name, 1;
 +                $forced_params{$name} = 1;
 +            }
 +            push @params, $name;
 +        }
 +    } else {
 +        # Argument to --params is a file
 +        open my $PARAM, '<', $params
 +            or die "Cannot open file $params: $!";
 +        while (my $name = <$PARAM>) {
 +            # Skip blank lines and comment lines
 +            $name =~ s/^\s+//;
 +            $name =~ s/\s+$//;
 +            next if !$name || $name =~ /^#/;
 +            if ($name =~ /^!/) {
 +                $name = substr $name, 1;
 +                $forced_params{$name} = 1;
 +            }
 +            push @params, $name;
 +        }
 +        close $PARAM or die "Cannot close $params: $!";
 +    }
 +    return \@params, \%forced_params;
 +}
 +
  
 sub read_transformation_file { sub read_transformation_file {
     my $transform_file = shift;     my $transform_file = shift;
 +    return if !$transform_file;
  
     open my $TRANSFORM, '<', $transform_file     open my $TRANSFORM, '<', $transform_file
Line 276: Line 388:
         $line =~ s/^\s+//;         $line =~ s/^\s+//;
         $line =~ s/\s+$//;         $line =~ s/\s+$//;
-         next if !$line || $line =~ /^#/;+        next if !$line || $line =~ /^#/;
         my ($param, $transform) = split /=/, $line, 2;         my ($param, $transform) = split /=/, $line, 2;
         die "Invalid transformation in $transform_file:\n$line\n"         die "Invalid transformation in $transform_file:\n$line\n"
Line 284: Line 396:
         $transform_of{$param} = $transform;         $transform_of{$param} = $transform;
     }     }
 +    close $TRANSFORM or die "Cannot close $transform_file: $!";
     return \%transform_of;     return \%transform_of;
 } }
  
-sub read_filter_file { +# Return true (1) if observation is to be filtered, i.e. does not 
-    my $filter_file = shift; +# comply with at least one line in filter file, where each line is one 
-    my @allowed_operators = +# or more alternatives <param> or <param> <operator> <value> 
-        ('=', +sub filter_obs { 
-         '<', +    my $msg_ref = shift; 
-         '<=', +    my $criteria_ref = shift; 
-         '>', +    my $num_alt_ref = shift; # gives the number of alternative 
-         '>=', +                             # criteria still to be checked 
-         '!=', +    return unless $criteria_ref;
-     ); +
-    my @criteria;+
  
-    open my $FILTER, '<', $filter_file +    my @ascii_params = qw(aircraft call_sign icao_id name obstime type wigosid);
-        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 +    # Note that the loop counter $i might be changed in the loop 
-    # lines and comment lines +    for (my $i=0; $i < @{$criteria_ref}; $i++) { 
-    while (my $line = <$FILTER>) { +        my $num_alt = $num_alt_ref->[$i]; 
-        $line =~ s/^\s+//; +        my $criterium = $criteria_ref->[$i]; 
-        $line =~ s/\s+$//; +        my ($f_param, $f_operator, $f_value) = split / +/, $criterium, 3;
-        next if !$line || $line =~ /^#/; +
-        push @criteria, $line; +
-    }+
  
-    # Check that the criteria are properly formatted +        # First check for !$par, meaning $par should not be in the observation 
-    foreach my $criterium (@criteria) { +        if (substr($f_param,0,1) eq '!') { 
-        # Naked parameter is ok +            $f_param = substr($f_param,1); 
-        next if $criterium =~ /^\w+$/;+            # If parameter is present, criterium is not fullfilled 
 +            if (exists $msg_ref->{$f_param}) { 
 +                next if $num_alt; # More alternatives to check
  
-        my $op = (split / +/, $criterium)[1]; +                # Criterium not fulfilled and no more alternatives to 
-        if (!defined($op) or grep(/[+*?\\]/, $op) or !grep(/^$op$/, @allowed_operators) ) { +                # check. This observation should be filtered away 
-            print "Error in $filter_file, line $. is badly formatted" +                return 1; 
-                . " or operator not supported:\n$criterium"; +            } else { 
-            exit 1;+                # Criterium fulfilled. No need to check alternative criteria 
 +                $i += $num_alt if $num_alt; 
 +                next; 
 +            }
         }         }
-    } 
-    return \@criteria; 
-} 
  
-# Return true (1) if observation is to be filtered, i.e. does not +        # If parameter not present, criterium is obviously not fullfilled 
-# comply with at least one of the <param> or <param> <operator> +        if (not exists $msg_ref->{$f_param}) { 
-# <value> filter criteria in filter file +            next if $num_alt; 
-sub filter_obs { +            return 1; 
-    my $msg_ref = shift; +        }
-    my $criteria_ref = shift;+
  
-    my @ascii_params = qw(call_sign icao_id name obstime type);+        my $msg_value = $msg_ref->{$f_param}; 
 +        # If a naked parameter criterium, we already know parameter is 
 +        # present (as found in previous check), so criterium is fulfilled 
 +        if (not defined $f_operator) { 
 +            if ($num_alt) { 
 +                # No need to check the alternative criteria 
 +                $i += $num_alt; 
 +            } 
 +            next; 
 +        }
  
-    foreach my $criterium (@$criteria_ref) { 
-        my ($f_param, $f_operator, $f_value) = split / +/, $criterium, 3; 
-        return 1 unless exists $msg_ref->{$f_param}; 
-        next if not defined $f_operator; # Naked parameter criterium. Parameter 
-                                         # present, so criterium fulfilled 
         chomp $f_value;         chomp $f_value;
-        if ($f_operator eq '=') {+        my $op; 
 +        if ($f_operator eq '<' 
 +            || $f_operator eq '<=' 
 +            || $f_operator eq '>' 
 +            || $f_operator eq '>=' 
 +            || $f_operator eq '=~' 
 +            || $f_operator eq '!~') { 
 +            $op = $f_operator; 
 +        } elsif ($f_operator eq '=' 
 +                 || $f_operator eq '!=') {
             if (grep {$_ eq $f_param} @ascii_params) {             if (grep {$_ eq $f_param} @ascii_params) {
-                $msg_ref->{$f_param} =~ s/\s*$//; +                $msg_value =~ s/\s*$//; 
-                return 1 unless $msg_ref->{$f_param} eq $f_value;+                $op = ($f_operator eq '=') ? 'eq' : 'ne';
             } else {             } else {
-                return 1 unless $msg_ref->{$f_param} == $f_value;+                $op = ($f_operator eq '=') ? '==' : '!=';
             }             }
-        } elsif ($f_operator eq '<') { +        } else { 
-            return 1 unless $msg_ref->{$f_param} < $f_value; +            die "Internal error: unknown operator '$f_operator'"; 
-        } elsif ($f_operator eq '<=') { +        } 
-            return 1 unless $msg_ref->{$f_param} <= $f_value; + 
-        } elsif ($f_operator eq '>') { + # Some parameters might need special massaging 
-            return 1 unless $msg_ref->{$f_param} > $f_value; +        if ($f_operator !~ /~/) { 
-        } elsif ($f_operator eq '>=') { +            if ($f_param eq 'wmonr' || $f_param eq 'buoy_id') { 
-            return 1 unless $msg_ref->{$f_param} >= $f_value; +                # Make non octal by removing leading 0 
-        } elsif ($f_operator eq '!=') { +                $msg_value =~ s/^0+//; 
-            if (grep {$_ eq $f_param} @ascii_params) { +                $f_value =~ s/^0+// if $f_value != 0; 
-                $msg_ref->{$f_param} =~ s/\s*$//; +            } elsif ($f_param eq 'nationalnr') { 
-                return 1 unless $msg_ref->{$f_param} ne $f_value; +                # Convert to a pure numerical value (float). For 001101 
-            } else { +                # State id only numbers between 100 and 699 are operational 
-                return 1 unless $msg_ref->{$f_param} != $f_value;+                $msg_value =~ s/_0*/./; 
 +                $f_value =~ s/_0*/./; 
 +            } elsif ($f_param eq 'obstime') { 
 +                # Convert to a pure numerical value (float) 
 +                $msg_value =~ s/[-:]//g; 
 +                $msg_value =~ s/ /./; 
 +                $f_value =~ s/[-:']//g; 
 +                $f_value =~ s/^ +//; 
 +                $f_value =~ s/ +$//; 
 +                $f_value =~ s/ /./; 
 +            } elsif ($f_param eq 'name') { 
 +                # Add or correct quoting to "" and ignore casing 
 +                $msg_value = '"' . lc $msg_value . '"'; 
 +                $f_value = lc $f_value; 
 +                if ($f_value =~ /^'.*'$/) { 
 +                    $f_value =~ s/^'//; 
 +                    $f_value =~ s/'$//; 
 +                } 
 +                if ($f_value !~ /^".*"$/) { 
 +                    $f_value = '"' . $f_value . '"'; 
 +                }
             }             }
         }         }
 +
 + my $condition = "$msg_value $op $f_value";
 + # Some values should be string values
 + if ($f_operator =~ /~/) {
 +     $condition = "q{$msg_value} $op $f_value";
 + } elsif (grep {$_ eq $f_param} @ascii_params) {
 +     $condition = "q{$msg_value} $op q{$f_value}";
 + }
 +
 +        # Finally, do the criterium check
 + if (eval $condition) {
 +     # No need to check the remaining alternative criteria
 +     $i += $num_alt if $num_alt;
 +     next;
 + } else {
 +     next if $num_alt;
 +     return 1;
 + }
     }     }
  
     # All filter conditions have been fullfilled     # All filter conditions have been fullfilled
     return 0;     return 0;
 +}
 +
 +# Return the type of station requested, and the station
 +# identifications. Leave some leeway for how to list wmonr and
 +# nationalnr (leading 0's might be omitted - added here)
 +sub get_requested_stations {
 +    my $req_stations = shift;
 +    return if !$req_stations;
 +    die "Station list must start with 'wmonr=', 'nationalnr=', "
 +        . "'call_sign=', 'buoy_id=', 'aircraft=', 'icao_id' or 'wigosid='"
 +        unless $req_stations
 +        =~ /^(wmonr=|nationalnr=|call_sign=|buoy_id=|aircraft=|icao_id=|wigosid=)/;
 +
 +    my ($id, $rest) = split /=/, $req_stations;
 +    my @stations = split /,/, $rest;
 +    if ($id eq 'wmonr') {
 +        my @req_stn;
 +        foreach my $station (@stations) {
 +            # Turn $station into a 5 digit wmonr
 +            $station =~ s/^0+//;
 +            $station += 1000 if $station < 1000;
 +            $station = sprintf("%05d", $station);
 +            push @req_stn, $station;
 +        }
 +        return ($id, \@req_stn);
 +    } elsif ($id eq 'nationalnr') {
 +        my @req_stn;
 +        foreach my $station (@stations) {
 +            # Turn national station number into 10 digits
 +            my ($state_id, $national_id) = split /_/, $station;
 +            die "Uncorrected formatted station: '$station' in station list"
 +                if !defined $national_id or $national_id eq '';
 +            $station = $state_id . '_' . sprintf("%010d", $national_id);
 +            push @req_stn, $station;
 +        }
 +        return ($id, \@req_stn);
 +    } else {
 +        return ($id, \@stations);
 +    }
 +}
 +
 +# Return true (1) if observation does not contain one of the stations
 +# listed in @$req_stn_ref (of type $req_id), i.e. if this observation
 +# should be filtered away
 +sub filter_station {
 +    my ($msg_ref, $req_id, $req_stn_ref) = @_;
 +
 +    return 1 unless $msg_ref->{$req_id};
 +    my $stn = $msg_ref->{$req_id};
 +
 +    return !grep { $_ eq $stn } @$req_stn_ref;
 +}
 +
 +
 +# When --sort_on is used, need to supply the sort method. Also returns
 +# input parameter $sort_on with possible trailing '-' (or '+')
 +# stripped off
 +sub get_sort_method {
 +    my ($sort_on, $sort) = @_;
 +    return if !$sort_on;
 +
 +    my $ascending_sort = 1;
 +    # A minus sign appended to the sort parameter means descending sort
 +    if ($sort_on =~ /-$/) {
 +        $ascending_sort = 0;
 +        chop $sort_on;
 +    }
 +    # Just in case someone adds a '+' to signify ascending sort
 +    if ($sort_on =~ /[+]$/) {
 +        chop $sort_on;
 +    }
 +
 +    my @ascii_params = qw(aircraft call_sign icao_id obstime name type wigosid);
 +    my $lexical_sort = grep {$_ eq $sort_on} @ascii_params;
 +
 +    my $sort_sub;
 +    if ($sort) {
 +        $sort_sub = sub {
 +            my ($stn_a, $val_a) = split /\|/, $a;
 +            my ($stn_b, $val_b) = split /\|/, $b;
 +            # Sort on stationid is always lexical and ascending
 +            my $cmp = $stn_a cmp $stn_b;
 +            if ($cmp) {
 +                return $cmp;
 +            } else {
 +                # Stationids are equal. Sort on value of sort_on parameter
 +                if ($lexical_sort) {
 +                    if ($ascending_sort) {
 +                        return $val_a cmp $val_b;
 +                    } else {
 +                        return $val_b cmp $val_a;
 +                    }
 +                } else {
 +                    # Numerical sort
 +                    if ($ascending_sort) {
 +                        return $val_a <=> $val_b;
 +                    } else {
 +                        return $val_b <=> $val_a;
 +                    }
 +                }
 +            }
 +        }
 +    } else {
 +        # Sort restricted to sort_on parameter
 +        $sort_sub = sub {
 +            if ($lexical_sort) {
 +                if ($ascending_sort) {
 +                    return $a cmp $b;
 +                } else {
 +                    return $b cmp $a;
 +                }
 +            } else {
 +                # Numerical sort
 +                if ($ascending_sort) {
 +                    return $a <=> $b;
 +                } else {
 +                    return $b <=> $a;
 +                }
 +            }
 +        }
 +    }
 +
 +    return ($sort_on, $sort_sub);
 } }
  
Line 380: Line 657:
  
   bufrdump.pl <bufr file(s)>   bufrdump.pl <bufr file(s)>
-      [--filter <filter file>] +      [--filter <filter file | filter list>] 
-      [--param <parameter file> [--csv]] +      [--param <parameter file | parameter list> [--csv [--delimiter <del>]] 
-      [--sort | --sort_on <parameter>[-]]+      [--sort] 
 +      [--sort_on <parameter>[-]] 
 +      [--station <station list>]
       [--transform <transformation file>]       [--transform <transformation file>]
-      [--lon1 x1] +      [--lon1 <x1>] 
-      [--lat1 y1] +      [--lat1 <y1>] 
-      [--lon2 x2] +      [--lon2 <x2>] 
-      [--lat2 x2]+      [--lat2 <y2>] 
 +      [--obstype <amdar|ocea|surface|sounding|sounding->]
       [--tablepath <path to BUFR tables>]       [--tablepath <path to BUFR tables>]
       [--help]       [--help]
Line 406: Line 686:
  
  
-  --filter <filter file> +  --filter <filter file | filter list> 
-                  Decode observations meeting criteria in <filter file> only +                  Decode observations meeting criteria in filter file or 
-  --param <parameter file> [--csv] +                  filter list only 
-                  Print parameters in <parameter file> only, in same order +  --param <parameter file | parameter list> [--csv [--delimiter <del>]] 
-                  as they occur in <parameter file>. If --csv, the parameters +                  Print parameters in parameter file or comma 
-                  vill be printed using the CSV (comma separated values) format+                  separated list (e.g. wmonr,TA) only, in same order 
 +                  as they occur there. If using --csv possibly 
 +                  followed by --delimiter <del>, the parameters vill 
 +                  be printed using the CSV (comma-separated values) 
 +                  format, with the delimiter del (default is ';')
   --sort          Sort the decoded observations on station identification;   --sort          Sort the decoded observations on station identification;
-                  first stations with wmonr, then stations with call sign, +                  first stations with wmonr, then stations with nationalnr, 
-                  then stations with buoy_id (others left out)+                  call_sign, buoy_id, aircraft, icao_id or wigosid 
 +                  (others left out)
   --sort_on <parameter>[-] Sort the decoded observations on increasing   --sort_on <parameter>[-] Sort the decoded observations on increasing
-                  values of <parameter>, or decreasing values if a '-' +                  values of parameter, or decreasing values if a '-' 
-                  follows the parameter name. Observations not containing +                  follows the parameter name. E.g. --sort_on TA- will 
-                  the parameter at all will be printed lastly. E.g. +                  sort on decreasing temperatures. Observations not 
-                  --sort_on TA- will sort on decreasing temperatures+                  containing the parameter at all will be printed lastly, 
 +                  except when --sort_on is combined with --sort (in which 
 +                  case sorting is done firstly on station identification, 
 +                  secondly on parameter with missing values printed first) 
 +  --station <station list> 
 +                  Print observations for stations in station list only, 
 +                  e.g. wmonr=01384,01492
   --transform <transformation file>   --transform <transformation file>
                   Do the transformations of parameter values listed in                   Do the transformations of parameter values listed in
-                  <transformation file> +                  transformation file 
-  --lon1 x1       Decode observations with longitude >= x1 only +  --lon1 <x1>     Decode observations with longitude >= x1 only 
-  --lat1 y1       Decode observations with latitude >= y1 only +  --lat1 <y1>     Decode observations with latitude >= y1 only 
-  --lon2 x2       Decode observations with longitude <= x2 only +  --lon2 <x2>     Decode observations with longitude <= x2 only 
-  --lat2 y2       Decode observations with latitude <= y2 only+  --lat2 <y2>     Decode observations with latitude <= y2 only
                   x1,y1,x2,y2 should be decimal degrees                   x1,y1,x2,y2 should be decimal degrees
 +  --obstype <amdar|ocea|surface|sounding|sounding->]
 +                  Force observation type. If this option is not set,
 +                  will make an educated guess of observation type
 +                  based on metadata in section 1 of each BUFR message
   --tablepath <path to BUFR tables>   --tablepath <path to BUFR tables>
                   Set path to BUFR tables (overrides ENV{BUFR_TABLES})                   Set path to BUFR tables (overrides ENV{BUFR_TABLES})
-  --help          Print this Usage+  --help          Print this Usage (but you might instead prefer to use 
 +                  perldoc bufrdump.pl)
  
 Options may be abbreviated, e.g. --h or -h for --help. Options may be abbreviated, e.g. --h or -h for --help.
  
 To avoid having to use the C<--tablepath> option, you are adviced to To avoid having to use the C<--tablepath> option, you are adviced to
-set the invironment variable BUFR_TABLES to the directory where your+set the environment variable BUFR_TABLES to the directory where your
 BUFR tables are located (unless the default path provided by BUFR tables are located (unless the default path provided by
 bufrdump.pl works for you). bufrdump.pl works for you).
  
-The lines in <parameter file> should be name of the parameters you +The lines in <parameter file>, or the comma separated values in 
-want to be printed. For example, if you want only station +<parameter list>, should be name of the parameters you want to be 
-identification and temperature to be printed for a BUFR SYNOP file, +printed. For example, if you want only station identification and 
-the <parameter file> should look like this:+temperature to be printed for a BUFR SYNOP file, either supply 
 + 
 +  wmonr,nationalnr,call_sign,TA 
 + 
 +as argument to --params, or supply a <parameter file> which should 
 +look like this:
  
   wmonr   wmonr
 +  nationalnr
   call_sign   call_sign
   TA   TA
Line 450: Line 752:
 If you want "parameter=value" to be printed also when value is missing If you want "parameter=value" to be printed also when value is missing
 in BUFR message, precede the parameter name with an exclamation mark in BUFR message, precede the parameter name with an exclamation mark
-(e.g. '!TA').  Missing values will then be displayed as -32767.+(e.g. '!TA'). Missing values will then be displayed as -32767. If the 
 +argument to --param is a parameter list, you must prevent the shell 
 +from attaching special meaning to the exclamation mark by enclosing the 
 +list in single quotes. 
 + 
 +If the parameter list consists of one parameter only, a comma must be 
 +appended (e.g. 'wmonr,') because bufrdump.pl uses the appearence of 
 +comma to signal that this is not a filename but parameter name(s).
  
 If --csv is used in conjunction with --param, all values will be If --csv is used in conjunction with --param, all values will be
 printed using the CSV format, with first line listing the parameters, printed using the CSV format, with first line listing the parameters,
 and with missing fields printed as -32767 if the parameter is marked and with missing fields printed as -32767 if the parameter is marked
-with '!' in parameter file. With the parameter file above, the listing +with '!' in parameter file or list. With the parameter file above, the 
-may for example start like+listing may for example start like 
 + 
 +  wmonr;nationalnr;call_sign;TA 
 +  01001;;;-1.5 
 +  ;;LF5U;9.0
  
-  wmonr,call_sign,TA +You can choose another delimiter than semicolon by use of option 
-  01001,,-1.5 +--delimiter <del>, e.g. --csv --delimiter ','
-  ,LF5U,9.0+
  
 Using --filter will decode only those observations that meet at least Using --filter will decode only those observations that meet at least
Line 466: Line 778:
 in <filter file>, where the BUFR descriptor criteria should come first in <filter file>, where the BUFR descriptor criteria should come first
 in filter file followed by a blank line, then comes the parameter in filter file followed by a blank line, then comes the parameter
-criteria which should match <param> or <param> <operator> <value> +criteria which should match <param> or !<param> or <param> <operator> 
-where operator is one of =, !=, <, <=, > and >=. An example filter +<value> where operator is one of =, !=, =~, !~, <, <=, > and >=. What 
-file is+follows =~ and !~ should be a Perl match regular expression. The parameter 
 +criteria may be phrased as alternatives by separating them with '|' on 
 +a single line. An example filter file is
  
   D: 001001 I2.2   D: 001001 I2.2
Line 485: Line 799:
  
 which decodes all observations with block number 01, two other which decodes all observations with block number 01, two other
-specific wmo stations and one specific ship, being manned stations and +specific wmo stations and one specific ship, where stations should be 
-having cloud cover different from 8 (but NN must be part of the +manned and have cloud cover with a value different from 8, and have 
-message) and temperature between 5 and 9.5 degrees Celsius and +temperature between 5 and 9.5 degrees Celsius, and contain 
-containing precipitation for last 24 hours. Comment lines starting +precipitation for last 24 hours. Comment lines starting with # will be 
-with # will be ignored.+ignored.
  
-Another example: the simple filter file (starting with a blank line!)+Another example: the filter file (starting with a blank line!)
  
  
-  wmonr+  call_sign =~ /^L[A-N]..$/ 
 +  obstime >= '2012-02-10 06:00:00' 
 +  HW | HWA | PW | PWA 
 +  FF > 10 | FG_010 > 10
  
-will print only those observations containing a wmonr (skipping +will print only those ship observations for which the 4 character 
-ships).+call_sign starts with 2 letters in the interval LA-LN, and having 
 +obstime larger or equal to the datetime given, and containing wave 
 +data (specifically: height or period of waves, manually or 
 +automatically measured), and with wind or 10 minutes gust more than 10 
 +m/s. 
 + 
 +For convenience, when there are no BUFR descriptor criteria, you might 
 +provide the filter criteria on the command line. Example: 
 + 
 +--filter 'wmonr,TA > 0,RR_12 | RR_24, !FF' 
 + 
 +will decode only observations with wmonr, having positive temperature 
 +and containing precipitation for 12 or 24 hours and not reporting 
 +wind. If (like for --param) the filter list consists of one criterium 
 +only, a comma must be appended. 
 + 
 +To avoid the need of creating a filter file when observations for some 
 +few stations are requested, you can provide the stations in a comma 
 +separated list after option --station. Some examples: 
 + 
 +  --station wmonr=01001,01152,01492 
 +  --station nationalnr=614_0050410003,637_108 
 +  --station call_sign=LF5U 
 +  --station buoyid=64607,64609 
 +  --station aircraft=EU3421,JHCWUURA 
 +  --station icao_id=ENGM,ENBO 
 +  --station wigosid=0-376-0-511,0-20000-0-01492 
 + 
 +You cannot mix different kinds of stations this way (before '=' you 
 +must choose either wmonr, nationalnr, call_sign, buoy_id, aircraft, 
 +icao_id or wigosid). Note also that providing the stations in the BUFR 
 +descriptor part (first part) of the filter file will speed up 
 +execution time considerably, compared to using option --station. It is 
 +possible to combine --filter with --station if done with some care, 
 +e.g. specifying WMO block 01 and the required parameters in filter 
 +file, then the requested stations in station list.
  
 The --transform option is provided mainly to be able to use other The --transform option is provided mainly to be able to use other
Line 520: Line 872:
 is to be applied for sky not all covered by clouds, you should use NN is to be applied for sky not all covered by clouds, you should use NN
 != 100 instead of NN != 8 in filter file. != 100 instead of NN != 8 in filter file.
 +
 +The --obstype option might be handy in some special cases, like when
 +you are interested only in the surface part of oceanographic data
 +(then use '--obstype surface'), or when you want to see only levels
 +with vss>0 in high resolution radiosonde data (then use '--obstype
 +sounding-'), or when data category and/or data sub-category in the
 +BUFR messages have unusual values.
  
 =head1 AUTHOR =head1 AUTHOR
  • bufr.pm/bufrdump.pl_source.1286349913.txt.gz
  • Last modified: 2022-05-31 09:23:11
  • (external edit)