view release on metacpan or  search on metacpan

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

sub report_extremes_per_year ($limit, $ndays, $cmp_op) {
    my $type = $Opt->cold ? 'Coldwaves' : 'Heatwaves';
    my $title = sprintf '%d-day waves %s %dC', $ndays, $cmp_op, $limit;
    say join $TAB, 'StnId', 'Location', 'Year', $title;

    my %years;

    foreach my $xw_aref (@ExtremeWaves) {
        my ($xw_begin, $xdays_aref, $stnid, $loc) = $xw_aref->@*;
        $stnid //= $EMPTY;
        $loc   //= $EMPTY;
        my ($year) = split $DASH, $xw_begin;
        my $count = scalar $xdays_aref->@*;
        next if $count < $ndays;
        $years{$stnid}{$year}++;
    }

    foreach my $stnid ( sort keys %years ) {
        foreach my $yr ( sort keys $years{$stnid}->%* ) {
            say join $TAB, $stnid, $Location{$stnid}, $yr, $years{$stnid}{$yr};
        }
    }

    return \%years;
}

########################################################################
# Script-standard Subroutines
########################################################################

=head2 get_options ( \@ARGV )

B<get_options> encapsulates everything we need to process command line
options, or to set options when invoking this script from a test script.

Normally it's called by passing a reference to @ARGV; from a test script
you'd set up a local array variable to specify the options.

By convention, you should set up a file-scoped lexical variable named
$Opt and set it in the mainline using the return value from this function.
Then all options can be accessed used $Opt->option notation.

=cut

sub get_options ($argv_aref) {

    my @options = (
        'limit=i',              # lower bound of extremes daily temperature
        'ndays=i',              # number of consecutive days needed to be a extremes
        'peryear',              # report number of heatwaves per year
        'cold',                 # report coldwaves instead of heatwaves
        'nogaps',               # generate a line for missing years (for charting)
        'outclip',              # output data to the Windows clipboard
        'help','usage|?',       # help
    );

    my %opt;

    # create a list of option key names by stripping the various adornments
    my @keys = map { (split m{ [!+=:|] }xms)[0] } grep { !ref  } @options;
    # initialize all possible options to undef
    @opt{ @keys } = ( undef ) x @keys;

    GetOptionsFromArray($argv_aref, \%opt, @options)
        or pod2usage(2);

    # Make %opt into an object and name it the same as what we usually
    # call the global options object.  Note that this doesn't set the
    # global -- the script will have to do that using the return value
    # from this function.  But, what this does is allow us to call
    # $Opt->help and other option within this function using the same
    # syntax as what we use in the script.  This is handy if you need
    # to rename option '-foo' to '-bar' because you can do a find/replace
    # on '$Opt->foo' and you'll get any instances of it here as well as
    # in the script.

    ## no critic [Capitalization]
    ## no critic [ProhibitReusedNames]
    my $Opt = _wrap_hash \%opt;

    pod2usage(1)             if $Opt->usage;
    pod2usage(-verbose => 2) if $Opt->help;

    return $Opt;
}

1;  # needed in case we import this as a module (e.g. for testing)

=head1 AUTHOR

Gary Puckering (jgpuckering@rogers.com)

=head1 LICENSE AND COPYRIGHT

Copyright 2022, Gary Puckering

=cut