1#!/usr/bin/env perl
2
3#
4# (C) Copyright 2005- ECMWF.
5#
6# This software is licensed under the terms of the Apache Licence Version 2.0
7# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
8#
9# In applying this licence, ECMWF does not waive the privileges and immunities
10# granted to it by virtue of its status as an intergovernmental organisation
11# nor does it submit to any jurisdiction.
12#
13
14#########################################################################################
15# Load in the definition files for GRIB "concepts" and check:
16#  1. They have the same number of parameters
17#  2. The params occur in the same order
18#  3. Each parameter has same keys and values
19#  4. Some basic rules are adhered to
20#
21# URLs:
22#  http://perldoc.perl.org/perldsc.html#MORE-ELABORATE-RECORDS
23#########################################################################################
24$|=1;
25#use strict;
26use Test::More;
27use Data::Dumper;
28use Cwd;
29
30my $GRIB1_MAX_TABLE2VERSION = 3;  # The maximum allowable value for WMO GRIB1 table2Version
31$extra_info= 0;                   # Do we print more info?
32$debug = 0;
33$check_duplicate_paramIDs = 0;    # We tolerate this but maybe not for new data
34
35$errmsg = "";
36my $key;
37my $pwd = getcwd;
38$localConcept = 0;
39# Determine if the parameters we are checking are LOCAL CONCEPTS or WMO ones
40if ($pwd =~ /\/localConcepts\//) {
41    print "It's local concepts\n";
42    $localConcept = 1;
43}
44
45@files = qw(name.def paramId.def shortName.def units.def);
46foreach my $f (@files) {
47    die "Where is $f?\nI expected to find: @files\n" unless -f $f;
48}
49
50while (my $arg = shift @ARGV){
51    if ($arg =~ /-D(\w+)=(\w+)/) {
52        $var_name = $1; $value = $2;
53        $$var_name = $value;
54        #$$1 = $2;  same as above but more compact
55    }
56}
57
58my %name_map = process("name.def");
59my $count = scalar(keys %name_map);
60
61ok($count > 0, "Check some params found");
62die "No params found." if ($count eq 0);
63
64my %paramId_map   = process("paramId.def");
65print Data::Dumper->Dump([\%paramId_map], ["paramId_map"]), $/ if ($debug);
66
67if ($extra_info) {
68    # Define an array of all hashes: key -> hash
69    my @all_maps = ();
70    print "paramId.def: Num parameters = " . $count . " \n";
71    print "paramId.def: Scanning for duplicate definitions...\n";
72    my $num_duplicates = 0;
73    for $key (keys %paramId_map) {
74        @hashes = @{ $paramId_map{$key} };
75
76        #if (@hashes > 1) {
77            #print "\t$key: @{ $name_map{$key} }\n";
78        #    print Data::Dumper->Dump([\$name_map{$key}], ["Map for $key"]);
79        #    ++$num_duplicates;
80        #}
81        # Iterate through the hashes array. Each entry in @hashes is a hash
82        foreach $ahash (@hashes) {
83            # See if our little map exists in the pool of all maps seen so far
84            #print Data::Dumper->Dump([\$ahash], ["Map for ahash"]);
85            for $m1 (@all_maps) {
86                #print "\t", Data::Dumper->Dump([\$m1], ["Map for m1"]);
87                #my $same = is_deeply(\$m1, \$ahash);
88                my $same = eq_hash(\$m1, \$ahash);
89                if ($same) {
90                    print "\nThe following mapping occurs somewhere else!!\n";
91                    print "Key=$key,\t", Data::Dumper->Dump([\$ahash], [" "]);
92                    #exit 2;
93                }
94            }
95            push(@all_maps, $ahash);
96        }
97    }
98    #print "DONE\n";
99}
100
101my %shortName_map = process("shortName.def");
102my %units_map     = process("units.def");
103
104# Check maps are the same
105is_deeply(\%name_map, \%paramId_map,   'Check name and paramId are the same');
106is_deeply(\%name_map, \%shortName_map, 'Check name and shortName are the same');
107is_deeply(\%name_map, \%units_map,     'Check name and units are the same');
108
109if (-f "cfVarName.def") {
110   my %cfVar_map     = process("cfVarName.def");
111   is_deeply(\%name_map, \%cfVar_map, 'Check name and cfVarName are the same');
112} else {
113   print "\n\tWARNING: Did not find a cfVarName.def file!!!\n\n";
114}
115
116done_testing();
117
118check_paramIDs("paramId.def");
119
120
121# -------------------------------------------------------------------------
122# Function to return a hash:
123#    key   = parameter long name
124#    value = an array holding 1 or more hashes
125#
126# E.g.
127# hash = {
128#  'Reactive tracer 10 mass mixing ratio' => [
129#       {
130#           'parameterCategory' => '210',
131#           'parameterNumber' => '149',
132#           'discipline' => '192'
133#       },
134#       {
135#           'parameterCategory' => '211',
136#           'parameterNumber' => '149',
137#           'discipline' => '192'
138#       }
139#   ],
140#  'downward shortwave radiant flux density' => [
141#       {
142#           'parameterCategory' => '201',
143#           'parameterNumber' => '1',
144#           'discipline' => '192'
145#       }
146#   ],
147# .... etc
148#
149# -------------------------------------------------------------------------
150sub process {
151    my ($filename) = @_;
152    open FILE, $filename or die "Tried to open $filename\n$!";
153    my @lines = <FILE>;
154    close(FILE);
155    print "Processing $filename\n";
156
157    my $error = 0; # boolean: 1 if at least one error encountered
158    my %map1 = ();
159    my %map2 = ();  # inner map
160    my $lineNum = 0;
161    my $desc = "";
162    my $concept = "";
163    my $this;           # a line in file
164    foreach $this (@lines) {
165        $lineNum++;
166        chomp $this;
167        if ($lineNum == 1 && $this !~ /^#/ ) {
168            die "File: $filename, first line should be a comment!";
169        }
170        # Description line
171        if ($this =~ /^\s*#\s*(.*)\s*/) {
172            $desc = $1;
173            $desc =~ s/^\s+//;  #remove leading spaces
174            $desc =~ s/\s+$//;  #remove trailing spaces
175            die "File: $filename, line: $lineNum: Description contains invalid characters." if (non_printable($desc));
176            die "File: $filename, line: $lineNum: Empty description." if ($desc eq "");
177        }
178        # key = value
179        elsif ($this =~ /(\w+)\s*=\s*([^ ]+)\s*;/ && $desc) {
180            $key = $1;
181            $val = $2;
182            if (!is_valid_keyval($key, $val, $localConcept)) {
183                $error = 1;
184                print "File: $filename, line: $lineNum: $errmsg (name=$desc)\n";
185            }
186            # Users will set parameters by shortname or ID
187            if ($filename eq 'paramId.def' || $filename eq 'shortName.def') {
188                # The 'typeOfSecondFixedSurface' key has side effects and can change the scale values/factors!
189                # So make sure it comes BEFORE the scale keys! So if we come across this key ensure none of
190                # scale keys came before it
191                if ( $key =~ /typeOfSecondFixedSurface/ &&
192                    (exists($map2{'scaleFactorOfFirstFixedSurface'}) ||
193                     exists($map2{'scaledValueOfFirstFixedSurface'}) ||
194                     exists($map2{'scaleFactorOfSecondFixedSurface'}) ||
195                     exists($map2{'scaledValueOfSecondFixedSurface'})) )
196                {
197                    print "File: $filename, line: $lineNum: TypeOfSurface issue: Please check: \"$desc\" ($concept)\n";
198                    print "      Make sure the 'typeOfSecondFixedSurface' key comes BEFORE all the scale keys\n";
199                    #print "DUMP,\t", Data::Dumper->Dump([\%map2], [" "]);
200                    $error = 1;
201                }
202            }
203            $map2{$key} = $val;
204        }
205        elsif ($this =~ /'(.*)' *= *{/) {
206            $concept = $1;
207            die "File: $filename, line: $lineNum: Value contains invalid characters." if (non_printable($concept));
208            if ($filename eq 'cfVarName.def') {
209               #if ($concept =~ /^[0-9]/) {
210               # Check CF naming convention. Do not allow numeric initial char or ~
211               if ($concept !~ /^[A-z]/) {
212                  $error = 1;
213                  die "File: $filename, line: $lineNum: Invalid netcdf variable name: $concept";
214               }
215            }
216        }
217        # Hit the end brace
218        elsif ($this =~ /^\s*}\s*$/) {
219            my %map2_copy = %map2;  # copy inner hash
220            # Store this inner hash in our array
221            push @{ $map1{$desc} }, \%map2_copy;
222            %map2 = ();             # Empty inner map for next param
223        }
224    }
225    exit 1 if $error;
226    return (%map1);
227}
228###################################
229sub is_valid_keyval {
230    my $key = shift;
231    my $val = shift;
232    my $local = shift;
233    return 0 if (!is_valid_octet($key,$val));
234    return 0 if (!is_valid_table2Version($key,$val,$local));
235    return 0 if (!is_goodval($key,$val));
236
237    return 1;
238}
239
240sub is_valid_octet {
241    my $key = shift;
242    my $val = shift;
243    # Rule: Some keys are are only 1 octet so can only be 0->255
244    if ($val > 255 || $val < 0) {
245        if ($key eq 'discipline' || $key eq 'parameterCategory' || $key eq 'parameterNumber' ||
246             $key eq 'indicatorOfParameter' || $key eq 'table2Version')
247        {
248            $errmsg = "Bad $key: \"$val\". Can only be 0->255";
249            return 0;
250        }
251    }
252    return 1;
253}
254
255sub is_valid_table2Version {
256    my $key = shift;
257    my $val = shift;
258    my $is_local = shift;
259    if (!$is_local && $key eq 'table2Version') {
260        # GRIB edition 1 rule: in the WMO dir, table2Version <= 3
261        if ($val > $GRIB1_MAX_TABLE2VERSION) {
262            $errmsg = "Bad table2Version: \"$val\". Is this a local concept?";
263            return 0;
264        }
265    }
266    return 1;
267}
268
269sub is_goodval {
270    my $key = shift;
271    my $val = shift;
272
273    if ($key eq 'discipline' || $key eq 'parameterCategory' || $key eq 'parameterNumber' ||
274        $key eq 'indicatorOfParameter' || $key eq 'table2Version')
275    {
276        if (!is_integer($val)) {
277            $errmsg = "Invalid value for $key: \"$val\". Expected a number!";
278            return 0;
279        }
280    }
281    return 1;
282}
283
284sub is_integer {
285    my $val = shift;
286    return ($val =~ /^\d+$/);
287}
288
289sub non_printable {
290    my $str = shift;
291    return ($str =~ /[^[:ascii:]]/);
292}
293
294################
295sub check_paramIDs {
296    my ($filename) = @_;
297    open FILE, $filename or die "Tried to open $filename\n$!";
298    my @lines = <FILE>;
299    close(FILE);
300
301    my $warnings = 0; # count of the number of warnings
302    my %id_map = ();
303    my $lineNum = 0;
304    my $a_pid; # a parameter ID
305    my $this;           # a line in file
306    foreach $this (@lines) {
307        $lineNum++;
308        chomp $this;
309        # a parameter ID
310        if ($this =~ /^\s*'(.*)'\s*/) {
311            $a_pid = $1;
312            die "File: $filename, line: $lineNum: paramID \"$a_pid\" is not an integer!" if (!is_integer($a_pid));
313
314            if ($check_duplicate_paramIDs) {
315                if (exists $id_map{$a_pid}) {
316                    print "WARNING: File: $filename, line: $lineNum: Duplicate paramID found: $a_pid\n";
317                    $warnings++;
318                } else {
319                    $id_map{$a_pid} = 1;
320                }
321            }
322        }
323    }
324    print "**\n* Duplicate paramIDs: Encountered $warnings warning(s)\n**\n" if ($warnings>0);
325}
326