view release on metacpan or  search on metacpan

lib/Weather/GHCN/App/Fetch.pm  view on Meta::CPAN

## no critic [References::ProhibitDoubleSigils]

########################################################################
# Export
########################################################################

require Exporter;

use base 'Exporter';

our @EXPORT = ( 'run' );

########################################################################
# Libraries and Features
########################################################################
use Object::Pad 0.66 qw( :experimental(init_expr) );

use Getopt::Long;
use Pod::Usage;
use Const::Fast;
use English         qw( -no_match_vars );

# cpan modules
use FindBin         qw($Bin);
use LWP::Simple;
use Path::Tiny;
use Text::Abbrev;

# modules for Windows only
use if $OSNAME eq 'MSWin32', 'Win32::Clipboard';

# conditional modules
use Module::Load::Conditional qw( can_load check_install requires );

# custom modules
use Weather::GHCN::Common    qw( :all );
use Weather::GHCN::StationTable;

########################################################################
# Global delarations
########################################################################

# is it ok to use Tk?
our $TK_MODULES = {
    'Tk'          => undef,
    'Tk::Getopt'  => undef,
};

# is it ok to use Win32::Clipboard?
our $USE_WINCLIP = $OSNAME eq 'MSWin32';
our $USE_TK      = can_load( modules => $TK_MODULES );

my $Opt;    # options object, with property accessors for each user option

# options that relate to script execution, not GHCN processing and output
my $Opt_savegui;    # file in which to save options from GUI dialog
my $Opt_gui;        # launch the GUI dialog
my $Opt_help;       # display POD documentation
my $Opt_readme;     # print the text of the GHCN readme file
my $Opt_usage;      # display a synopsis of the command line syntax
my $Opt_outclip;    # send report output to the Windows clipboard instead of STDOUT

########################################################################
# Constants
########################################################################

const my $EMPTY  => q();       # empty string
const my $SPACE  => q( );      # space character
const my $DASH   => q(-);      # dash character
const my $TAB    => qq(\t);    # tab character
const my $NL     => qq(\n);    # perl universal newline (any platform)
const my $TRUE   => 1;         # perl's usual TRUE
const my $FALSE  => not $TRUE; # a dual-var consisting of '' and 0

const my $PROFILE_FILE => Weather::GHCN::Options->get_profile_filespec();

const my $STN_THRESHOLD     => 100;     # ask if number of selected stations exceeds this

const my $STN_ID_RE     => qr{ [[:upper:]]{2} [[:alnum:]\_\-]{9} }xms;

########################################################################
# Script Mainline
########################################################################

__PACKAGE__->run( \@ARGV ) unless caller;

=head1 SUBROUTINES

=head2 run ( \@ARGV, stdin => 0 )

Invoke this subroutine, passing in a reference to @ARGV, in order to
fetch NOAA GHCN station data or daily weather data.

See ghnc_fetch.pl -help for details.

Stations are filtered by various options, such as -country and -location.
But Fetch->run can also receive a list of station id's via a pipe or
a file.  To enable this feature, set the B<stdin> parameter to 1 (true).

When calling Fetch->run inside a test script, it's usually best to leave
this option disabled as some test harnesses may fool the algorithm used
to detect stdin from a file or pipe.  This can be done by omitting
the stdin => <bool> parameter, or setting it to false.


=cut

sub run ($progname, $argv_aref, %args) {

    local @ARGV = $argv_aref->@*;

    # these persist across calls to run() in the unit tests, so we
    # need to reset them each time
    $Opt_savegui = $FALSE;
    $Opt_gui     = $FALSE;     
    $Opt_help    = $FALSE;    
    $Opt_readme  = $FALSE;  
    $Opt_usage   = $FALSE;   
    $Opt_outclip = $FALSE; 

    my $ghcn = Weather::GHCN::StationTable->new;

lib/Weather/GHCN/App/Fetch.pm  view on Meta::CPAN

            say $ghcn->get_missing_rows;
        }

        # these only do something when $Opt->report ne 'detail'
        $ghcn->summarize_data;
        say $ghcn->get_summary_data;
        say $EMPTY;

        goto WRAP_UP if $Opt->dataonly;

        say $EMPTY;
        say $ghcn->get_footer;

        say $EMPTY;
        say $ghcn->get_flag_statistics;
    }

    say $EMPTY;
    say $ghcn->get_stations( kept => 1 );

    my @rejected = $ghcn->get_stations( list => 1, kept => 0, no_header => 1 );
    if (@rejected) {
        say $EMPTY;
        say 'Stations that failed to meet range or quality criteria:';
        say tsv(\@rejected);
        say $EMPTY;
        say 'Reasons for rejection:';
        my @notes = $ghcn->get_station_note_list;
        say tsv(\@notes);
    }

    if ( $ghcn->has_missing_data ) {
        warn '*W* some data was missing for the stations and date range processed' . $NL;
        say $EMPTY;
        say $ghcn->get_missing_data_ranges;
    }

    $ghcn->tstats->stop('_Overall') ;
    $ghcn->tstats->finish;

    say $EMPTY;
    say $ghcn->get_options;

    say $EMPTY;
    say 'Script:';
    say $TAB, $PROGRAM_NAME;
    say "\tWeather::GHCN::StationTable version " . $Weather::GHCN::StationTable::VERSION;
    say $TAB, 'Cache directory: ' . $ghcn->cachedir;
    say $TAB, 'Profile file: ' . $ghcn->profile_file;

    if ( $Opt->performance ) {
        say $EMPTY;
        say sprintf 'Timing statistics (ms) and memory [bytes]';
        say $ghcn->get_timing_stats;

        say $EMPTY;
        say $ghcn->get_hash_stats;
    }

WRAP_UP:
    # send output to the Windows clipboard
    if ( $Opt_outclip and $USE_WINCLIP ) {
        Win32::Clipboard->new()->Set( $output );
        select $old_fh;     ## no critic [ProhibitOneArgSelect]
    }

    return;
}

########################################################################
# Subroutines
########################################################################

=head2 get_user_options ( $optfile=undef )

Fetch.pm uses B<get_user_options()> to either get user options
via B<Tk::GetOptions> -- if it is installed -- or via B<Getopt::Long>.

=cut

sub get_user_options ( $optfile=undef ) {

    my $user_opt_href = $Opt_gui
                      ? get_user_options_tk($optfile)
                      : get_user_options_no_tk($optfile)
                      ;

    return $user_opt_href;
}

=head2 get_user_options_no_tk ( $optfile=undef )

This function obtains user options from @ARGV by calling B<Getopt::Long>
B<GetOptions> using a list of option definitions obtained by calling
B<Weather::GHCN::Options->get_getopt_list()>.  The options (and their values)
are extracted from @ARGV and put in a hash, a reference to which is
then returned.

This function is called when the GUI is not being used.  The $optfile
argument, if provided, is assumed to be a file saved from a GUI
invocation and will be eval'd and used as the options list.

=cut

sub get_user_options_no_tk ( $optfile=undef ) {

    my @options = ( Weather::GHCN::Options->get_getopt_list() );

    if ($optfile) {
        my $saved_opt_perlsrc = join $SPACE, path($optfile)->lines( {chomp=>1} );
        my $loadoptions;

        ## no critic [ProhibitStringyEval]
        ## no critic [RequireCheckingReturnValueOfEval]
        eval $saved_opt_perlsrc;

        return $loadoptions;
    }

    my %opt;
    GetOptions( \%opt, @options);