Weather-GHCN-Fetch

 view release on metacpan or  search on metacpan

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

        'type:s',               # select based on type
        'cachedir:s',           # cache location
        'profile:s',            # profile file
        '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

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

        '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

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

=cut

sub read_data ($fh, $count_href) {
    my $lineno = 0;

    while ( my $data = <$fh> ) {
        chomp $data;
        next if $data =~ m{ \A \s* \Z }xms;

        my ($stnid, $co, $state, $active) = split m{\t}xms, $data;

        $lineno++;
        if ($lineno == 1) {
            die '*E* invalid input data'
                unless  $stnid eq 'StationId' and $active eq 'Active';
            next;
        }

        last if not $active;

        my @rangelist = parse_active_range($stnid, $active);

        next unless @rangelist;

        foreach my $range (@rangelist) {
            my ($from, $to) = split m{-}xms, $range;

            $to //= $from;

            foreach my $yr ($from..$to) {
                $count_href->{$yr}{$stnid}++;
            }
        }
    }

    return;

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

    my @options = (
        'outclip',              # output data to the Windows clipboard
        'debug',                # enable debug() statements on stderr
        '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

lib/Weather/GHCN/CacheURI.pm  view on Meta::CPAN

method _fetch_without_cache ($uri) {
    # check for a fresher copy on the server
    my $key = $self->_uri_to_key($uri);

    my $content = get($uri);
    return ($FROM_URI, $content);
}

method _uri_to_key ($uri) {
    my @parts = split m{ $FSLASH }xms, $uri;
    my $key = $parts[-1];  # use the last part as the key

    # this transformation is for testing using CPAN pages and is not
    # necessary for the NOAA GHCN pages we actually deal with
    $key =~ s{ [:] }{}xmsg;

    return $key;
}

method _path_to_key ($uri) {

lib/Weather/GHCN/CountryCodes.pm  view on Meta::CPAN

const my $TRUE   => 1;      # perl's usual TRUE
const my $FALSE  => not $TRUE; # a dual-var consisting of '' and 0


#############################################################################

# Load the %Country hash during the UNITCHECK phase, before any of the
# regular runtime code needs it.

UNITCHECK {
    my @lines = split m{ \n }xms, country_table();

    foreach my $line (@lines) {
        my ($entity, $gec, $iso2, $iso3, $isonum, $nato, $internet, $comment) = split m{ [|] }xms, $line;

        # skip table entries with no GEC
        next if $gec eq q(-);

        # check for duplicates, though there shouldn't be any
        croak "*W* country $entity with GEC $gec already exists"
            if $Country{$gec};

        $Country{$gec} = {
            'name'      => $entity,

lib/Weather/GHCN/StationTable.pm  view on Meta::CPAN

            my $opt_country = $Opt->country;
            next if $Opt->country and $country !~ m{\A$opt_country}msi;

            my $opt_state = $Opt->state;
            next if $Opt->state and $state !~ m{\A$opt_state}msi;

            ## use critic [RequireExtendedFormatting]
            next if $Opt->location and not _match_location($id, $name, $Opt->location);

            if ( $Opt->gps ) {
                my ($opt_lat, $opt_long) = split m{[,;\s]}xms, $Opt->gps;
                my $distance = _gis_distance($opt_lat, $opt_long, $lat, $long);
                next if $distance > $Opt->radius;
            }

            next if $Opt->gsn and not $gsn;
        }

        $_station{$id} = Weather::GHCN::Station->new(
            id      => $id,
            country => $country,

lib/Weather/GHCN/StationTable.pm  view on Meta::CPAN

    push @output, '  <Icon>';
    # push @output, '    <href>http://maps.google.com/mapfiles/kml/pushpin/' . $kmlcolor . '-pushpin.png</href>';
    push @output, '    <href>http://maps.google.com/mapfiles/kml/shapes/donut.png</href>';
    push @output, '  </Icon>';
    push @output, '  </IconStyle>';
    push @output, '  </Style>';

    foreach my $stn ( values %_station ) {
        next if $stn->error_count;
        # TODO:  use ->sets to get a list of spans and use the first span instead of splitting run_list
        my ($start, $end) = split m{ [-] }xms, $stn->active;
        $end //= $start;

        my $desc = $stn->description();

        push @output,         '  <Placemark>';
        push @output,         '    <styleUrl>#mypin</styleUrl>';
        push @output, sprintf '    <name>%s</name>', encode_entities($stn->name);
        push @output, sprintf '    <description>%s</description>', encode_entities($desc);
        push @output,         '    <TimeSpan>';
        push @output, sprintf '      <begin>%s-01-01T00:00:00Z</begin>', $start;

lib/Weather/GHCN/StationTable.pm  view on Meta::CPAN

    my $return_list = $arg{list} // $_return_list;

    my @output;

    push @output, '# Use curl -K <this_file> to download these URL\'s'
        if $arg{curl};

    foreach my $stn ( values %_station ) {
        next if $stn->error_count;
        # TODO:  use ->sets to get a list of spans and use the first span instead of splitting run_list
        my ($start, $end) = split m{ [-] }xms, $stn->active;

        if ( $arg{curl} ) {
            my @parts = split m{ [/] }xms, $stn->url;
            push @output, 'output = ' . $parts[-1];
            push @output, 'url = ' . $stn->url;
        } else {
            push @output, $stn->url;
        }
    }

    return $return_list ? @output : tsv(\@output);
}

lib/Weather/GHCN/StationTable.pm  view on Meta::CPAN

    my @errors = $_ghcn_opt_obj->validate();

    if ( defined $_opt_href->{'aliases'} and defined $_opt_href->{'location'} ) {
        # if the location matches an aliases, then pull the list of
        # stations from the alias definition and assign it to the
        # $_stnid_filter
        my $stnid_string = $_opt_href->{'aliases'}->{ $_opt_href->{'location'} } // $EMPTY;
        if ($stnid_string) {
            my @stns = split m{ [,;\s] }xms, $stnid_string;
            my %stnid_filter;
            foreach my $stnid (@stns) {
                $stnid_filter{$stnid} = $TRUE;
            }
            $_stnid_filter_href = \%stnid_filter;
            $_opt_href->{'location'} = undef;
        }
    }

    # update the combined options hash in the Options object

lib/Weather/GHCN/StationTable.pm  view on Meta::CPAN

# id's, it returns success if any of them match the stn_id parameter.  Otherwise,
# it matches the <pattern> to the start of the stn_name parameter.
sub _match_location ($stn_id, $stn_name, $pattern) {

    my $result = $FALSE;

    if ($pattern =~ m{ \A $STN_ID_RE \Z }xms) {
        $result = $stn_id eq $pattern;
    }
    elsif ($pattern =~ m{ \A $STN_ID_RE ( [,] $STN_ID_RE )+ \Z }xms) {
        my @patterns = split m{ [,] }xms, $pattern;
        my $multi_pattern = '\A(' . join(q(|), @patterns) . ')\Z';

        $result = $stn_id =~ $multi_pattern;
    }
    else {
        ## no critic [RequireExtendedFormatting]
        $result = $stn_name =~ m{\A$pattern}msi;
    }

    return $result;

lib/Weather/GHCN/StationTable.pm  view on Meta::CPAN

# -nogaps Helper Functions
#----------------------------------------------------------------------

# parse the missing values text, which looks like this:
#   month names:   Jan Feb Mar Apr May Jun Jul Aug Sep Oct
#   or day ranges: May[2] Oct[3,11] Nov[1] Dec[2,5]

sub _parse_missing_text ( $s ) {
    my @months;
    my @mmdd;
    my @f = split m{ \s }xms, $s;

    my $mmm_re    = qr{ [[:upper:]][[:lower:]][[:lower:]] }xms;
    my $nbr_rng   = qr{ \d+ ( [-] \d+)? }xms;
    my $rng_list  = qr{ $nbr_rng (, $nbr_rng)* }xms;

    foreach my $tok (@f) {
        if ( $tok =~ m{ \A $mmm_re \Z }xms ) {
            push @months, $MMM_TO_MM{$tok};
        }
        if ( $tok =~ m{ \A ($mmm_re) \[ ($rng_list) \] \Z }xms ) {

t/14_options.t  view on Meta::CPAN

    my $user_options = '-location Ottawa -country CA -state ON -range 2000-2010 -gsn';
    GetOptionsFromString($user_options, \%user_opt, @all_options);

    my ($opt_href, $opt_obj) = $opt->combine_options( \%user_opt );
    # using the $profile_href obtained from the test yaml ealier
    @errors = $opt->validate();
    ok !@errors, 'validate returned no errors';

    my $opt_string = $opt->options_as_string;

    my @opt_list = split m{ \s\s }xms, $opt_string;

    $count = grep { $_ =~ m{ -baseline \s \d{4}-\d{4} }xms } @opt_list;
    is $count, 1, , '-baseline found';

    $count = grep { $_ =~ m{-kmlcolor \s red }xms } @opt_list;
    is $count, 1, , '-kmlcolor found';

    $count = grep { $_ =~ m{-country \s CA }xms } @opt_list;
    is $count, 1, , '-country found';