From 086d17a8864e090cc21a841ce22def940bac414c Mon Sep 17 00:00:00 2001 From: Shahram Najm Date: Fri, 20 Dec 2013 17:50:58 +0000 Subject: [PATCH] Added Perl scripts for working with grib concepts etc --- definitions/check_grib_defs.pl | 300 ++++++++++++++++++++++++++++++++ definitions/compare_concepts.pl | 164 +++++++++++++++++ 2 files changed, 464 insertions(+) create mode 100755 definitions/check_grib_defs.pl create mode 100755 definitions/compare_concepts.pl diff --git a/definitions/check_grib_defs.pl b/definitions/check_grib_defs.pl new file mode 100755 index 000000000..2c61f031b --- /dev/null +++ b/definitions/check_grib_defs.pl @@ -0,0 +1,300 @@ +#!/usr/local/share/perl + +######################################################################################### +# Load in the definition files for GRIB "concepts" and check: +# 1. They have the same number of parameters +# 2. The params occur in the same order +# 3. Each parameter has same keys and values +# 4. Some basic rules are adhered to +# +# URLs: +# http://perldoc.perl.org/perldsc.html#MORE-ELABORATE-RECORDS +######################################################################################### +$|=1; +#use strict; +use Test::More; +use Data::Dumper; +use Cwd; + +my $GRIB1_MAX_TABLE2VERSION = 3; # The maximum allowable value for WMO GRIB1 table2Version +$extra_info= 0; # Do we print more info? +$debug = 0; +$check_duplicate_paramIDs = 0; # We tolerate this but maybe not for new data + +$errmsg = ""; +my $key; +my $pwd = getcwd; +$localConcept = 0; +# Determine if the parameters we are checking are LOCAL CONCEPTS or WMO ones +if ($pwd =~ /\/localConcepts\//) { + print "It's local concepts\n"; + $localConcept = 1; +} + +@files = qw(name.def paramId.def shortName.def units.def); +foreach my $f (@files) { + die "Where is $f?\nI expected to find: @files\n" unless -f $f; +} + +while (my $arg = shift @ARGV){ + if ($arg =~ /-D(\w+)=(\w+)/) { + $var_name = $1; $value = $2; + $$var_name = $value; + #$$1 = $2; same as above but more compact + } +} + +my %name_map = process("name.def"); +my $count = scalar(keys %name_map); + +ok($count > 0, "Check some params found"); +die "No params found" if ($count eq 0); + +my %paramId_map = process("paramId.def"); +print Data::Dumper->Dump([\%paramId_map], ["paramId_map"]), $/ if ($debug); + +if ($extra_info) { + # Define an array of all hashes: key -> hash + my @all_maps = (); + print "paramId.def: Num parameters = " . $count . " \n"; + print "paramId.def: Scanning for duplicate definitions...\n"; + my $num_duplicates = 0; + for $key (keys %paramId_map) { + @hashes = @{ $paramId_map{$key} }; + + #if (@hashes > 1) { + #print "\t$key: @{ $name_map{$key} }\n"; + # print Data::Dumper->Dump([\$name_map{$key}], ["Map for $key"]); + # ++$num_duplicates; + #} + # Iterate through the hashes array. Each entry in @hashes is a hash + foreach $ahash (@hashes) { + # See if our little map exists in the pool of all maps seen so far + #print Data::Dumper->Dump([\$ahash], ["Map for ahash"]); + for $m1 (@all_maps) { + #print "\t", Data::Dumper->Dump([\$m1], ["Map for m1"]); + #my $same = is_deeply(\$m1, \$ahash); + my $same = eq_hash(\$m1, \$ahash); + if ($same) { + print "\nThe following mapping occurs somewhere else!!\n"; + print "Key=$key,\t", Data::Dumper->Dump([\$ahash], [" "]); + #exit 2; + } + } + push(@all_maps, $ahash); + } + } + #print "DONE\n"; +} + +my %shortName_map = process("shortName.def"); +my %units_map = process("units.def"); + +# Check maps are the same +is_deeply(\%name_map, \%paramId_map, 'Check name and paramId are the same'); +is_deeply(\%name_map, \%shortName_map, 'Check name and shortName are the same'); +is_deeply(\%name_map, \%units_map, 'Check name and units are the same'); + +if (-f "cfVarName.def") { + my %cfVar_map = process("cfVarName.def"); + is_deeply(\%name_map, \%cfVar_map, 'Check name and cfVarName are the same'); +} else { + print "\nNote: Did not find a cfVarName.def file\n\n"; +} + +done_testing(); + +check_paramIDs("paramId.def"); + + +# ------------------------------------------------------------------------- +# Function to return a hash: +# key = parameter long name +# value = an array holding 1 or more hashes +# +# E.g. +# hash = { +# 'Reactive tracer 10 mass mixing ratio' => [ +# { +# 'parameterCategory' => '210', +# 'parameterNumber' => '149', +# 'discipline' => '192' +# }, +# { +# 'parameterCategory' => '211', +# 'parameterNumber' => '149', +# 'discipline' => '192' +# } +# ], +# 'downward shortwave radiant flux density' => [ +# { +# 'parameterCategory' => '201', +# 'parameterNumber' => '1', +# 'discipline' => '192' +# } +# ], +# .... etc +# +# ------------------------------------------------------------------------- +sub process { + my ($filename) = @_; + open FILE, $filename or die "Tried to open $filename\n$!"; + my @lines = ; + close(FILE); + + my $error = 0; # boolean: 1 if at least one error encountered + my %map1 = (); + my %map2 = (); # inner map + my $lineNum = 0; + my $desc = ""; + my $concept = ""; + my $this; # a line in file + foreach $this (@lines) { + $lineNum++; + chomp $this; + if ($lineNum == 1 && $this !~ /^#/ ) { + die "File: $filename, first line should be a comment!"; + } + # Description line + if ($this =~ /^\s*#\s*(.*)\s*/) { + $desc = $1; + $desc =~ s/^\s+//; #remove leading spaces + $desc =~ s/\s+$//; #remove trailing spaces + die "File: $filename, line: $lineNum: Empty description" if ($desc eq ""); + } + # key = value + elsif ($this =~ /(\w+)\s*=\s*([^ ]+)\s*;/ && $desc) { + $key = $1; + $val = $2; + if (!is_valid_keyval($key, $val, $localConcept)) { + $error = 1; + print "File: $filename, line: $lineNum: $errmsg (name=$desc)\n"; + } + # Users will set parameters by shortname or ID + if ($filename eq 'paramId.def' || $filename eq 'shortName.def') { + # The 'typeOfSecondFixedSurface' key has side effects and can change the scale values/factors! + # So make sure it comes BEFORE the scale keys! i.e. if we find a scale key then our map should have + # the typeOf key since it came before + if ($key =~ /scale.*OfSecondFixedSurface/ && !exists($map2{'typeOfSecondFixedSurface'})) { + print "File: $filename, line: $lineNum: 'Type of Surface' problem: Please check: $desc\n"; + #$error = 1; + } + if ($key =~ /typeOfSecondFixedSurface/ && exists($map2{'typeOfFirstFixedSurface'})) { + print "File: $filename, line: $lineNum: TypeOf1 before TypeOf2 problem: Please check: $desc\n"; + } + } + $map2{$key} = $val; + } + elsif ($this =~ /'(.*)'.*=/) { + $concept = $1; + if ($filename eq 'cfVarName.def') { + if ($concept =~ /^[0-9]/) { + $error = 1; + die "File: $filename, line: $lineNum: Invalid netcdf variable name: $concept"; + } + } + } + # Hit the end brace + elsif ($this =~ /^\s*}\s*$/) { + my %map2_copy = %map2; # copy inner hash + # Store this inner hash in our array + push @{ $map1{$desc} }, \%map2_copy; + %map2 = (); # Empty inner map for next param + } + } + exit 1 if $error; + return (%map1); +} +################################### +sub is_valid_keyval { + my $key = shift; + my $val = shift; + my $local = shift; + return 0 if (!is_valid_octet($key,$val)); + return 0 if (!is_valid_table2Version($key,$val,$local)); + return 0 if (!is_goodval($key,$val)); + + return 1; +} + +sub is_valid_octet { + my $key = shift; + my $val = shift; + # Rule: Some keys are are only 1 octet so can only be 0->255 + if ($val > 255 || $val < 0) { + if ($key eq 'discipline' || $key eq 'parameterCategory' || $key eq 'parameterNumber' || + $key eq 'indicatorOfParameter' || $key eq 'table2Version') + { + $errmsg = "Bad $key: \"$val\". Can only be 0->255"; + return 0; + } + } + return 1; +} + +sub is_valid_table2Version { + my $key = shift; + my $val = shift; + my $is_local = shift; + if (!$is_local && $key eq 'table2Version') { + # GRIB edition 1 rule: in the WMO dir, table2Version <= 3 + if ($val > $GRIB1_MAX_TABLE2VERSION) { + $errmsg = "Bad table2Version: \"$val\". Is this a local concept?"; + return 0; + } + } + return 1; +} + +sub is_goodval { + my $key = shift; + my $val = shift; + + if ($key eq 'discipline' || $key eq 'parameterCategory' || $key eq 'parameterNumber' || + $key eq 'indicatorOfParameter' || $key eq 'table2Version') + { + if (!is_integer($val)) { + $errmsg = "Invalid value for $key: \"$val\". Expected a number!"; + return 0; + } + } + return 1; +} + +sub is_integer { + my $val = shift; + return ($val =~ /^\d+$/); +} + +################ +sub check_paramIDs { + my ($filename) = @_; + open FILE, $filename or die "Tried to open $filename\n$!"; + my @lines = ; + close(FILE); + + my $warnings = 0; # count of the number of warnings + my %id_map = (); + my $lineNum = 0; + my $a_pid; # a parameter ID + my $this; # a line in file + foreach $this (@lines) { + $lineNum++; + chomp $this; + # a parameter ID + if ($this =~ /^\s*'(.*)'\s*/) { + $a_pid = $1; + die "File: $filename, line: $lineNum: paramID \"$a_pid\" is not an integer!" if (!is_integer($a_pid)); + + if ($check_duplicate_paramIDs) { + if (exists $id_map{$a_pid}) { + print "WARNING: File: $filename, line: $lineNum: Duplicate paramID found: $a_pid\n"; + $warnings++; + } else { + $id_map{$a_pid} = 1; + } + } + } + } + print "**\n* Duplicate paramIDs: Encountered $warnings warning(s)\n**\n" if ($warnings>0); +} diff --git a/definitions/compare_concepts.pl b/definitions/compare_concepts.pl new file mode 100755 index 000000000..70a9f2fc0 --- /dev/null +++ b/definitions/compare_concepts.pl @@ -0,0 +1,164 @@ +#! /usr/local/apps/perl/current/bin/perl + +######################################################################################### +# Program to read in two files (e.g. name.def, paramId.def, shortName.def or units.def) +# and check +# 1. They have the same number of parameters +# 2. They occur in the same order +# 3. And each param is defined in exactly the same way +# For each parameter we store its keys in the order encountered +# in the files and compare. +# +# Usage: +# $0 file1 file2 +# +# URLs: +# http://perldoc.perl.org/perldsc.html#MORE-ELABORATE-RECORDS +######################################################################################### + +$|=1; +#use strict; +use Test::More; +use Data::Dumper; +#use Algorithm::Diff qw[ diff ]; +use Algorithm::Diff::Callback 'diff_hashes'; + +$extra_info= 0; # Do we print more info? +$debug = 0; +my $key; my @values; + +die "Bad args. Expected two files" if (scalar @ARGV < 2); +$file1 = $ARGV[0]; +$file2 = $ARGV[1]; +print "Comparing $file1 and $file2\n"; +#die "File extension should be '.def'" if $file1 !~ /\.def$/; +#die "File extension should be '.def'" if $file2 !~ /\.def$/; + +while (my $arg = shift @ARGV){ + if ($arg =~ /-D(\w+)=(\w+)/) { + $var_name = $1; $value = $2; + $$var_name = $value; + } +} + +my %map1 = process("$file1"); +my %map2 = process("$file2"); +my $count1 = scalar(keys %map1); +my $count2 = scalar(keys %map2); + +# Compare hashes +if ($compare) { + print "Compare hashes...\n"; + diff_hashes( + \%map1, + \%map2, + sub { print "\nLost ", shift }, + sub { print "\nGained ", shift }, + undef, + ); +} +#diff_hashes( +# \%map1, +# \%map2, +# sub { print 'Lost ', shift }, +# sub { print 'Gained ', shift }, +# sub { +# my ( $key, $before, $after ) = @_; +# print "$key changed from $before to $after\n"; +# }, +# ); + +#@diffs = diff( \%map1, \%map2 ); +#exit 0; +#print @$_ for map{ +# @$_ +#} diff( +# [ split "\n", Dumper( \%map1 ) ], +# [ split "\n", Dumper( \%map2 ) ] +#); + +print "\nTesting now...\n"; +ok($count1==$count2, "Same number of elements"); +ok($count1 > 0 && $count2 > 0, "Check some params found"); + +#print "count1=$count1, count2=$count2\n"; + +# Check name maps are the same +is_deeply(\%map1, \%map2, 'Check hashes are the same'); + +print Data::Dumper->Dump([\%map1], ["Name Map1"]), $/ if ($debug); + +done_testing(); + +# ------------------------------------------------------------------------- +# Function to return a hash: +# key = parameter long name +# value = an array holding 1 or more hashes +# We use a trick to store the main title e.g. units, paramId in they key "
" +# E.g. +# hash = { +# 'Reactive tracer 10 mass mixing ratio' => [ +# { +# 'parameterCategory' => '210', +# 'parameterNumber' => '149', +# 'discipline' => '192' +# }, +# { +# 'parameterCategory' => '211', +# 'parameterNumber' => '149', +# 'discipline' => '192' +# } +# ], +# 'downward shortwave radiant flux density' => [ +# { +# 'parameterCategory' => '201', +# 'parameterNumber' => '1', +# 'discipline' => '192' +# } +# ], +# .... etc +# +# ------------------------------------------------------------------------- +sub process { + my ($filename) = @_; + + open FILE, $filename or die "Tried to open $filename\n$!"; + my @lines = ; + close(FILE); + + my %map1 = (); + my %map2 = (); # inner map + my $lineNum = 0; + my $desc = ""; + my $this; # a line in file + foreach $this (@lines) { + $lineNum++; + chomp $this; + #if ($lineNum == 1 && $this !~ /Automatically generated by/ ) { + # die "File: $filename, Line 1: Should say 'Automatically generated'"; + #} + #next if ($lineNum == 1); # always skip first line + # Description line + if ($this =~ /^\s*#\s*(.*)\s*/) { + $desc = $1; + die "File: $filename, Empty description" if ($desc eq ""); + } + # 'something' = { + elsif ($this =~ /^'(.*)'\s*=\s*{\s*$/ && $desc) { + $map2{"
"} = $1; + } + # key = value + elsif ($this =~ /(\w+)\s*=\s*([^ ]+)\s*;/ && $desc) { + $key = $1; $val = $2; + $map2{$key} = $val; + } + # Hit the end brace + elsif ($this =~ /^\s*}\s*$/) { + my %map2_copy = %map2; # copy inner hash + # Store this inner hash in our array + push @{ $map1{$desc} }, \%map2_copy; + %map2 = (); # Empty inner map for next param + } + } + return (%map1); +}