#!/usr/bin/perl -w

# (C) Copyright 2010-2016 MET Norway
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301, USA.

# pod included at end of file

use strict;
use Getopt::Long;
use Pod::Usage qw(pod2usage);
use Geo::BUFR;

# Will be used if neither --tablepath nor $ENV{BUFR_TABLES} is set
use constant DEFAULT_TABLE_PATH => '/usr/local/lib/bufrtables';
# Ought to be your most up-to-date B table
use constant DEFAULT_TABLE => 'B0000000000000023000';

# Parse command line options
my %option = ();

GetOptions(
           \%option,
           'tablepath=s',# Set BUFR table path
           'code=s',     # Print the contents of code table
           'flag=i',     # Resolve the flag value given
           'help',       # Print help information and exit
           'noexpand',   # Don't expand D descriptors
           'partial',    # Expand D descriptors only once, ignoring
                         # replication
           'simple',     # Like 'partial', but displaying the resulting
                         # descriptors on one line
           'bufrtable=s',# Set BUFR tables
           'verbose=i',  # Display path and tables used
       ) or pod2usage(-verbose => 0);


# User asked for help
pod2usage(-verbose => 1) if $option{help};

# No arguments if --code or --flag, else there should be at least one argument
if (defined $option{code} or defined $option{flag}) {
    pod2usage(-verbose => 0) if @ARGV;
} else {
    pod2usage(-verbose => 0) if not @ARGV;
}

# If --flag is set, user must also provide code table
pod2usage(-verbose => 0) if defined $option{flag} and !defined $option{code};

# All arguments must be integers
foreach (@ARGV) {
    pod2usage("All arguments must be integers!") unless /^\d+$/;
}
if (defined $option{code} && $option{code} !~ /^\d+$/) {
    pod2usage("Code table is not a (positive) integer!");
}
if (defined $option{flag} && $option{flag} !~ /^\d+$/) {
    pod2usage("Flag value is not a (positive) integer!");
}


# Set verbosity level for the BUFR module
my $verbose = $option{verbose} ? 1 : 0;
Geo::BUFR->set_verbose($verbose);

# From version 1.32 a descriptor sequence ending in e.g. 106000 031001
# will be allowed unless strict checking is set, and we really want
# bufrresolve.pl to complain in this case
Geo::BUFR->set_strict_checking(2);

# Set BUFR table path
if ($option{tablepath}) {
    # Command line option --tablepath overrides all
    Geo::BUFR->set_tablepath($option{tablepath});
} elsif ($ENV{BUFR_TABLES}) {
    # If no --tablepath option, use the BUFR_TABLES environment variable
    Geo::BUFR->set_tablepath($ENV{BUFR_TABLES});
} else {
    # If all else fails, use the libbufr bufrtables
    Geo::BUFR->set_tablepath(DEFAULT_TABLE_PATH);
}

# BUFR table file to use
my $table = $option{bufrtable} || DEFAULT_TABLE;

my $bufr = Geo::BUFR->new();

if (defined $option{code}) {
    # Resolve flag value or dump code table
    my $code_table = $option{code};
    if (defined $option{flag}) {
        if ($option{flag} == 0) {
            print "No bits are set\n";
        } else {
            print $bufr->resolve_flagvalue($option{flag}, $code_table, $table);
        }
    } else {
        print $bufr->dump_codetable($code_table, $table);
    }
} else {
    # Resolve descriptor(s)
    $bufr->load_BDtables($table);
    if ($option{simple}) {
        print $bufr->resolve_descriptor('simply', @ARGV);
    } elsif ($option{partial}) {
        print $bufr->resolve_descriptor('partially', @ARGV);
    } elsif ($option{noexpand}) {
        print $bufr->resolve_descriptor('noexpand', @ARGV);
    } else {
        print $bufr->resolve_descriptor('fully', @ARGV);
    }
}

=pod

=encoding utf8

=head1 SYNOPSIS

  1) bufrresolve.pl <descriptor(s)>
     [--partial]
     [--simple]
     [--noexpand]
     [--bufrtable <name of BUFR B table]
     [--tablepath <path to BUFR tables>]
     [--verbose n]
     [--help]

  2) bufrresolve.pl --code <code or flag table>
     [--bufrtable <name of BUFR B table>]
     [--tablepath <path to BUFR tables>]
     [--verbose n]

  3) bufrresolve.pl --flag <value> --code <flag table>
     [--bufrtable <name of BUFR B table]
     [--tablepath <path to BUFR tables>]
     [--verbose n]

=head1 DESCRIPTION

Utility program for fetching info from BUFR tables.

Execute without arguments for Usage, with option C<--help> for some
additional info. See also L<https://wiki.met.no/bufr.pm/start> for
examples of use.

It is supposed that the code and flag tables are contained in a file
with same name as corresponding B table except for having prefix C
instead of B. The tables used can be chosen by the user with options
C<--bufrtable> and C<--tablepath>. Default is the hard coded
DEFAULT_TABLE in directory DEFAULT_TABLE_PATH, but this last one will
be overriden if the environment variable BUFR_TABLES is set. You
should consider edit the source code if you are not satisfied with the
defaults chosen.

=head1 OPTIONS

   --partial    Expand D descriptors only once, ignoring replication
   --simple     Like --partial, but displaying the resulting
                descriptors on one line
   --noexpand   Don't expand D descriptors at all

   --bufrtable <name of BUFR B or D table>  Set BUFR tables
   --tablepath <path to BUFR tables>  Set BUFR table path
   --verbose n  Display path and tables used if n > 0

   --help       Display Usage and explain the options used. Almost
                the same as consulting perldoc bufrresolve.pl

Usage 1): Resolves the given descriptor(s) fully into table B
descriptors, with name, unit, scale, reference value and width (in
bits) written on each line (except for --simple). --partial, --simple
and --noexpand are mutually exclusive (full expansion is default).

Usage 2): Prints the contents of the requested code or flag table
(named by the table B descriptor).

Usage 3): Displays the bits set when the data value for the requested
flag table is <value>.

Options may be abbreviated, e.g. C<--h> or C<-h> for C<--help>

=head1 NOTE ON --VERBOSE

n > 1 in C<--verbose n> does not provide any more output than n=1, so
demanding an argument to C<--verbose> looks funny. But if not, sooner
or later someone would type C<bufrresolve.pl 307080 --verbose 1> which
by Perl would be interpreted as if the arguments were C<307080 000001
--verbose>, which probably is not what the user intended.

=head1 AUTHOR

Pål Sannes E<lt>pal.sannes@met.noE<gt>

=head1 COPYRIGHT

Copyright (C) 2010-2016 MET Norway

=cut