| File: | blib/lib/Weather/Meteo.pm |
| Coverage: | 84.2% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package Weather::Meteo; | ||||||
| 2 | |||||||
| 3 | 15 15 15 | 1146407 11 126 | use strict; | ||||
| 4 | 15 15 15 | 16 6 208 | use warnings; | ||||
| 5 | |||||||
| 6 | 15 15 15 | 15 14 244 | use Carp; | ||||
| 7 | 15 15 15 | 1489 174737 135 | use CHI; | ||||
| 8 | 15 15 15 | 22 8 263 | use JSON::MaybeXS; | ||||
| 9 | 15 15 15 | 3746 165492 194 | use LWP::UserAgent; | ||||
| 10 | 15 15 15 | 3205 667281 710 | use Object::Configure; | ||||
| 11 | 15 15 15 | 35 92 671 | use Params::Get 0.13; | ||||
| 12 | 15 15 15 | 19 9 127 | use Params::Validate::Strict; | ||||
| 13 | 15 15 15 | 14 7 105 | use Return::Set; | ||||
| 14 | 15 15 15 | 475 9 111 | use Scalar::Util; | ||||
| 15 | 15 15 15 | 13 10 27 | use Time::HiRes; | ||||
| 16 | 15 15 15 | 350 13 132 | use URI; | ||||
| 17 | |||||||
| 18 | # Archive API host (historical data from 1940 onwards) | ||||||
| 19 | 15 15 15 | 17 6 260 | use constant DEFAULT_HOST => 'archive-api.open-meteo.com'; | ||||
| 20 | # Forecast API host (up to 16 days ahead) | ||||||
| 21 | 15 15 15 | 17 12 205 | use constant FORECAST_HOST => 'api.open-meteo.com'; | ||||
| 22 | 15 15 15 | 14 8 1160 | use constant FIRST_YEAR => 1940; | ||||
| 23 | 15 15 15 | 13 10 208 | use constant EXPIRES_IN => '1 hour'; | ||||
| 24 | 15 15 15 | 11 5 157 | use constant MIN_INTERVAL => 0; | ||||
| 25 | # Default timezone when neither the caller nor the location object supplies one | ||||||
| 26 | 15 15 15 | 10 12 17345 | use constant DEFAULT_TZ => 'Europe/London'; | ||||
| 27 | |||||||
| 28 - 36 | =head1 NAME Weather::Meteo - Interface to L<https://open-meteo.com> for historical and forecast weather data =head1 VERSION Version 0.15 =cut | ||||||
| 37 | |||||||
| 38 | our $VERSION = '0.15'; | ||||||
| 39 | |||||||
| 40 - 196 | =head1 SYNOPSIS
The C<Weather::Meteo> module provides an interface to the Open-Meteo API for retrieving
historical weather data from 1940 and weather forecasts up to 16 days ahead.
It allows users to fetch weather information by specifying latitude, longitude, and a date.
The module supports object-oriented usage and allows customisation of the HTTP user agent.
use Weather::Meteo;
my $meteo = Weather::Meteo->new();
# Historical weather
my $weather = $meteo->weather({ latitude => 0.1, longitude => 0.2, date => '2022-12-25' });
# Forecast (default 7 days)
my $forecast = $meteo->forecast({ latitude => 51.34, longitude => 1.42 });
# Sunrise and sunset for a specific date
my $times = $meteo->sunrise_sunset({ latitude => 51.34, longitude => 1.42, date => '2025-06-21' });
print "Sunrise: $times->{sunrise}\n";
=over 4
=item * Caching
Identical requests are cached (using L<CHI> or a user-supplied caching object),
reducing the number of HTTP requests to the API and speeding up repeated queries.
When a request is made,
a cache key is constructed from the coordinates, date, and timezone.
If a cached response exists it is returned immediately,
avoiding unnecessary API calls.
=item * Rate-Limiting
A minimum interval between successive API calls can be enforced to ensure that the
API is not overwhelmed and to comply with any request throttling requirements.
Rate-limiting is implemented using L<Time::HiRes>.
A minimum interval between API calls can be specified via the C<min_interval> parameter
in the constructor.
Before making an API call,
the module checks how much time has elapsed since the last request and,
if necessary,
sleeps for the remaining time.
=back
=head1 METHODS
=head2 new
my $meteo = Weather::Meteo->new();
# Custom user agent with proxy support
my $ua = LWP::UserAgent->new();
$ua->env_proxy(1);
$meteo = Weather::Meteo->new(ua => $ua);
# Clone an existing object and override one slot
my $clone = $meteo->new(host => 'custom.example.com');
Creates a new C<Weather::Meteo> instance.
When called on an existing C<Weather::Meteo> object,
clones that object and merges the supplied parameters.
=over 4
=item * C<cache>
A caching object.
If not provided,
an in-memory cache is created with a default expiration of one hour.
=item * C<host>
The archive API host endpoint.
Defaults to C<archive-api.open-meteo.com>.
Must be a plain DNS hostname - letters, digits, hyphens, and dots - with an
optional port suffix (e.g. C<mock.example.com:8080>).
Values containing C<@>, path segments, or other special characters are rejected
with a C<croak> to prevent Server-Side Request Forgery (SSRF) via the
C<WEATHER__METEO__host> environment variable or configuration file.
Falsy values (C<undef>, C<"">, C<0>) fall back to the default silently.
=item * C<logger>
An optional logger object.
Must respond to C<error()>.
When supplied, API errors are reported through this logger in addition to C<Carp::carp>.
=item * C<min_interval>
Minimum number of seconds to wait between API requests.
Defaults to C<0> (no delay).
Use this option to enforce rate-limiting.
=item * C<ua>
An object to use for HTTP requests.
If not provided, a default C<LWP::UserAgent> is created.
Must respond to C<get()>.
=back
The class can be configured at runtime using environment variables and configuration files,
for example,
setting C<$ENV{'WEATHER__METEO__carp_on_warn'}> causes warnings to use L<Carp>.
For more information about runtime configuration,
see L<Object::Configure>.
=head3 EXAMPLE
# Minimal -- use all defaults
my $meteo = Weather::Meteo->new();
# Custom UA with throttling
use LWP::UserAgent::Throttled;
my $ua = LWP::UserAgent::Throttled->new();
$ua->throttle('open-meteo.com' => 1);
my $meteo = Weather::Meteo->new(ua => $ua, min_interval => 1);
# Clone the object but change the host for integration testing
my $test_meteo = $meteo->new(host => 'mock.example.com');
=head3 API SPECIFICATION
=head4 Input
All parameters are optional.
They may be supplied as a hashref or a flat key/value list.
When C<$class> is an existing C<Weather::Meteo> object the call clones it,
merging any supplied parameters.
{
ua => { type => 'object', can => 'get', optional => 1 },
cache => { type => 'object', optional => 1 },
host => { type => 'scalar', optional => 1 },
min_interval => { type => 'scalar', optional => 1 },
logger => { type => 'object', can => 'error', optional => 1 },
}
=head4 Output
{ type => 'object', isa => 'Weather::Meteo' }
=head3 MESSAGES
Message Type Trigger
------------------------------------------------- ----- -----------------------------------
'ua' argument must be an object with a get() croak clone called with an invalid ua arg
method
Invalid host '$host': must be a plain hostname croak host contains @, /, or other chars
that are not safe in a DNS label
=cut | ||||||
| 197 | |||||||
| 198 | sub new { | ||||||
| 199 | 258 | 1 | 1274369 | my $class = shift; | |||
| 200 | 258 | 304 | my $params = Params::Get::get_params(undef, \@_) || {}; | ||||
| 201 | |||||||
| 202 | 258 | 2727 | if(!defined($class)) { | ||||
| 203 | # Weather::Meteo::new() used rather than Weather::Meteo->new() | ||||||
| 204 | 1 | 0 | $class = __PACKAGE__; | ||||
| 205 | } elsif(Scalar::Util::blessed($class)) { | ||||||
| 206 | # Clone path: merge new params over the existing object's fields. | ||||||
| 207 | 6 | 14 | if(exists($params->{ua})) { | ||||
| 208 | 1 | 4 | if(!defined($params->{ua})) { | ||||
| 209 | # ua=>undef means "keep the original" -- silently drop it | ||||||
| 210 | 0 | 0 | delete $params->{ua}; | ||||
| 211 | } elsif(!Scalar::Util::blessed($params->{ua}) || !$params->{ua}->can('get')) { | ||||||
| 212 | 0 | 0 | Carp::croak("'ua' argument must be an object with a get() method"); | ||||
| 213 | } | ||||||
| 214 | } | ||||||
| 215 | 6 6 6 | 4 8 15 | return bless { %{$class}, %{$params} }, ref($class); | ||||
| 216 | } | ||||||
| 217 | |||||||
| 218 | 252 | 259 | $params = Object::Configure::configure($class, $params); | ||||
| 219 | |||||||
| 220 | # Validate and untaint host: only DNS labels + optional port are accepted. | ||||||
| 221 | # Prevents SSRF via WEATHER__METEO__host env var or config file injection. | ||||||
| 222 | # Falsy values (undef, "", 0) are left as-is -- they fall back to DEFAULT_HOST | ||||||
| 223 | # in the bless statement and never reach the URL constructor. | ||||||
| 224 | 252 | 518286 | if($params->{host}) { | ||||
| 225 | 6 | 18 | (my $safe_host) = ($params->{host} =~ /\A([A-Za-z0-9][A-Za-z0-9.\-]*(:\d{1,5})?)\z/) | ||||
| 226 | or Carp::croak("Invalid host '$params->{host}': must be a plain hostname"); | ||||||
| 227 | 6 | 5 | $params->{host} = $safe_host; | ||||
| 228 | } | ||||||
| 229 | |||||||
| 230 | 252 | 143 | my $ua = $params->{ua}; | ||||
| 231 | 252 | 185 | if(!defined($ua)) { | ||||
| 232 | 222 | 356 | $ua = LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION"); | ||||
| 233 | 222 | 30657 | $ua->default_header(accept_encoding => 'gzip,deflate'); | ||||
| 234 | } | ||||||
| 235 | |||||||
| 236 | 252 | 3713 | my $cache = $params->{cache} || CHI->new( | ||||
| 237 | driver => 'Memory', | ||||||
| 238 | global => 1, | ||||||
| 239 | expires_in => EXPIRES_IN, | ||||||
| 240 | ); | ||||||
| 241 | |||||||
| 242 | return bless { | ||||||
| 243 | min_interval => $params->{min_interval} || MIN_INTERVAL, | ||||||
| 244 | last_request => 0, | ||||||
| 245 | 252 | 795 | %{$params}, | ||||
| 246 | cache => $cache, | ||||||
| 247 | 252 | 350586 | host => $params->{host} || DEFAULT_HOST, | ||||
| 248 | ua => $ua, | ||||||
| 249 | }, $class; | ||||||
| 250 | } | ||||||
| 251 | |||||||
| 252 - 357 | =head2 weather
use Geo::Location::Point;
my $ramsgate = Geo::Location::Point->new({ latitude => 51.34, longitude => 1.42 });
my $weather = $meteo->weather($ramsgate, '2022-12-25');
# Print snowfall at 1AM on Christmas morning in Ramsgate
my @snowfall = @{$weather->{'hourly'}->{'snowfall'}};
print 'Snowfall at 1AM: ', $snowfall[1], " cm\n";
use DateTime;
my $dt = DateTime->new(year => 2024, month => 2, day => 1);
$weather = $meteo->weather({ location => $ramsgate, date => $dt });
The date argument can be an ISO-8601 formatted string (C<YYYY-MM-DD>),
or any object that supports C<strftime>.
Takes an optional C<tz> argument containing the time zone.
If not given, the module tries to derive it from the location object;
set C<TIMEZONEDB_KEY> to your API key from L<https://timezonedb.com> to enable that.
If all else fails, the module falls back to C<Europe/London>.
Dates before 1940 return C<undef> silently.
Invalid date strings cause a C<carp> and return C<undef>.
Missing required arguments or non-numeric coordinates cause a C<croak>.
On success returns a hashref with at minimum an C<hourly> key.
The C<daily> key includes C<sunrise> and C<sunset> as ISO-8601 datetime strings
(e.g. C<2022-12-25T08:09>), as well as temperature, precipitation, and wind fields.
Returns C<undef> if the API returns an error, if the JSON cannot be
parsed, or if the response contains no C<hourly> key.
=head3 EXAMPLE
my $meteo = Weather::Meteo->new();
my $weather = $meteo->weather({ latitude => 51.34, longitude => 1.42, date => '2022-12-25' });
if(defined($weather)) {
my $max_temp = $weather->{'daily'}->{'temperature_2m_max'}[0];
my $sunrise = $weather->{'daily'}->{'sunrise'}[0];
my @temps = @{$weather->{'hourly'}->{'temperature_2m'}};
print "Max temp: ${max_temp}C Sunrise: $sunrise\n";
print "Temp at noon: $temps[12]C\n";
}
=head3 API SPECIFICATION
=head4 Input
Three call forms are accepted.
# Form 1 and 2 -- hashref or flat list
{
latitude => { type => 'scalar' },
longitude => { type => 'scalar' },
date => { type => 'scalar | object' },
tz => { type => 'scalar', optional => 1 },
location => { type => 'object', can => 'latitude', optional => 1 },
}
# Form 3 -- positional: ($location_obj, $date)
# $location_obj must respond to latitude() and longitude()
=head4 Output
{ type => 'hashref', min => 1 } # success -- contains 'hourly' key
undef # pre-1940 date, bad input, or API error
=head3 MESSAGES
Message Type Trigger
--------------------------------------------------- ----- ----------------------------------
Usage: weather(latitude => ...) croak lat, lon, or date is missing
Invalid latitude/longitude format ($lat, $lon) croak coordinate is not numeric
'$date' is not a valid date carp date string is not YYYY-MM-DD
Invalid date format. Expected YYYY-MM-DD croak strftime() returned wrong format
UA->get did not return a valid HTTP response carp UA returned non-response object
$url API returned error: $status carp HTTP 4xx/5xx response
Failed to parse JSON response: $err carp response body is not valid JSON
($err is the exception with control
chars stripped and length capped at
200 chars to prevent log injection)
Weather::Meteo: API error: $reason carp API returned {"error":true,...}
=head3 PSEUDOCODE
parse call form (3 variants: hashref, flat list, positional (location, date))
extract lat, lon, date, tz; resolve location object if given
croak if lat, lon, or date is missing
normalise leading-decimal coordinates via _normalise_coord()
validate coordinates with /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/
(atomic groups prevent ReDoS; list-context capture also untaints for perl -T)
croak if either coordinate does not match
if date is a strftime object: call strftime('%F'); croak if result not YYYY-MM-DD
return undef silently if year < 1940
carp and return undef if date string is not YYYY-MM-DD
return cached result if available
build URL for /v1/archive endpoint with hourly and daily fields
fetch and decode JSON via _fetch_json()
return undef if HTTP error, JSON error, or API-level error (with carp)
return undef if response has no 'hourly' key
store result in cache
return hashref (enforced by Return::Set)
=cut | ||||||
| 358 | |||||||
| 359 | sub weather | ||||||
| 360 | { | ||||||
| 361 | 189 | 1 | 7172 | my $self = shift; | |||
| 362 | 189 | 105 | my $params; | ||||
| 363 | |||||||
| 364 | 189 | 232 | if((scalar(@_) == 2) && Scalar::Util::blessed($_[0]) && ($_[0]->can('latitude'))) { | ||||
| 365 | # Two-arg positional form: (location_obj, date) | ||||||
| 366 | 10 | 6 | my $location = $_[0]; | ||||
| 367 | 10 | 11 | $params = { | ||||
| 368 | latitude => $location->latitude(), | ||||||
| 369 | longitude => $location->longitude(), | ||||||
| 370 | date => $_[1], | ||||||
| 371 | }; | ||||||
| 372 | $params->{'tz'} = $_[0]->tz() | ||||||
| 373 | 10 | 95 | if $_[0]->can('tz') && $ENV{'TIMEZONEDB_KEY'}; | ||||
| 374 | } else { | ||||||
| 375 | 179 | 142 | $params = Params::Get::get_params(undef, \@_); | ||||
| 376 | } | ||||||
| 377 | |||||||
| 378 | 187 | 1524 | my $latitude = $params->{latitude}; | ||||
| 379 | 187 | 94 | my $longitude = $params->{longitude}; | ||||
| 380 | 187 | 83 | my $location = $params->{'location'}; | ||||
| 381 | 187 | 80 | my $date = $params->{'date'}; | ||||
| 382 | 187 | 174 | my $tz = $params->{'tz'} || DEFAULT_TZ; | ||||
| 383 | |||||||
| 384 | 187 | 170 | if(!defined($latitude) && defined($location) && | ||||
| 385 | Scalar::Util::blessed($location) && $location->can('latitude')) { | ||||||
| 386 | 2 | 2 | $latitude = $location->latitude(); | ||||
| 387 | 2 | 7 | $longitude = $location->longitude(); | ||||
| 388 | } | ||||||
| 389 | |||||||
| 390 | 187 | 263 | if(!defined($latitude) || !defined($longitude) || !defined($date)) { | ||||
| 391 | 18 | 13 | my $msg = 'Usage: weather(latitude => $latitude, longitude => $longitude, date => "YYYY-MM-DD")'; | ||||
| 392 | 18 | 47 | $self->{'logger'}->error($msg) if $self->{'logger'}; | ||||
| 393 | 18 | 4032 | Carp::croak($msg); | ||||
| 394 | } | ||||||
| 395 | |||||||
| 396 | 169 | 126 | $latitude = _normalise_coord($latitude); | ||||
| 397 | 169 | 90 | $longitude = _normalise_coord($longitude); | ||||
| 398 | |||||||
| 399 | # Atomic groups prevent O(n) backtracking on adversarial input; list-context | ||||||
| 400 | # capture also untaints the values for taint-mode compliance. | ||||||
| 401 | 169 | 324 | my ($lat_clean) = ($latitude =~ /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/); | ||||
| 402 | 169 | 193 | my ($lon_clean) = ($longitude =~ /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/); | ||||
| 403 | 169 | 175 | if(!defined($lat_clean) || !defined($lon_clean)) { | ||||
| 404 | 12 | 11 | my $msg = __PACKAGE__ . ": Invalid latitude/longitude format ($latitude, $longitude)"; | ||||
| 405 | 12 | 19 | $self->{'logger'}->error($msg) if $self->{'logger'}; | ||||
| 406 | 12 | 2544 | Carp::croak($msg); | ||||
| 407 | } | ||||||
| 408 | 157 | 70 | $latitude = $lat_clean; | ||||
| 409 | 157 | 57 | $longitude = $lon_clean; | ||||
| 410 | |||||||
| 411 | 157 | 256 | if(Scalar::Util::blessed($date) && $date->can('strftime')) { | ||||
| 412 | 5 | 6 | $date = $date->strftime('%F'); | ||||
| 413 | } elsif($date =~ /^(\d{4})-/) { | ||||||
| 414 | 141 | 184 | return if $1 < FIRST_YEAR; | ||||
| 415 | } else { | ||||||
| 416 | 11 | 110 | Carp::carp("'$date' is not a valid date"); | ||||
| 417 | 11 | 1005 | return; | ||||
| 418 | } | ||||||
| 419 | |||||||
| 420 | 140 | 156 | unless($date =~ /^\d{4}-\d{2}-\d{2}$/) { | ||||
| 421 | 7 | 5 | my $msg = 'Invalid date format. Expected YYYY-MM-DD'; | ||||
| 422 | 7 | 16 | $self->{'logger'}->error($msg) if $self->{'logger'}; | ||||
| 423 | 7 | 1635 | Carp::croak($msg); | ||||
| 424 | } | ||||||
| 425 | |||||||
| 426 | 133 | 98 | my $cache_key = "weather:$latitude:$longitude:$date:$tz"; | ||||
| 427 | 133 | 154 | if(my $cached = $self->{'cache'}->get($cache_key)) { | ||||
| 428 | 17 | 1188 | return $cached; | ||||
| 429 | } | ||||||
| 430 | |||||||
| 431 | 116 | 3743 | my $uri = URI->new("https://$self->{host}/v1/archive"); | ||||
| 432 | 116 | 27307 | $uri->query_form( | ||||
| 433 | latitude => $latitude, | ||||||
| 434 | longitude => $longitude, | ||||||
| 435 | start_date => $date, | ||||||
| 436 | end_date => $date, | ||||||
| 437 | hourly => 'temperature_2m,rain,snowfall,weathercode', | ||||||
| 438 | daily => 'weathercode,temperature_2m_max,temperature_2m_min,rain_sum,snowfall_sum,precipitation_hours,windspeed_10m_max,windgusts_10m_max,sunrise,sunset', | ||||||
| 439 | timezone => $tz, | ||||||
| 440 | # https://stackoverflow.com/questions/16086962/how-to-get-a-time-zone-from-a-location-using-latitude-and-longitude-coordinates | ||||||
| 441 | windspeed_unit => 'mph', | ||||||
| 442 | precipitation_unit => 'inch', | ||||||
| 443 | ); | ||||||
| 444 | 116 | 11337 | my $url = $uri->as_string(); | ||||
| 445 | 116 | 373 | $url =~ s/%2C/,/g; | ||||
| 446 | |||||||
| 447 | 116 | 94 | my $rc = $self->_fetch_json($url); | ||||
| 448 | 116 | 169 | return unless defined($rc) && ref($rc) eq 'HASH'; | ||||
| 449 | |||||||
| 450 | 95 | 103 | if($rc->{'error'}) { | ||||
| 451 | # Surface the API-provided reason so callers can diagnose failures | ||||||
| 452 | 3 | 16 | my $reason = $rc->{'reason'} // 'unknown'; | ||||
| 453 | # eval guard: logger->error() may be fatal (e.g. Log::Abstraction), but | ||||||
| 454 | # the documented contract is to return undef, so we must not propagate the die | ||||||
| 455 | 3 3 | 3 6 | eval { $self->{'logger'}->error(__PACKAGE__ . ": API error: $reason") } if $self->{'logger'}; | ||||
| 456 | 3 | 664 | Carp::carp(__PACKAGE__ . ": API error: $reason"); | ||||
| 457 | 3 | 411 | return; | ||||
| 458 | } | ||||||
| 459 | |||||||
| 460 | 92 | 69 | return unless defined($rc->{'hourly'}); | ||||
| 461 | |||||||
| 462 | 88 | 114 | $self->{'cache'}->set($cache_key, $rc); | ||||
| 463 | 88 | 11768 | return Return::Set::set_return($rc, { type => 'hashref', min => 1 }); | ||||
| 464 | } | ||||||
| 465 | |||||||
| 466 - 559 | =head2 forecast
my $meteo = Weather::Meteo->new();
my $forecast = $meteo->forecast({ latitude => 51.34, longitude => 1.42 });
my @temps = @{$forecast->{'hourly'}->{'temperature_2m'}};
# Request 3 days of forecast
$forecast = $meteo->forecast({ latitude => 51.34, longitude => 1.42, days => 3 });
use Geo::Location::Point;
my $ramsgate = Geo::Location::Point->new({ latitude => 51.34, longitude => 1.42 });
$forecast = $meteo->forecast($ramsgate);
$forecast = $meteo->forecast($ramsgate, 5);
Fetches weather forecast data from L<https://api.open-meteo.com>.
Returns up to 16 days of hourly and daily data.
The C<daily> key of the response includes C<sunrise> and C<sunset> ISO-8601 datetime strings.
Takes an optional C<days> argument (integer 1-16, default 7).
Takes an optional C<tz> argument for the time zone; defaults to C<Europe/London>.
On success returns a hashref containing at minimum the key C<hourly>.
Returns C<undef> if the API returns an error, if the JSON cannot be parsed,
or if the response contains no C<hourly> key.
=head3 EXAMPLE
my $meteo = Weather::Meteo->new();
my $forecast = $meteo->forecast({ latitude => 51.34, longitude => 1.42, days => 5 });
if(defined($forecast)) {
my $daily = $forecast->{'daily'};
my @sunrises = @{$daily->{'sunrise'}};
my @max_temps = @{$daily->{'temperature_2m_max'}};
for my $i (0 .. $#sunrises) {
print "Day $i: sunrise $sunrises[$i], max $max_temps[$i]C\n";
}
}
=head3 API SPECIFICATION
=head4 Input
Three call forms are accepted.
# Form 1 and 2 -- hashref or flat list
{
latitude => { type => 'scalar' },
longitude => { type => 'scalar' },
days => { type => 'scalar', optional => 1 },
tz => { type => 'scalar', optional => 1 },
location => { type => 'object', can => 'latitude', optional => 1 },
}
# Form 3 -- positional: ($location_obj) or ($location_obj, $days)
# $location_obj must respond to latitude() and longitude()
=head4 Output
{ type => 'hashref', min => 1 } # success -- contains 'hourly' key
undef # bad input or API error
=head3 MESSAGES
Message Type Trigger
--------------------------------------------------- ----- ----------------------------------
Usage: forecast(latitude => ...) croak lat or lon is missing
Invalid latitude/longitude format ($lat, $lon) croak coordinate is not numeric
days must be between 1 and 16; defaulting to 7 carp days argument is out of range
UA->get did not return a valid HTTP response carp UA returned non-response object
$url API returned error: $status carp HTTP 4xx/5xx response
Failed to parse JSON response: $err carp response body is not valid JSON
($err is the exception with control
chars stripped and length capped at
200 chars to prevent log injection)
=head3 PSEUDOCODE
parse call form (3 variants: hashref, flat list, positional (location) or (location, days))
extract lat, lon, days, tz; resolve location object if given
croak if lat or lon is missing
normalise leading-decimal coordinates via _normalise_coord()
validate coordinates with /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/
(atomic groups prevent ReDoS; list-context capture also untaints for perl -T)
croak if either coordinate does not match
clamp days to 1-16: carp and default to 7 if out of range
return cached result if available
build URL for FORECAST_HOST/v1/forecast with forecast_days parameter
fetch and decode JSON via _fetch_json()
return undef on error or if response has no 'hourly' key
store result in cache
return hashref (enforced by Return::Set)
=cut | ||||||
| 560 | |||||||
| 561 | sub forecast | ||||||
| 562 | { | ||||||
| 563 | 27 | 1 | 448 | my $self = shift; | |||
| 564 | 27 | 14 | my $params; | ||||
| 565 | |||||||
| 566 | 27 | 69 | if(scalar(@_) >= 1 && Scalar::Util::blessed($_[0]) && $_[0]->can('latitude')) { | ||||
| 567 | # Positional form: (location_obj) or (location_obj, days) | ||||||
| 568 | 2 | 2 | my $location = $_[0]; | ||||
| 569 | 2 | 1 | $params = { | ||||
| 570 | latitude => $location->latitude(), | ||||||
| 571 | longitude => $location->longitude(), | ||||||
| 572 | }; | ||||||
| 573 | 2 | 13 | $params->{days} = $_[1] if defined($_[1]); | ||||
| 574 | $params->{tz} = $location->tz() | ||||||
| 575 | 2 | 3 | if $location->can('tz') && $ENV{'TIMEZONEDB_KEY'}; | ||||
| 576 | } else { | ||||||
| 577 | 25 | 24 | $params = Params::Get::get_params(undef, \@_); | ||||
| 578 | } | ||||||
| 579 | |||||||
| 580 | 27 | 239 | my $latitude = $params->{latitude}; | ||||
| 581 | 27 | 22 | my $longitude = $params->{longitude}; | ||||
| 582 | 27 | 14 | my $location = $params->{location}; | ||||
| 583 | 27 | 31 | my $days = $params->{days} // 7; | ||||
| 584 | 27 | 27 | my $tz = $params->{tz} || DEFAULT_TZ; | ||||
| 585 | |||||||
| 586 | 27 | 30 | if(!defined($latitude) && defined($location) && | ||||
| 587 | Scalar::Util::blessed($location) && $location->can('latitude')) { | ||||||
| 588 | 0 | 0 | $latitude = $location->latitude(); | ||||
| 589 | 0 | 0 | $longitude = $location->longitude(); | ||||
| 590 | } | ||||||
| 591 | |||||||
| 592 | 27 | 38 | if(!defined($latitude) || !defined($longitude)) { | ||||
| 593 | 3 | 3 | my $msg = 'Usage: forecast(latitude => $latitude, longitude => $longitude)'; | ||||
| 594 | 3 | 5 | $self->{'logger'}->error($msg) if $self->{'logger'}; | ||||
| 595 | 3 | 738 | Carp::croak($msg); | ||||
| 596 | } | ||||||
| 597 | |||||||
| 598 | 24 | 22 | $latitude = _normalise_coord($latitude); | ||||
| 599 | 24 | 16 | $longitude = _normalise_coord($longitude); | ||||
| 600 | |||||||
| 601 | 24 | 54 | my ($lat_clean) = ($latitude =~ /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/); | ||||
| 602 | 24 | 34 | my ($lon_clean) = ($longitude =~ /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/); | ||||
| 603 | 24 | 33 | if(!defined($lat_clean) || !defined($lon_clean)) { | ||||
| 604 | 1 | 1 | my $msg = __PACKAGE__ . ": Invalid latitude/longitude format ($latitude, $longitude)"; | ||||
| 605 | 1 | 2 | $self->{'logger'}->error($msg) if $self->{'logger'}; | ||||
| 606 | 1 | 220 | Carp::croak($msg); | ||||
| 607 | } | ||||||
| 608 | 23 | 10 | $latitude = $lat_clean; | ||||
| 609 | 23 | 28 | $longitude = $lon_clean; | ||||
| 610 | |||||||
| 611 | 23 | 54 | if($days !~ /^\d+$/ || $days < 1 || $days > 16) { | ||||
| 612 | 2 | 21 | Carp::carp('days must be between 1 and 16; defaulting to 7'); | ||||
| 613 | 2 | 158 | $days = 7; | ||||
| 614 | } | ||||||
| 615 | |||||||
| 616 | 23 | 17 | my $cache_key = "forecast:$latitude:$longitude:$days:$tz"; | ||||
| 617 | 23 | 29 | if(my $cached = $self->{'cache'}->get($cache_key)) { | ||||
| 618 | 2 | 136 | return $cached; | ||||
| 619 | } | ||||||
| 620 | |||||||
| 621 | 21 | 630 | my $uri = URI->new('https://' . FORECAST_HOST . '/v1/forecast'); | ||||
| 622 | 21 | 570 | $uri->query_form( | ||||
| 623 | latitude => $latitude, | ||||||
| 624 | longitude => $longitude, | ||||||
| 625 | forecast_days => $days, | ||||||
| 626 | hourly => 'temperature_2m,rain,snowfall,weathercode', | ||||||
| 627 | daily => 'weathercode,temperature_2m_max,temperature_2m_min,rain_sum,snowfall_sum,precipitation_hours,windspeed_10m_max,windgusts_10m_max,sunrise,sunset', | ||||||
| 628 | timezone => $tz, | ||||||
| 629 | windspeed_unit => 'mph', | ||||||
| 630 | precipitation_unit => 'inch', | ||||||
| 631 | ); | ||||||
| 632 | 21 | 1909 | my $url = $uri->as_string(); | ||||
| 633 | 21 | 68 | $url =~ s/%2C/,/g; | ||||
| 634 | |||||||
| 635 | 21 | 19 | my $rc = $self->_fetch_json($url); | ||||
| 636 | 21 | 30 | return unless defined($rc) && ref($rc) eq 'HASH'; | ||||
| 637 | 21 | 15 | return if $rc->{'error'}; | ||||
| 638 | 21 | 21 | return unless defined($rc->{'hourly'}); | ||||
| 639 | |||||||
| 640 | 21 | 19 | $self->{'cache'}->set($cache_key, $rc); | ||||
| 641 | 21 | 2654 | return Return::Set::set_return($rc, { type => 'hashref', min => 1 }); | ||||
| 642 | } | ||||||
| 643 | |||||||
| 644 - 749 | =head2 sunrise_sunset
my $meteo = Weather::Meteo->new();
# Historical date -- uses the archive endpoint
my $times = $meteo->sunrise_sunset({ latitude => 51.34, longitude => 1.42, date => '2022-12-25' });
print "Sunrise: $times->{sunrise}\n";
print "Sunset: $times->{sunset}\n";
# Today (no date given -- uses the forecast endpoint)
$times = $meteo->sunrise_sunset({ latitude => 51.34, longitude => 1.42 });
use Geo::Location::Point;
my $ramsgate = Geo::Location::Point->new({ latitude => 51.34, longitude => 1.42 });
$times = $meteo->sunrise_sunset($ramsgate, '2022-12-25');
Returns a hashref with C<sunrise> and C<sunset> ISO-8601 datetime strings
(e.g. C<2022-12-25T08:09>) for the given location and date.
If no date is supplied, today is used and the forecast endpoint is queried.
For historical dates (strictly before today) the archive endpoint is used.
For today and future dates the forecast endpoint (L<https://api.open-meteo.com>) is used.
Takes an optional C<tz> argument for the time zone; defaults to C<Europe/London>.
Returns C<undef> if the API returns an error or if the response does not contain
sunrise/sunset data.
=head3 EXAMPLE
my $meteo = Weather::Meteo->new();
my $times = $meteo->sunrise_sunset({ latitude => 48.8566, longitude => 2.3522 });
if(defined($times)) {
print "Paris sunrise today: $times->{sunrise}\n";
print "Paris sunset today: $times->{sunset}\n";
}
# Historical query
my $solstice = $meteo->sunrise_sunset({
latitude => 51.4779,
longitude => -0.0015,
date => '2024-06-21',
tz => 'Europe/London',
});
print "Greenwich sunrise on summer solstice 2024: $solstice->{sunrise}\n";
=head3 API SPECIFICATION
=head4 Input
Three call forms are accepted.
# Form 1 and 2 -- hashref or flat list
{
latitude => { type => 'scalar' },
longitude => { type => 'scalar' },
date => { type => ['scalar', 'object'], optional => 1 },
tz => { type => 'scalar', optional => 1 },
location => { type => 'object', can => 'latitude', optional => 1 },
}
# Form 3 -- positional: ($location_obj) or ($location_obj, $date)
# $location_obj must respond to latitude() and longitude()
=head4 Output
{ type => 'hashref' } # { sunrise => STRING, sunset => STRING }
undef # bad input or API error
=head3 MESSAGES
Message Type Trigger
--------------------------------------------------- ----- ----------------------------------
Usage: sunrise_sunset(latitude => ...) croak lat or lon is missing
Invalid latitude/longitude format ($lat, $lon) croak coordinate is not numeric
'$date' is not a valid date carp date string is not YYYY-MM-DD
UA->get did not return a valid HTTP response carp UA returned non-response object
$url API returned error: $status carp HTTP 4xx/5xx response
Failed to parse JSON response: $err carp response body is not valid JSON
($err is the exception with control
chars stripped and length capped at
200 chars to prevent log injection)
=head3 PSEUDOCODE
parse call form (3 variants: hashref, flat list, positional (location) or (location, date))
extract lat, lon, date, tz; resolve location object if given
croak if lat or lon is missing
normalise leading-decimal coordinates via _normalise_coord()
validate coordinates with /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/
(atomic groups prevent ReDoS; list-context capture also untaints for perl -T)
croak if either coordinate does not match
if date is a strftime object: call strftime('%F')
carp and return undef if date string is not YYYY-MM-DD
determine endpoint: archive for historical dates, forecast for today/future
default date to today if omitted
return cached result if available
build URL with daily=sunrise,sunset only (no hourly fields)
fetch and decode JSON via _fetch_json()
return undef on error or if daily sunrise/sunset arrays are absent
extract sunrise[0] and sunset[0]
store { sunrise, sunset } in cache
return hashref
=cut | ||||||
| 750 | |||||||
| 751 | sub sunrise_sunset | ||||||
| 752 | { | ||||||
| 753 | 18 | 1 | 446 | my $self = shift; | |||
| 754 | 18 | 6 | my $params; | ||||
| 755 | |||||||
| 756 | 18 | 46 | if(scalar(@_) >= 1 && Scalar::Util::blessed($_[0]) && $_[0]->can('latitude')) { | ||||
| 757 | # Positional form: (location_obj) or (location_obj, date) | ||||||
| 758 | 1 | 0 | my $location = $_[0]; | ||||
| 759 | 1 | 2 | $params = { | ||||
| 760 | latitude => $location->latitude(), | ||||||
| 761 | longitude => $location->longitude(), | ||||||
| 762 | }; | ||||||
| 763 | 1 | 6 | $params->{date} = $_[1] if defined($_[1]); | ||||
| 764 | $params->{tz} = $location->tz() | ||||||
| 765 | 1 | 4 | if $location->can('tz') && $ENV{'TIMEZONEDB_KEY'}; | ||||
| 766 | } else { | ||||||
| 767 | 17 | 18 | $params = Params::Get::get_params(undef, \@_); | ||||
| 768 | } | ||||||
| 769 | |||||||
| 770 | 18 | 149 | my $latitude = $params->{latitude}; | ||||
| 771 | 18 | 8 | my $longitude = $params->{longitude}; | ||||
| 772 | 18 | 18 | my $location = $params->{location}; | ||||
| 773 | 18 | 20 | my $tz = $params->{'tz'} || DEFAULT_TZ; | ||||
| 774 | |||||||
| 775 | 18 | 21 | if(!defined($latitude) && defined($location) && | ||||
| 776 | Scalar::Util::blessed($location) && $location->can('latitude')) { | ||||||
| 777 | 0 | 0 | $latitude = $location->latitude(); | ||||
| 778 | 0 | 0 | $longitude = $location->longitude(); | ||||
| 779 | } | ||||||
| 780 | |||||||
| 781 | 18 | 26 | if(!defined($latitude) || !defined($longitude)) { | ||||
| 782 | 2 | 1 | my $msg = 'Usage: sunrise_sunset(latitude => $latitude, longitude => $longitude)'; | ||||
| 783 | 2 | 4 | $self->{'logger'}->error($msg) if $self->{'logger'}; | ||||
| 784 | 2 | 484 | Carp::croak($msg); | ||||
| 785 | } | ||||||
| 786 | |||||||
| 787 | 16 | 13 | $latitude = _normalise_coord($latitude); | ||||
| 788 | 16 | 13 | $longitude = _normalise_coord($longitude); | ||||
| 789 | |||||||
| 790 | 16 | 36 | my ($lat_clean) = ($latitude =~ /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/); | ||||
| 791 | 16 | 20 | my ($lon_clean) = ($longitude =~ /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/); | ||||
| 792 | 16 | 21 | if(!defined($lat_clean) || !defined($lon_clean)) { | ||||
| 793 | 0 | 0 | my $msg = __PACKAGE__ . ": Invalid latitude/longitude format ($latitude, $longitude)"; | ||||
| 794 | 0 | 0 | $self->{'logger'}->error($msg) if $self->{'logger'}; | ||||
| 795 | 0 | 0 | Carp::croak($msg); | ||||
| 796 | } | ||||||
| 797 | 16 | 13 | $latitude = $lat_clean; | ||||
| 798 | 16 | 7 | $longitude = $lon_clean; | ||||
| 799 | |||||||
| 800 | 16 | 84 | my @t = localtime(time()); | ||||
| 801 | 16 | 26 | my $today = sprintf('%04d-%02d-%02d', $t[5] + 1900, $t[4] + 1, $t[3]); | ||||
| 802 | 16 | 10 | my $date = $params->{date}; | ||||
| 803 | |||||||
| 804 | 16 | 31 | if(defined($date) && Scalar::Util::blessed($date) && $date->can('strftime')) { | ||||
| 805 | 0 | 0 | $date = $date->strftime('%F'); | ||||
| 806 | } | ||||||
| 807 | |||||||
| 808 | 16 | 31 | if(defined($date) && $date !~ /^\d{4}-\d{2}-\d{2}$/) { | ||||
| 809 | 2 | 23 | Carp::carp("'$date' is not a valid date"); | ||||
| 810 | 2 | 123 | return; | ||||
| 811 | } | ||||||
| 812 | |||||||
| 813 | # No date means use forecast endpoint (more reliable for today than the archive) | ||||||
| 814 | 14 | 20 | my $use_forecast = !defined($date) || ($date ge $today); | ||||
| 815 | 14 | 10 | $date //= $today; | ||||
| 816 | |||||||
| 817 | 14 | 14 | my $cache_key = "sunrise_sunset:$latitude:$longitude:$date:$tz"; | ||||
| 818 | 14 | 18 | if(my $cached = $self->{'cache'}->get($cache_key)) { | ||||
| 819 | 3 | 171 | return $cached; | ||||
| 820 | } | ||||||
| 821 | |||||||
| 822 | 11 | 330 | my $endpoint_host = $use_forecast ? FORECAST_HOST : $self->{host}; | ||||
| 823 | 11 | 8 | my $endpoint_path = $use_forecast ? '/v1/forecast' : '/v1/archive'; | ||||
| 824 | |||||||
| 825 | 11 | 18 | my $uri = URI->new("https://$endpoint_host$endpoint_path"); | ||||
| 826 | 11 | 310 | $uri->query_form( | ||||
| 827 | latitude => $latitude, | ||||||
| 828 | longitude => $longitude, | ||||||
| 829 | start_date => $date, | ||||||
| 830 | end_date => $date, | ||||||
| 831 | daily => 'sunrise,sunset', | ||||||
| 832 | timezone => $tz, | ||||||
| 833 | ); | ||||||
| 834 | |||||||
| 835 | 11 | 627 | my $rc = $self->_fetch_json($uri->as_string()); | ||||
| 836 | 11 | 31 | return unless defined($rc) && ref($rc) eq 'HASH' && !$rc->{'error'}; | ||||
| 837 | |||||||
| 838 | 11 | 4 | my $daily = $rc->{'daily'}; | ||||
| 839 | 11 | 11 | return unless ref($daily) eq 'HASH'; | ||||
| 840 | |||||||
| 841 | 11 | 16 | my $sr = ref($daily->{'sunrise'}) eq 'ARRAY' ? $daily->{'sunrise'}[0] : undef; | ||||
| 842 | 11 | 9 | my $ss = ref($daily->{'sunset'}) eq 'ARRAY' ? $daily->{'sunset'}[0] : undef; | ||||
| 843 | 11 | 15 | return unless defined($sr) && defined($ss); | ||||
| 844 | |||||||
| 845 | 11 | 11 | my $result = { sunrise => $sr, sunset => $ss }; | ||||
| 846 | 11 | 15 | $self->{'cache'}->set($cache_key, $result); | ||||
| 847 | 11 | 1391 | return $result; | ||||
| 848 | } | ||||||
| 849 | |||||||
| 850 - 898 | =head2 ua
Accessor method to get and set the C<UserAgent> object used internally.
You can call C<env_proxy> for example, to get proxy information from
environment variables:
$meteo->ua()->env_proxy(1);
You can also replace the user agent entirely:
use LWP::UserAgent::Throttled;
my $ua = LWP::UserAgent::Throttled->new();
$ua->throttle('open-meteo.com' => 1);
$meteo->ua($ua);
=head3 EXAMPLE
my $meteo = Weather::Meteo->new();
# Getter: inspect the current UA
my $ua = $meteo->ua();
$ua->env_proxy(1);
# Setter: replace with a throttled UA
use LWP::UserAgent::Throttled;
$meteo->ua(LWP::UserAgent::Throttled->new());
=head3 API SPECIFICATION
=head4 Input
When called with no arguments acts as a getter; the input schema is empty.
When called with an argument the argument must be an object that responds to C<get>:
{ ua => { type => 'object', can => 'get' } }
=head4 Output
{ type => 'object', can => 'get' }
=head3 MESSAGES
Message Type Trigger
--------------------------------------------------- ----- ----------------------------------
ua() requires a defined value croak ua(undef) called
must be an object that understands the get method croak ua arg lacks get() method
=cut | ||||||
| 899 | |||||||
| 900 | sub ua { | ||||||
| 901 | 42 | 1 | 2025 | my $self = shift; | |||
| 902 | |||||||
| 903 | 42 | 34 | if(@_) { | ||||
| 904 | 24 | 31 | my $params = Params::Validate::Strict::validate_strict({ | ||||
| 905 | args => Params::Get::get_params('ua', \@_), | ||||||
| 906 | schema => { | ||||||
| 907 | ua => { | ||||||
| 908 | type => 'object', | ||||||
| 909 | can => 'get' | ||||||
| 910 | } | ||||||
| 911 | } | ||||||
| 912 | }); | ||||||
| 913 | # Reject undef explicitly before it silently corrupts $self->{ua} | ||||||
| 914 | 11 | 727 | if(!defined($params->{ua})) { | ||||
| 915 | 1 | 2 | $self->{'logger'}->error('ua() requires a defined value') if $self->{'logger'}; | ||||
| 916 | 1 | 216 | Carp::croak('ua() requires a defined value'); | ||||
| 917 | } | ||||||
| 918 | 10 | 12 | $self->{ua} = $params->{ua}; | ||||
| 919 | } | ||||||
| 920 | 28 | 66 | return $self->{ua}; | ||||
| 921 | } | ||||||
| 922 | |||||||
| 923 | # --------------------------------------------------------------------------- | ||||||
| 924 | # _normalise_coord -- fix a coordinate that leads with a bare decimal point | ||||||
| 925 | # | ||||||
| 926 | # Purpose: Perl and many user inputs write ".5" where "0.5" is required. | ||||||
| 927 | # The regex /^-?\d+(\.\d+)?$/ rejects the bare-dot form, so we | ||||||
| 928 | # normalise before validating. | ||||||
| 929 | # Entry: $coord -- a coordinate string, possibly with a leading "." | ||||||
| 930 | # Exit: normalised string: ".5" -> "0.5", "-.5" -> "-0.5", others unchanged | ||||||
| 931 | # Side effects: none | ||||||
| 932 | # --------------------------------------------------------------------------- | ||||||
| 933 | sub _normalise_coord { | ||||||
| 934 | 418 | 187 | my ($coord) = @_; | ||||
| 935 | 418 | 151 | my $result = $coord; | ||||
| 936 | # Anchored with \z; atomic group on \d+ prevents O(n) backtracking | ||||||
| 937 | 418 2 | 373 2 | if(my ($frac) = $result =~ /\A-\.((?>\d+))\z/) { $result = "-0.$frac" } | ||||
| 938 | 4 | 2 | elsif($result =~ /\A\./) { $result = "0$result" } | ||||
| 939 | 418 | 221 | return $result; | ||||
| 940 | } | ||||||
| 941 | |||||||
| 942 | # --------------------------------------------------------------------------- | ||||||
| 943 | # _enforce_rate_limit -- sleep until enough time has passed since the last call | ||||||
| 944 | # | ||||||
| 945 | # Purpose: Prevent hammering the API when min_interval > 0. | ||||||
| 946 | # Entry: $self -- Weather::Meteo instance with last_request and min_interval | ||||||
| 947 | # Exit: (nothing returned) | ||||||
| 948 | # Side effects: may block for up to min_interval seconds via Time::HiRes::sleep | ||||||
| 949 | # --------------------------------------------------------------------------- | ||||||
| 950 | sub _enforce_rate_limit { | ||||||
| 951 | 148 | 69 | my ($self) = @_; | ||||
| 952 | 148 | 110 | my $elapsed = time() - $self->{last_request}; | ||||
| 953 | 148 | 113 | if($elapsed < $self->{min_interval}) { | ||||
| 954 | 2 | 1000187 | Time::HiRes::sleep($self->{min_interval} - $elapsed); | ||||
| 955 | } | ||||||
| 956 | } | ||||||
| 957 | |||||||
| 958 | # --------------------------------------------------------------------------- | ||||||
| 959 | # _fetch_json -- HTTP GET a URL and decode the response body as JSON | ||||||
| 960 | # | ||||||
| 961 | # Purpose: Centralise the HTTP dispatch and JSON parsing steps that are | ||||||
| 962 | # common to all three public data methods, giving one place to | ||||||
| 963 | # maintain error-handling and rate-limiting logic. | ||||||
| 964 | # Entry: $self -- Weather::Meteo instance | ||||||
| 965 | # $url -- fully-formed request URL string | ||||||
| 966 | # Exit: decoded hashref (or other JSON value) on success; undef on error | ||||||
| 967 | # Side effects: enforces rate limit (may sleep); updates last_request timestamp; | ||||||
| 968 | # carps on HTTP errors and JSON parse failures | ||||||
| 969 | # --------------------------------------------------------------------------- | ||||||
| 970 | sub _fetch_json { | ||||||
| 971 | 148 | 107 | my ($self, $url) = @_; | ||||
| 972 | |||||||
| 973 | 148 | 111 | $self->_enforce_rate_limit(); | ||||
| 974 | |||||||
| 975 | 148 | 10244 | my $res = $self->{ua}->get($url); | ||||
| 976 | 148 | 3814 | $self->{last_request} = time(); | ||||
| 977 | |||||||
| 978 | 148 | 257 | unless(defined($res) && ref($res) && $res->can('is_error')) { | ||||
| 979 | 7 | 71 | Carp::carp(ref($self) . ': UA->get did not return a valid HTTP response'); | ||||
| 980 | 7 | 1049 | return; | ||||
| 981 | } | ||||||
| 982 | |||||||
| 983 | 141 | 520 | if($res->is_error()) { | ||||
| 984 | 5 | 26 | Carp::carp(ref($self) . ": $url API returned error: " . $res->status_line()); | ||||
| 985 | 5 | 471 | return; | ||||
| 986 | } | ||||||
| 987 | |||||||
| 988 | 136 | 375 | my $rc; | ||||
| 989 | 136 136 | 56 629 | eval { $rc = JSON::MaybeXS->new()->utf8()->decode($res->decoded_content()) }; | ||||
| 990 | 136 | 7169 | if($@) { | ||||
| 991 | # Sanitise the exception: strip control chars and cap length to prevent | ||||||
| 992 | # log injection or flooding from a malicious API response body | ||||||
| 993 | 8 | 7 | my $err = "$@"; | ||||
| 994 | 8 | 10 | $err =~ s/[[:cntrl:]]/ /g; | ||||
| 995 | 8 | 18 | $err = substr($err, 0, 200) . '...' if length($err) > 200; | ||||
| 996 | 8 | 81 | Carp::carp("Failed to parse JSON response: $err"); | ||||
| 997 | 8 | 856 | return; | ||||
| 998 | } | ||||||
| 999 | |||||||
| 1000 | 128 | 165 | return $rc; | ||||
| 1001 | } | ||||||
| 1002 | |||||||
| 1003 - 1336 | =head1 LIMITATIONS
=over 4
=item * Archive data lag
The Open-Meteo archive endpoint has a lag of approximately five days before
recent historical data becomes available.
For dates within the past five days,
C<weather()> may return C<undef> even when no error occurs.
Use C<forecast()> or C<sunrise_sunset()> (without a date) to obtain data for
today or recent days.
=item * Coordinate range
The module normalises coordinates with a bare leading decimal point (e.g.
C<".5"> to C<"0.5">) but does not validate that latitude is within C<-90..90>
or longitude within C<-180..180>.
Out-of-range values are passed to the API, which may return an error.
=item * No sub-hourly resolution
The hourly data arrays always contain exactly 24 entries per day (one per hour).
Sub-hourly resolution is not supported by this interface.
=item * Per-process rate limiting
The C<min_interval> rate limiter tracks the last request timestamp within a
single process instance.
Multiple concurrent processes or threads are not coordinated and may collectively
exceed the desired request rate.
=item * Timezone resolution requires an API key
Automatic per-location timezone resolution requires setting the
C<TIMEZONEDB_KEY> environment variable to a valid key from
L<https://timezonedb.com>.
Without it the module defaults to C<Europe/London> for all locations.
=item * No list-context support
C<weather()> and C<forecast()> enforce scalar/hashref context via
L<Return::Set>.
List context is not currently supported.
=item * Access control by convention only
Private methods (prefixed with C<_>) are not enforced by a module such as
L<Sub::Private>.
Callers are expected to treat them as internal; white-box test files may
access them directly.
=item * Host parameter restricted to plain DNS hostnames
The C<host> constructor parameter (and the C<WEATHER__METEO__host> environment
variable) must match C</\A[A-Za-z0-9][A-Za-z0-9.\-]*(:\d{1,5})?\z/>.
IP addresses in CIDR notation, URLs with path components, C<@>-style
user-info, and other special characters are rejected with a C<croak> to
prevent Server-Side Request Forgery.
If you need to test against a local service on a non-standard port, use a
plain C<hostname:port> string (e.g. C<localhost:8080>).
=item * Coordinate values limited to decimal numbers
Latitude and longitude must match C</\A-?(?>\d+)(?:\.(?>\d+))?\z/> after
leading-decimal normalisation.
Exponential notation (C<1.5e2>), hex (C<0x1F>), and strings with embedded
whitespace are rejected.
Pass a pre-formatted decimal string rather than a Perl numeric expression if
your caller might produce non-decimal representations.
=back
=head1 AUTHOR
Nigel Horne, C<< <njh@nigelhorne.com> >>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
Lots of thanks to the folks at L<https://open-meteo.com>.
=head1 BUGS
Please report any bugs or feature requests to C<bug-weather-meteo at rt.cpan.org>,
or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Weather-Meteo>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SEE ALSO
=over 4
=item * Open Meteo API: L<https://open-meteo.com/en/docs#api_form>
=item * L<Configure an Object at Runtime|Object::Configure>
=item * L<Test Dashboard|https://nigelhorne.github.io/Weather-Meteo/coverage/>
=back
=head1 SUPPORT
This module is provided as-is without any warranty.
You can find documentation for this module with the perldoc command.
perldoc Weather::Meteo
You can also look for information at:
=over 4
=item * MetaCPAN
L<https://metacpan.org/release/Weather-Meteo>
=item * RT: CPAN's request tracker
L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Weather-Meteo>
=item * CPANTS
L<http://cpants.cpanauthors.org/dist/Weather-Meteo>
=item * CPAN Testers' Matrix
L<http://matrix.cpantesters.org/?dist=Weather-Meteo>
=item * CPAN Testers Dependencies
L<http://deps.cpantesters.org/?module=Weather-Meteo>
=back
=head1 FORMAL SPECIFICATION
=head2 new
___ NEW ___________________________________________________
| class? : PACKAGE | Weather::Meteo |
| params? : NAME |--> VALUE |
|___________________________________________________________|
| result! : Weather::Meteo |
| |
| blessed(result!) = 'Weather::Meteo' |
| |
| params?.ua? => result!.ua = params?.ua |
| ~params?.ua => result!.ua : LWP::UserAgent |
| params?.cache? => result!.cache = params?.cache |
| ~params?.cache => result!.cache : CHI(Memory, global) |
| params?.host? ^ valid_hostname(params?.host?) |
| => result!.host = params?.host? |
| params?.host? ^ ~valid_hostname(params?.host?) |
| => croak /Invalid host/ |
| valid_hostname(h) ::= h =~ /\A[A-Za-z0-9][A-Za-z0-9.\-]*(:\d{1,5})?\z/ |
| ~params?.host? => result!.host = DEFAULT_HOST |
| params?.min_interval? => result!.min_interval = params?.min_interval |
| ~params?.min_interval => result!.min_interval = 0 |
| result!.last_request = 0 |
|___________________________________________________________|
| |
| PRE: class? is PACKAGE name or blessed Weather::Meteo |
| POST: blessed(result!) = 'Weather::Meteo' |
| forall k in params? . result!.k = params?.k |
|___________________________________________________________|
=head2 weather
___ WEATHER _______________________________________________
| self? : Weather::Meteo |
| latitude? : REAL |
| longitude? : REAL |
| date? : DATE_STRING | strftime_OBJECT |
| tz? : STRING (optional, default 'Europe/London')|
|____________________________________________________________|
| result! : HASHREF | undef |
|____________________________________________________________|
| |
| PRE (~latitude? v ~longitude? v ~date?) |
| => croak /Usage: weather\(latitude/ |
| |
| PRE lat? or lon? not matching |
| /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/ |
| (after leading-decimal normalisation via _normalise_coord) |
| => croak /Invalid latitude\/longitude format/ |
| NOTE: list-context capture untaints lat/lon (perl -T) |
| atomic groups eliminate O(n) backtracking |
| |
| PRE date? blessed ^ date?.can('strftime') |
| => date? := date?.strftime('%F') |
| PRE date? !~ /^\d{4}-\d{2}-\d{2}$/ |
| => croak /Invalid date format. Expected YYYY-MM-DD/ |
| |
| PRE year(date?) < 1940 |
| => result! = undef |
| |
| POST cache hit for (lat, lon, date, tz) |
| => result! = cached_value |
| |
| POST HTTP error response |
| => carp msg ^ result! = undef |
| |
| POST JSON parse failure |
| => carp /Failed to parse JSON response/ ^ result! = undef |
| |
| POST response.error = true |
| => carp /API error: reason/ ^ result! = undef |
| |
| POST ~response.hourly |
| => result! = undef |
| |
| POST otherwise |
| => result! = { hourly => HOURLY, daily => DAILY } |
| cache.set(key, result!) |
|____________________________________________________________|
=head2 forecast
___ FORECAST ______________________________________________
| self? : Weather::Meteo |
| latitude? : REAL |
| longitude? : REAL |
| days? : INTEGER [1..16] (optional, default 7) |
| tz? : STRING (optional, default 'Europe/London')|
|____________________________________________________________|
| result! : HASHREF | undef |
|____________________________________________________________|
| |
| PRE (~latitude? v ~longitude?) |
| => croak /Usage: forecast\(latitude/ |
| |
| PRE lat? or lon? not matching |
| /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/ |
| (after leading-decimal normalisation via _normalise_coord) |
| => croak /Invalid latitude\/longitude format/ |
| NOTE: list-context capture untaints lat/lon (perl -T) |
| atomic groups eliminate O(n) backtracking |
| |
| PRE days? defined ^ (days? < 1 v days? > 16) |
| => carp /days must be between 1 and 16/ |
| days? := 7 |
| |
| POST cache hit for (lat, lon, days, tz) |
| => result! = cached_value |
| |
| POST HTTP error response |
| => carp msg ^ result! = undef |
| |
| POST JSON parse failure |
| => carp /Failed to parse JSON response/ ^ result! = undef |
| |
| POST response.error = true |
| => result! = undef |
| |
| POST ~response.hourly |
| => result! = undef |
| |
| POST otherwise |
| => result! = { hourly => HOURLY, daily => DAILY } |
| cache.set(key, result!) |
|____________________________________________________________|
=head2 sunrise_sunset
___ SUNRISE_SUNSET ________________________________________
| self? : Weather::Meteo |
| latitude? : REAL |
| longitude? : REAL |
| date? : DATE_STRING (optional, default today) |
| tz? : STRING (optional, default 'Europe/London')|
|____________________________________________________________|
| result! : HASHREF | undef |
|____________________________________________________________|
| |
| PRE (~latitude? v ~longitude?) |
| => croak /Usage: sunrise_sunset\(latitude/ |
| |
| PRE lat? or lon? not matching |
| /\A(-?(?>\d+)(?:\.(?>\d+))?)\z/ |
| (after leading-decimal normalisation via _normalise_coord) |
| => croak /Invalid latitude\/longitude format/ |
| NOTE: list-context capture untaints lat/lon (perl -T) |
| atomic groups eliminate O(n) backtracking |
| |
| PRE date? defined ^ date? !~ /^\d{4}-\d{2}-\d{2}$/ |
| => carp /not a valid date/ ^ result! = undef |
| |
| POST ~date? v date? >= today |
| => uses forecast endpoint (api.open-meteo.com) |
| |
| POST date? < today |
| => uses archive endpoint (archive-api.open-meteo.com) |
| |
| POST cache hit for (lat, lon, date, tz) |
| => result! = cached_value |
| |
| POST HTTP error or JSON failure or ~daily.sunrise |
| => result! = undef |
| |
| POST otherwise |
| => result! = { sunrise => ISO8601, sunset => ISO8601 } |
| cache.set(key, result!) |
|____________________________________________________________|
=head2 ua
___ UA ____________________________________________________
| self? : Weather::Meteo |
| ua? : OBJECT [can 'get'] (optional) |
|____________________________________________________________|
| result! : OBJECT [can 'get'] |
|____________________________________________________________|
| |
| PRE ua? defined ^ ~ua?.can('get') |
| => croak /must be an object that understands the get method/ |
| |
| POST ua? defined |
| => self?.ua = ua? ^ result! = ua? |
| |
| POST ~ua? |
| => result! = self?.ua (no state change) |
|____________________________________________________________|
=head1 LICENSE AND COPYRIGHT
Copyright 2023-2026 Nigel Horne.
Usage is subject to the GPL2 licence terms.
If you use it,
please let me know.
=cut | ||||||
| 1337 | |||||||
| 1338 | 1; | ||||||