view release on metacpan or  search on metacpan

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

                push @days_with_data, $day
                    if vec($day_vec, $day - 1, 1) == 1;
            }

            my $days_in_month_nrs = $Opt->fday
                ? $opt_fday_nrs
                : rng_new( 1 .. $mdays );

            my $days_nrs = rng_new( @days_with_data );

            my $day_gap_nrs = $days_in_month_nrs->diff($days_nrs);

            $days_missing += $day_gap_nrs->cardinality;

            $gap_text .= $SPACE . _month_names($mm) . '[' . $day_gap_nrs->as_string . ']'
                unless $day_gap_nrs->is_empty;
        }

        $gap_text = join $SPACE, $gap_months, $gap_text
            if $gap_months;

        $gap_text =~ s{ \A \s+ }{}xms;  # trim leading whitespace

        if ( $gap_text !~ m{\A \s* \Z}xms ) {
            my $days_of_data = _days_in_year($yyyy) - $days_missing;
            my $quality = sprintf '%6.1f', 100 * ( $days_of_data / _days_in_year($yyyy) );
            my $msg = sprintf "%s\tmissing data: %d %s %s", $stn->id, $yyyy, $quality, $gap_text;
            $stn->add_note($WARN_MISS_DY, $msg, $Opt->verbose);
            $gap_text =~ s{\A \s+ }{}xms;
            $_missing_href->{$stn->id}{$yyyy}{$gap_text} = $quality;
        }
    }

    $_tstats->stop('Report_gaps');

    return;
}

#----------------------------------------------------------------------
# -kml Helper Functions
#----------------------------------------------------------------------

# TODO: allow any KML hex colour code, format <opacity%><red><green><blue>

sub _get_kml_color ($color_opt) {

    # From https://developers.google.com/kml/documentation/kmlreference#colorstyle

    # Color and opacity (alpha) values are expressed in hexadecimal notation.
    # The range of values for any one color is 0 to 255 (00 to ff). For
    # alpha, 00 is fully transparent and ff is fully opaque. The order of
    # expression is aabbggrr, where:
    #
    #    aa=alpha (00 to ff)
    #    bb=blue (00 to ff)
    #    gg=green (00 to ff)
    #    rr=red (00 to ff).
    #
    # For example, if you want to apply a blue color with 50 percent opacity
    #  to an overlay, you would specify the following:
    #    <color>7fff0000</color>,
    #  where alpha=0x7f, blue=0xff, green=0x00, and red=0x00.

    my %kml_colors = (
        b => [ 'blue',  'ff780000' ],
        g => [ 'grn',   'ff147800' ],
        a => [ 'ltblu', 'ffF06414' ], # 'a' for azure
        p => [ 'purple','ff780078' ],
        r => [ 'red',   'ff1400FF' ],
        w => [ 'wht',   'ffFFFFFF' ],
        y => [ 'ylw',   'ff14F0FF' ],
    );

    # just use the first character of whatever string we're given
    my $c = substr $color_opt, 0, 1;

    return unless $kml_colors{$c};

    return $kml_colors{$c}->[1];
}

#----------------------------------------------------------------------
# -gps Helper Functions
#----------------------------------------------------------------------

# Calculate geographic distances in kilometers between coordinates in
# geodetic WGS84 format using the Haversine formula.

sub _gis_distance ($lat1, $lon1, $lat2, $lon2) {
    $lon1 = deg2rad($lon1);
    $lat1 = deg2rad($lat1);
    $lon2 = deg2rad($lon2);
    $lat2 = deg2rad($lat2);

    ## no critic [ProhibitParensWithBuiltins]
    ## no critic [ProhibitMagicNumbers]

    my $dlon = $lon2 - $lon1;
    my $dlat = $lat2 - $lat1;
    my $a = (sin($dlat/2)) ** 2 + cos($lat1) * cos($lat2) * (sin($dlon/2)) ** 2;
    my $c = 2 * atan2(sqrt($a), sqrt(1-$a));

    return 6_371_640 * $c / 1000.0;
}

#----------------------------------------------------------------------
# -location Helper Functions
#----------------------------------------------------------------------

# Match -location <pattern> to the station id or name provided in the call.
# If the pattern looks like a station id (e.g. 'CA006105887') then it matches
# to the stn_id parameter; if it looks like a comma-separated list of station
# 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;