"Fossies" - the Fresh Open Source Software Archive

Member "fimex-1.4.1/share/scripts/fiConfigOverview.pl" (30 Oct 2019, 16657 Bytes) of package /linux/privat/fimex-1.4.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "fiConfigOverview.pl" see the Fossies "Dox" file reference documentation.

    1 #! /usr/bin/perl -w
    2 
    3 =head1 NAME
    4 
    5 fiConfigOverview - create overview tables of fimex config
    6 
    7 =head1 SYNOPSIS
    8 
    9 fiConfigOverview -i DIR/FILES -o OUT.html
   10 
   11 =head1 DESCRIPTION
   12 
   13 fiConfigOverview read a single or a directory of fimex input/output
   14 xml-configuration files and writes an overview-table in html format.
   15 
   16 =head2 OPTIONS
   17 
   18 =over8
   19 
   20 =item -h
   21 
   22 help
   23 
   24 =item -i
   25 
   26 comma-separated list of files or directories
   27 
   28 =item -o
   29 
   30 output-file
   31 
   32 =back
   33 
   34 =head1 AUTHOR
   35 
   36 Heiko Klein, E<lt>Heiko.Klein@met.noE<gt>
   37 
   38 =head1 SEE ALSO
   39 
   40 https://wiki.met.no/fimex/
   41 
   42 =cut
   43 
   44 use 5.6.1;
   45 use strict;
   46 use warnings;
   47 use Pod::Usage qw(pod2usage);
   48 use Getopt::Std qw(getopts);
   49 use File::Find  qw();
   50 
   51 our %Args;
   52 our @Args = @ARGV;
   53 $Args{o} = '-';
   54 getopts('hi:o:', \%Args)
   55     or pod2usage(2);
   56 pod2usage(-exitval => 0,
   57           -verbose => 2) if $Args{h};
   58 pod2usage(-exitval => 2,
   59           -msg => "Unkown emission input -i") unless ($Args{i});
   60 
   61 File::Find::find({
   62     wanted => sub {-f $_ && Fimex::Config::parseFile($File::Find::name);},
   63     follow => 1,
   64     no_chdir => 1,
   65 }, split (',', $Args{i}));
   66 
   67 Fimex::Config::writeHtml($Args{o});
   68 
   69 
   70 #####################################################################
   71 
   72 package Fimex::Config;
   73 use Carp qw(carp);
   74 our %content; # type => id => Fimex::Config::Content object
   75 
   76 use constant DEBUG => 0;
   77 
   78 use constant NAMESPACES => {
   79     gr => 'http://www.met.no/schema/fimex/cdmGribReaderConfig',
   80     ncml => 'http://www.unidata.ucar.edu/namespaces/netcdf/ncml-2.2',
   81 };
   82 
   83 use constant IGNORE_APX => [qw(dtd xsd cfg ~)];
   84 
   85 use constant FILETYPES => {
   86     "gr:cdmGribReaderConfig" => \&parseGribReader,
   87     'ncml:netcdf' => \&ignore,
   88     "cdm_felt_config" => \&parseFeltConfig,
   89         # XINCLUDEs for cdm_felt_config
   90         "variables" => \&parseFeltConfig,
   91         'global_attributes' => \&ignore,
   92         'axes' => \&ignore,
   93     'cdm_gribwriter_config' => \&parseGribWriter,
   94     'cdm_ncwriter_config' => \&ignore,
   95     'cdmQualityConfig' => \&ignore,
   96     'gribFileIndex' => \&ignore,
   97     'metgm_config' => \&ignore,
   98 };
   99 
  100 
  101 sub parseFile {
  102     my ($file) = @_;
  103 
  104     # ignore all .-files or files in .-directories
  105     return if $file =~ /\/\./;
  106     foreach my $apx (@{IGNORE_APX()}) {
  107         if ($file =~ /\Q$apx\E$/) {
  108             print STDERR "ignore $file $apx\n" if DEBUG;
  109             return;
  110         }
  111     }
  112 
  113     # late loading of external modules
  114     require XML::LibXML;
  115     require XML::LibXML::XPathContext;
  116 
  117     eval {
  118         my $doc = XML::LibXML->load_xml(location => $file,
  119                                         no_blanks => 1);
  120         my $xpc = XML::LibXML::XPathContext->new($doc);
  121         while (my ($prefix, $uri) = each %{NAMESPACES()}) {
  122             $xpc->registerNs($prefix, $uri);
  123         }
  124         my $found = 0;
  125         my @content;
  126         foreach my $rootPath (keys %{FILETYPES()}) {
  127             if ($xpc->exists($rootPath)) {
  128                 @content = FILETYPES->{$rootPath}->($file, $xpc, $doc);
  129                 $found++;
  130                 print STDERR "found $rootPath in $file\n" if DEBUG;
  131                 last;
  132             }
  133         }
  134         if ($found) {
  135             addContent(@content);
  136         } else {
  137             print STDERR "unknown xml-file: $file\n";
  138         }
  139     }; if ($@) {
  140         if ($@ =~ /parser error/) {
  141             print STDERR "invalid xml-file: $file\n";
  142         } else {
  143             die $@;
  144         }
  145         return;
  146     }
  147 }
  148 
  149 sub addContent {
  150     my @content = @_;
  151     foreach my $c (@content) {
  152         if (exists $content{$c->type}{$c->id}) {
  153             $content{$c->type}{$c->id}->merge($c);
  154         } else {
  155             $content{$c->type}{$c->id} = $c;
  156         }
  157     }
  158 }
  159 
  160 sub parseGribReader {
  161     my ($filename, $xpc, $doc) = @_;
  162     my @content;
  163     foreach my $node ($xpc->findnodes("/gr:cdmGribReaderConfig/gr:variables/gr:parameter")) {
  164         my $xml = $node->toString(1);
  165         my $varName;
  166         my %attr = map {$_->getName => $_->getValue} $node->attributes;
  167         $varName = $attr{name};
  168         my ($longName, $metnoName, $unit, $standardName);
  169         foreach my $attNode ($xpc->findnodes("gr:attribute", $node)) {
  170             my %attr = map {$_->getName => $_->getValue} $attNode->attributes;
  171             if ($attr{name} eq "units") {
  172                 $unit = $attr{value};
  173             } elsif ($attr{name} eq "long_name") {
  174                 $longName = $attr{value};
  175             } elsif ($attr{name} eq "standard_name") {
  176                 $standardName = $attr{value};
  177             } elsif ($attr{name} eq "metno_name") {
  178                 $metnoName = $attr{value};
  179             }
  180         }
  181         foreach my $param ($xpc->findnodes("gr:grib1", $node)) {
  182             my %attr = map {$_->getName => $_->getValue} $param->attributes;
  183             my @idTerms = map {exists $attr{$_} ? ($attr{$_}) : ("")} qw(indicatorOfParameter gribTablesVersionNo identificationOfOriginatingGeneratingCentre typeOfLevel);
  184             my $id = join ",", @idTerms;
  185             push @content, Fimex::Config::Content::Grib1->new($id, $xml, $filename, $unit, $standardName, $varName, $longName, $metnoName);
  186         }
  187         foreach my $param ($xpc->findnodes("gr:grib2", $node)) {
  188             my %attr = map {$_->getName => $_->getValue} $param->attributes;
  189             my @idTerms = map {exists $attr{$_} ? ($attr{$_}) : ("")} qw(discipline parameterCategory parameterNumber typeOfLevel);
  190             my $id = join ",", @idTerms;
  191             push @content, Fimex::Config::Content::Grib2->new($id, $xml, $filename, $unit, $standardName, $varName, $longName, $metnoName);
  192         }
  193     }
  194     return @content;
  195 }
  196 
  197 sub parseGribWriter {
  198     my ($fileName, $xpc, $doc) = @_;
  199     my @content;
  200     foreach my $node ($xpc->findnodes("//variables/parameter")) {
  201         my $xml = $node->toString(1);
  202         my ($varName, $level, $standardName);
  203         my ($longName, $metnoName) = ("", "");
  204         my %attr = map {$_->getName => $_->getValue} $node->attributes;
  205         $varName = $attr{name} || "";
  206         $level = $attr{level} || "";
  207         $standardName = $attr{standard_name} || "";
  208         foreach my $param ($xpc->findnodes("grib1", $node)) {
  209             my %attr = map {$_->getName => $_->getValue} $param->attributes;
  210             my @idTerms = map {exists $attr{$_} ? ($attr{$_}) : ("")} qw(parameterNumber codeTable identificationOfOriginatingGeneratingCentre typeOfLevel);
  211             my $id = join ",", @idTerms;
  212             $id .= ",level=$level" if $level;
  213             push @content, Fimex::Config::Content::Grib1->new($id, $xml, $fileName, $attr{units}, $standardName, $varName, $longName, $metnoName);
  214         }
  215         foreach my $param ($xpc->findnodes("grib2", $node)) {
  216             my %attr = map {$_->getName => $_->getValue} $param->attributes;
  217             my @idTerms = map {exists $attr{$_} ? ($attr{$_}) : ("")} qw(discipline parameterCategory parameterNumber typeOfLevel);
  218             my $id = join ",", @idTerms;
  219             $id .= ",level=$level" if $level;
  220             push @content, Fimex::Config::Content::Grib2->new($id, $xml, $fileName, $attr{units}, $standardName, $varName, $longName, $metnoName);
  221         }
  222     }
  223     return @content;
  224 }
  225 
  226 sub parseFeltConfig {
  227     my ($fileName, $xpc, $doc) = @_;
  228     my @content;
  229     foreach my $node ($xpc->findnodes("//variables/parameter")) {
  230         my $xml = $node->toString(1);
  231         my ($varName, $id);
  232         my %attr = map {$_->getName => $_->getValue} $node->attributes;
  233         $varName = $attr{name};
  234         $id = $attr{id};
  235         my ($longName, $metnoName, $unit, $standardName);
  236         foreach my $attNode ($xpc->findnodes("attribute", $node)) {
  237             my %attr = map {$_->getName => $_->getValue} $attNode->attributes;
  238             if ($attr{name} eq "units") {
  239                 $unit = $attr{value};
  240             } elsif ($attr{name} eq "long_name") {
  241                 $longName = $attr{value};
  242             } elsif ($attr{name} eq "standard_name") {
  243                 $standardName = $attr{value};
  244             } elsif ($attr{name} eq "metno_name") {
  245                 $metnoName = $attr{value};
  246             }
  247         }
  248         push @content, Fimex::Config::Content::Felt->new($id, $xml, $fileName, $unit, $standardName, $varName, $longName, $metnoName);
  249     }
  250     return @content;
  251 }
  252 
  253 sub ignore {
  254     my ($fileName, $xpc, $doc) = @_;
  255     print STDERR "ignore $fileName\n" if DEBUG;
  256     return ();
  257 }
  258 
  259 
  260 sub writeHtml {
  261     my ($outFile) = @_;
  262 
  263     open HTML, ">$outFile"
  264         or die "Cannot write $outFile: $!\n";
  265     print HTML <<'EOT';
  266 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
  267 <html>
  268 <head>
  269 <meta http-equiv="content-type" content="text/html; charset=UTF-8">
  270 <meta name="author" content="Heiko Klein, heiko.klein@met.no">
  271 <style type="text/css">
  272 <!--
  273 #main
  274 {
  275   padding: 0;
  276   margin: 0;
  277   border-collapse: collapse;
  278   border: 1px solid #333;
  279   font-family: Verdana, Arial, Helvetica, sans-serif;
  280   font-size: 0.9em;
  281   color: #000;
  282 }
  283 
  284 #main caption
  285 {
  286   caption-side: bottom;
  287   font-size: 0.9em;
  288   font-style: italic;
  289   text-align: right;
  290   padding: 0.5em 0;
  291 }
  292 
  293 #main td
  294 {
  295   border: 1px dotted #666;
  296   padding: 0.5em;
  297   text-align: left;
  298 }
  299 
  300 .hidden
  301 {
  302     display: none;
  303 }
  304 
  305 .explanation {
  306   font-family: Verdana, Arial, Helvetica, sans-serif;
  307   font-size: 0.9em;
  308 }
  309 
  310 -->
  311 </style>
  312 <link rel="stylesheet" href="http://code.jquery.com/ui/1.8.21/themes/redmond/jquery-ui.css" type="text/css" media="all" />
  313 <script src="http://code.jquery.com/jquery-1.7.2.min.js" type="text/javascript"></script>
  314 <script src="http://fimex.met.no/js/colResizable-1.3.min.js" type="text/javascript"></script>
  315 <script src="http://code.jquery.com/ui/1.8.21/jquery-ui.min.js" type="text/javascript"></script>
  316 <script src="http://fimex.met.no/js/stupidtable.min.js" type="text/javascript"></script>
  317 <script type="text/javascript">
  318 <!--
  319 "use strict";
  320 EOT
  321     print HTML 'var fiConf = ', Fimex::JSON::encode(\%content),";\n";
  322     print HTML <<'EOT';
  323 -->
  324 </script>
  325 <script type="text/javascript">
  326 <!--
  327 "use strict";
  328 // indexed-array to all rows from fiConf
  329 var fiConfRows = [];
  330 
  331 function tableRowDialog(elem, rowNo) {
  332     $(document.createElement('div')).attr({title: fiConfRows[rowNo]["varName"] + " " + $(elem).text()})
  333     .append(fiConfRows[rowNo]["fileName"])
  334     .append($(document.createElement('pre')).text(fiConfRows[rowNo]["xml"]))
  335     .dialog({ width: 640 });
  336 }
  337 
  338 $(document).ready(function() {
  339 var cols = ["varName", "unit", "standardName", "grib1Id", "grib2Id", "feltId", "longName", "metnoName"];
  340 var type, id, i, j, k;
  341 var $col, $row;
  342 var rowNo, rowObj;
  343 var uniqXml = {}; /* xml -> rowId */
  344 for (type in fiConf) {
  345     for (id in fiConf[type]) {
  346         ROW: for (i = 0; i < fiConf[type][id]["varName"].length; ++i) {
  347             if (fiConf[type][id]["xml"][i] in uniqXml) {
  348                 /* row exists already, add fileName and continue */
  349                 rowNo = uniqXml[fiConf[type][id]["xml"][i]];
  350                 /* fiConfRows[rowNo]["fileName"] += ", " + fiConf[type][id]["fileName"][i]; */
  351                 for ( k in fiConf[type][id] ) {
  352                     if ((i < fiConf[type][id][k].length) && (fiConf[type][id][k][i].length > 0)) {
  353                         if (fiConfRows[rowNo][k] != fiConf[type][id][k][i]) {
  354                             if (k in fiConfRows[rowNo] && fiConfRows[rowNo][k]) {
  355                                 fiConfRows[rowNo][k] += "; " + fiConf[type][id][k][i];
  356                             } else {
  357                                 fiConfRows[rowNo][k] = fiConf[type][id][k][i];
  358                             }
  359                         }
  360                     }
  361                 }
  362                 continue ROW;
  363             }
  364             rowNo = fiConfRows.length;
  365             uniqXml[fiConf[type][id]["xml"][i]] = rowNo;
  366             rowObj = {};
  367             for (k in fiConf[type][id]) {
  368                 rowObj[k] = fiConf[type][id][k][i];
  369             }
  370             fiConfRows.push(rowObj);
  371         }
  372     }
  373 }
  374 for (i = 0; i < fiConfRows.length; ++i) {
  375     $row = $(document.createElement('tr'));
  376     $("#main").append($row);
  377     for (j = 0; j < cols.length; ++j) {
  378         $(document.createElement('td'))
  379         .click({"no": i}, function(evt) {tableRowDialog(this, evt.data.no);})
  380         .append(fiConfRows[i][cols[j]])
  381         .appendTo($row);
  382     }
  383 }
  384 $("#main").colResizable();
  385 $("#main").stupidtable();
  386 
  387 });
  388 -->
  389 </script>
  390 <title>Fimex Config Overview</title>
  391 </head>
  392 <body>
  393 <h1 class="ui-widget">Fimex Config Overview</h1>
  394 <div class="explanation">Click table-header to sort. Click table-content to get full information.</div>
  395 EOT
  396     my $datestamp = gmtime(time);
  397     print HTML <<"EOT";
  398 <table id='main' width="100%">
  399 <caption>generated on $datestamp UTC with: $0 @main::Args</caption>
  400 <thead class="ui-widget-header">
  401 <tr><th class="type-string">variable</th><th class="type-string">units</th><th class="type-string">standard_name</th><th class="type-int">grib1</th><th class="type-int">grib2</th><th class="type-int">felt-id</th><th class="type-string">long_name</th><th class="type-string">metno_name</th></tr>
  402 </thead>
  403 <tbody></tbody>
  404 </table>
  405 </html>
  406 EOT
  407     close HTML;
  408 }
  409 
  410 ########################################################################
  411 # minimum requirements to fill data with
  412 package Fimex::Config::Content;
  413 
  414 
  415 sub mk_listaccessors_ {
  416     my ($class, @fields) = @_;
  417     foreach my $f (@fields) {
  418         my $func = sub {
  419             my ($self, $fData) = @_;
  420             push @{$self->{$f}}, $fData if defined $fData;
  421             return @{ $self->{$f} };
  422         };
  423         my $funcName = $class . '::' . $f;
  424         no strict 'refs';
  425         *{$funcName} = $func;
  426     }
  427 }
  428 
  429 BEGIN {
  430     __PACKAGE__->mk_listaccessors_(qw(unit varName xml fileName longName standardName metnoName grib1Id grib2Id feltId));
  431     die unless UNIVERSAL::can(__PACKAGE__, 'xml');
  432 }
  433 
  434 sub new {
  435     my ($package, $id, $xml, $filename, $unit, $standardName, $varName, $longName, $metnoName) = @_;
  436     die "don't use interface, use implementation" if ($package eq __PACKAGE__);
  437     my $self = {
  438         id => $id,
  439         unit => [],
  440         varName => [],
  441         longName => [],
  442         standardName => [],
  443         metnoName => [],
  444         grib1Id => [],
  445         grib2Id => [],
  446         feltId => [],
  447         xml => [],
  448         fileName => [],
  449     };
  450     bless $self, $package;
  451     $self->xml($xml || "");
  452     $self->unit($unit || "");
  453     $self->fileName($filename || "");
  454     $self->standardName($standardName || "");
  455     $self->varName($varName || "");
  456     $self->longName($longName || "");
  457     $self->metnoName($metnoName || "");
  458     return $self;
  459 }
  460 
  461 sub type {
  462     die "not implemented in base";
  463 }
  464 
  465 sub id {
  466     return $_[0]->{id};
  467 }
  468 
  469 =head2 merge(other)
  470 
  471 merge information from $other to this object
  472 
  473 =cut
  474 
  475 sub merge {
  476     my ($self, $other) = @_;
  477     if ($self->isa($other)) {
  478         die "cannot merge different types";
  479     }
  480     foreach my $key (%{ $other }) {
  481         if (ref($self->{$key}) eq 'ARRAY') {
  482             push @{ $self->{$key} }, @{$other->{$key}};
  483         }
  484     }
  485 
  486 }
  487 
  488 package Fimex::Config::Content::Grib1;
  489 use base qw(Fimex::Config::Content);
  490 
  491 sub new {
  492     my $self = Fimex::Config::Content::new(@_);
  493     $self->grib1Id($self->id);
  494     return $self;
  495 }
  496 
  497 sub type {
  498     return "grib1";
  499 }
  500 
  501 package Fimex::Config::Content::Grib2;
  502 use base qw(Fimex::Config::Content);
  503 
  504 sub new {
  505     my $self = Fimex::Config::Content::new(@_);
  506     $self->grib2Id($self->id);
  507     return $self;
  508 }
  509 
  510 sub type {
  511     return "grib2";
  512 }
  513 
  514 package Fimex::Config::Content::Felt;
  515 use base qw(Fimex::Config::Content);
  516 
  517 sub new {
  518     my $self = Fimex::Config::Content::new(@_);
  519     $self->feltId($self->id);
  520     return $self;
  521 }
  522 
  523 sub type {
  524     return "felt";
  525 }
  526 
  527 
  528 #####################################################################
  529 package Fimex::JSON;
  530 use Scalar::Util qw(reftype);
  531 sub encode {
  532     my ($var) = @_;
  533     my $ref = reftype $var;
  534     if (!defined $ref) {
  535         return encodeScalar($var);
  536     } elsif ($ref eq 'SCALAR') {
  537         return encodeScalar($$var);
  538     } elsif ($ref eq 'HASH') {
  539         return encodeHashRef($var);
  540     } elsif ($ref eq 'ARRAY') {
  541         return encodeArrayRef($var);
  542     }
  543 }
  544 
  545 sub encodeHashRef {
  546     my ($h) = @_;
  547     my %out;
  548     while (my ($key, $val) = each %$h) {
  549         $out{$key} = encode($val);
  550     }
  551     return "{". join(',', map {encodeScalar($_).': '. $out{$_} } keys %out) ."}";
  552 }
  553 
  554 sub encodeArrayRef {
  555     my ($a) = @_;
  556     my @out;
  557     foreach my $e (@$a) {
  558         push @out, encode($e);
  559     }
  560     return "[". join(',', @out) . "]";
  561 }
  562 
  563 sub encodeScalar {
  564     my ($s) = @_;
  565 
  566     # escape
  567     $s =~ s:\\:\\\\:g;
  568     $s =~ s:/:\\/:g;
  569     $s =~ s:":\\":g;
  570     $s =~ s:\r:\\r:g;
  571     $s =~ s:\n:\\n:g;
  572     $s =~ s:\t:\\t:g;
  573     return '"'. $s . '"';
  574 }