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
Next revision Both sides next revision
bufr.pm:bufrdump.pl_source [2013-12-04 13:07:39]
pals 		bufr.pm:bufrdump.pl_source [2018-04-25 08:41:39]
pals
Line 1: Line 1:
-<code perl>+<code perl bufrdump.pl>
 #!/usr/bin/perl -w #!/usr/bin/perl -w
  
-# (C) Copyright 2010, met.no+# (C) Copyright 2010-2018, met.no
 # #
 # This program is free software; you can redistribute it and/or modify # This program is free software; you can redistribute it and/or modify
Line 39: Line 39:
            'csv',         # Use CSV format for printing            'csv',         # Use CSV format for printing
            'delimiter=s', # Choose the delimiter for the CSV format            'delimiter=s', # Choose the delimiter for the CSV format
-           'sort',        # Sort on stationid (wmonr/nationalnr/call_sign/buoy_id/aircraft)+           'sort',        # Sort on stationid (wmonr/nationalnr/call_sign/buoy_id/aircraft/wigosid)
            'sort_on=s',   # Sort on specified parameter            'sort_on=s',   # Sort on specified parameter
            'station=s',   # Filter on list of stations            'station=s',   # Filter on list of stations
Line 137: Line 137:
             # Build up the message to be (possibly) printed             # Build up the message to be (possibly) printed
             my ($param, $value) = ($line =~ /^(.+)=\s*(.*?)\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 186: Line 189:
                     if ($sort) {                     if ($sort) {
                         # Sort wmonr before nationalnr before call                         # Sort wmonr before nationalnr before call
-                        # sign before buoy_id before aircraft+                        # sign before buoy_id before aircraft before wigosid
                         if ($msg{wmonr}) {                         if ($msg{wmonr}) {
                             $stnid = '00_' . $msg{wmonr};                             $stnid = '00_' . $msg{wmonr};
Line 197: Line 200:
                         } elsif ($msg{aircraft}) {                         } elsif ($msg{aircraft}) {
                             $stnid = '40_' . $msg{aircraft};                             $stnid = '40_' . $msg{aircraft};
 +                        } elsif ($msg{wigosid}) {
 +                            $stnid = '50_' . $msg{wigosid};
                         } else {                         } else {
                             # Skip observation if no station identification found                             # Skip observation if no station identification found
Line 205: Line 210:
                             my $key = $stnid . '|' . $val;                             my $key = $stnid . '|' . $val;
                             $data_of{$key} = exists $data_of{$key}                             $data_of{$key} = exists $data_of{$key}
-                                ? $data_of{$key} . "$txt\n" : "$txt\n";+                            ? $data_of{$key} . "$txt\n" : "$txt\n";
                         } else {                         } else {
                             $data_of{$stnid} = exists $data_of{$stnid}                             $data_of{$stnid} = exists $data_of{$stnid}
-                                ? $data_of{$stnid} . "$txt\n" : "$txt\n";+                            ? $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 281: Line 286:
          '>=',          '>=',
          '!=',          '!=',
-     );+         '=~', 
 +         '!~', 
 +        );
     my @criteria;     my @criteria;
     my @num_alt; # Number of alternative criteria following this,     my @num_alt; # Number of alternative criteria following this,
Line 379: Line 386:
         $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 401: Line 408:
     return unless $criteria_ref;     return unless $criteria_ref;
  
-    my @ascii_params = qw(aircraft call_sign icao_id name obstime type);+    my @ascii_params = qw(aircraft call_sign icao_id name obstime type wigosid);
  
     # Note that the loop counter $i might be changed in the loop     # Note that the loop counter $i might be changed in the loop
Line 446: Line 453:
         my $op;         my $op;
         if ($f_operator eq '<'         if ($f_operator eq '<'
-            | $f_operator eq '<=' +            || $f_operator eq '<=' 
-            | $f_operator eq '>' +            || $f_operator eq '>' 
-            | $f_operator eq '>=') {+            || $f_operator eq '>=' 
 +            || $f_operator eq '=~' 
 +            || $f_operator eq '!~') {
             $op = $f_operator;             $op = $f_operator;
         } elsif ($f_operator eq '='         } elsif ($f_operator eq '='
-                 | $f_operator eq '!=') {+                 || $f_operator eq '!=') {
             if (grep {$_ eq $f_param} @ascii_params) {             if (grep {$_ eq $f_param} @ascii_params) {
                 $msg_value =~ s/\s*$//;                 $msg_value =~ s/\s*$//;
Line 462: Line 471:
         }         }
  
-        if ($f_param eq 'wmonr' || $f_param eq 'buoy_id') { + # Some parameters might need special massaging 
-            # Make non octal by removing leading 0 +        if ($f_operator !~ /~/) { 
-            $msg_value =~ s/^0+//; +            if ($f_param eq 'wmonr' || $f_param eq 'buoy_id') { 
-            $f_value =~ s/^0+// if $f_value != 0; +                # Make non octal by removing leading 0 
-        } elsif ($f_param eq 'nationalnr') { +                $msg_value =~ s/^0+//; 
-            # Convert to a pure numerical value (float). For 001101 +                $f_value =~ s/^0+// if $f_value != 0; 
-            # State id only numbers between 100 and 699 are operational +            } elsif ($f_param eq 'nationalnr') { 
-            $msg_value =~ s/_0*/./; +                # Convert to a pure numerical value (float). For 001101 
-            $f_value =~ s/_0*/./; +                # State id only numbers between 100 and 699 are operational 
-        } elsif ($f_param eq 'obstime') { +                $msg_value =~ s/_0*/./; 
-            # Convert to a pure numerical value (float) +                $f_value =~ s/_0*/./; 
-            $msg_value =~ s/[-:]//g; +            } elsif ($f_param eq 'obstime') { 
-            $msg_value =~ s/ /./; +                # Convert to a pure numerical value (float) 
-            $f_value =~ s/[-:']//g; +                $msg_value =~ s/[-:]//g; 
-            $f_value =~ s/^ +//; +                $msg_value =~ s/ /./; 
-            $f_value =~ s/ +$//; +                $f_value =~ s/[-:']//g; 
-            $f_value =~ s/ /./; +                $f_value =~ s/^ +//; 
-        } elsif ($f_param eq 'name') { +                $f_value =~ s/ +$//; 
-            # Add or correct quoting to "" and ignore casing +                $f_value =~ s/ /./; 
-            $msg_value = '"' . lc $msg_value . '"'; +            } elsif ($f_param eq 'name') { 
-            $f_value = lc $f_value; +                # Add or correct quoting to "" and ignore casing 
-            if ($f_value =~ /^'.*'$/) { +                $msg_value = '"' . lc $msg_value . '"'; 
-                $f_value =~ s/^'//; +                $f_value = lc $f_value; 
-                $f_value =~ s/'$//; +                if ($f_value =~ /^'.*'$/) { 
-            } +                    $f_value =~ s/^'//; 
-            if ($f_value !~ /^".*"$/) { +                    $f_value =~ s/'$//; 
-                $f_value = '"' . $f_value . '"';+                } 
 +                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         # Finally, do the criterium check
-        if (eval "$msg_value $op $f_value") { + if (eval $condition) { 
-            # No need to check the remaining alternative criteria +     # No need to check the remaining alternative criteria 
-            $i += $num_alt if $num_alt; +     $i += $num_alt if $num_alt; 
-            next; +     next; 
-        } else { + } else { 
-            next if $num_alt; +     next if $num_alt; 
-            return 1; +     return 1; 
-        }+ }
     }     }
  
Line 514: Line 534:
     return if !$req_stations;     return if !$req_stations;
     die "Station list must start with 'wmonr=', 'nationalnr=', "     die "Station list must start with 'wmonr=', 'nationalnr=', "
-        . "'call_sign=', 'buoy_id=' or aircraft='"+        . "'call_sign=', 'buoy_id=', 'aircraft=' or 'wigosid='"
         unless $req_stations         unless $req_stations
-        =~ /^(wmonr=|nationalnr=|call_sign=|buoy_id=|aircraft=)/;+        =~ /^(wmonr=|nationalnr=|call_sign=|buoy_id=|aircraft=|wigosid=)/;
  
     my ($id, $rest) = split /=/, $req_stations;     my ($id, $rest) = split /=/, $req_stations;
Line 577: Line 597:
     }     }
  
-    my @ascii_params = qw(aircraft call_sign icao_id obstime name type);+    my @ascii_params = qw(aircraft call_sign icao_id obstime name type wigosid);
     my $lexical_sort = grep {$_ eq $sort_on} @ascii_params;     my $lexical_sort = grep {$_ eq $sort_on} @ascii_params;
  
Line 676: Line 696:
   --sort          Sort the decoded observations on station identification;   --sort          Sort the decoded observations on station identification;
                   first stations with wmonr, then stations with nationalnr,                   first stations with wmonr, then stations with nationalnr,
-                  call sign, buoy_id or aircraft (others left out)+                  call sign, buoy_id, aircraft 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 '-'
Line 699: Line 719:
                   Force observation type. If this option is not set,                   Force observation type. If this option is not set,
                   will make an educated guess of observation type                   will make an educated guess of observation type
-                  based on metadata in section 1 of each BUFR +                  based on metadata in section 1 of each BUFR message
-                  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})
Line 718: Line 737:
 temperature to be printed for a BUFR SYNOP file, either supply temperature to be printed for a BUFR SYNOP file, either supply
  
-  wmonr,call_sign,TA+  wmonr,nationalnr,call_sign,TA
  
 as argument to --params, or supply a <parameter file> which should as argument to --params, or supply a <parameter file> which should
Line 724: Line 743:
  
   wmonr   wmonr
 +  nationalnr
   call_sign   call_sign
   TA   TA
Line 744: Line 764:
 listing may for example start like listing may for example start like
  
-  wmonr,call_sign,TA +  wmonr;nationalnr;call_sign;TA 
-  01001,,-1.5 +  01001;;;-1.5 
-  ,LF5U,9.0+  ;;LF5U;9.0
  
-You can choose another delimiter than comma by use of option +You can choose another delimiter than semicolon by use of option 
---delimiter <del>, e.g. --csv --delimiter ';'+--delimiter <del>, e.g. --csv --delimiter ','
  
 Using --filter will decode only those observations that meet at least Using --filter will decode only those observations that meet at least
Line 756: Line 776:
 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> or <param> <operator> criteria which should match <param> or !<param> or <param> <operator>
-<value> where operator is one of =, !=, <, <=, > and >=. The parameter+<value> where operator is one of =, !=, =~, !~, <, <=, > and >=. What 
 +follows =~ and !~ should be a Perl match regular expression. The parameter
 criteria may be phrased as alternatives by separating them with '|' on criteria may be phrased as alternatives by separating them with '|' on
 a single line. An example filter file is a single line. An example filter file is
Line 775: Line 796:
  
 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 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'   obstime >= '2012-02-10 06:00:00'
-  RR_1 | RR_12 | RR_24 +  HW | HWA | PW | PWA 
-  TA < -30 | TA > 30+  FF > 10 | FG_010 > 10
  
-will print only those observations containing a wmonr (skipping ships), +will print only those ship observations for which the 4 character 
-and having obstime larger or equal to the datetime given, and +call_sign starts with 2 letters in the interval LA-LN, and having 
-containing precipitation for 1, 12 or 24 hours, and having temperature +obstime larger or equal to the datetime given, and containing wave 
-below minus 30 or above plus 30 degrees Celsius.+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 For convenience, when there are no BUFR descriptor criteria, you might
Line 813: Line 836:
   --station buoyid=64607,64609   --station buoyid=64607,64609
   --station aircraft=EU3421,JHCWUURA   --station aircraft=EU3421,JHCWUURA
 +  --station wigosid=0-376-0-511,0-20000-0-01492
  
 You cannot mix different kinds of stations this way (before '=' you You cannot mix different kinds of stations this way (before '=' you
-must choose either wmonr, nationalnr, call_sign, buoy_id or +must choose either wmonr, nationalnr, call_sign, buoy_id, aircraft or 
-aircraft). Note also that providing the stations in the BUFR +wigosid). Note also that providing the stations in the BUFR descriptor 
-descriptor part (first part) of the filter file will speed up +part (first part) of the filter file will speed up execution time 
-execution time considerably, compared to using option --station. It is +considerably, compared to using option --station. It is possible to 
-possible to combine --filter with --station if done with some care,+combine --filter with --station if done with some care,
 e.g. specifying WMO block 01 and the required parameters in filter e.g. specifying WMO block 01 and the required parameters in filter
 file, then the requested stations in station list. file, then the requested stations in station list.
Line 861: Line 885:
  
 =cut =cut
- 
 </code> </code>
  • bufr.pm/bufrdump.pl_source.txt
  • Last modified: 2022-05-31 09:29:31
  • (external edit)