File Coverage

File:blib/lib/Weather/Meteo.pm
Coverage:70.0%

linestmtbrancondsubtimecode
1package Weather::Meteo;
2
3
6
6
6
6
530660
5
85
use strict;
4
6
6
6
6
9
4
110
use warnings;
5
6
6
6
6
6
11
5
146
use Carp;
7
6
6
6
6
1349
168796
111
use CHI;
8
6
6
6
6
20
5
179
use JSON::MaybeXS;
9
6
6
6
6
1961
115561
116
use LWP::UserAgent;
10
6
6
6
6
1375
318447
143
use Object::Configure;
11
6
6
6
6
27
49
100
use Params::Get 0.13;
12
6
6
6
6
12
5
72
use Params::Validate::Strict;
13
6
6
6
6
7
6
54
use Return::Set;
14
6
6
6
6
8
6
56
use Scalar::Util;
15
6
6
6
6
9
4
23
use Time::HiRes;
16
6
6
6
6
211
5
68
use URI;
17
18
6
6
6
6
11
7
163
use constant FIRST_YEAR => 1940;
19
6
6
6
6
17
11
115
use constant EXPIRES_IN => '1 hour';
20
6
6
6
6
9
8
3728
use constant MIN_INTERVAL => 0;      # default: no rate-limiting delay
21
22 - 30
=head1 NAME

Weather::Meteo - Interface to L<https://open-meteo.com> for historical weather data

=head1 VERSION

Version 0.12

=cut
31
32our $VERSION = '0.12';
33
34 - 122
=head1 SYNOPSIS

The C<Weather::Meteo> module provides an interface to the Open-Meteo API for retrieving historical weather data from 1940.
It allows users to fetch weather information by specifying latitude, longitude, and a date.
The module supports object-oriented usage and allows customization of the HTTP user agent.

      use Weather::Meteo;

      my $meteo = Weather::Meteo->new();
      my $weather = $meteo->weather({ latitude => 0.1, longitude => 0.2, date => '2022-12-25' });

=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.

This module leverages L<CHI> for caching geocoding responses.
When a geocode request is made,
a cache key is constructed from the request.
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();
    my $ua = LWP::UserAgent->new();
    $ua->env_proxy(1);
    $meteo = Weather::Meteo->new(ua => $ua);

    my $weather = $meteo->weather({ latitude => 51.34, longitude => 1.42, date => '2022-12-25' });
    my @snowfall = @{$weather->{'hourly'}->{'snowfall'}};

    print 'Number of cms of snow: ', $snowfall[1], "\n";

Creates a new instance. Acceptable options include:

=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 API host endpoint.
Defaults to L<https://archive-api.open-meteo.com>.

=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 user agent is created.

=back

The class can be configured at runtime using environments 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>.

=cut
123
124sub new {
125
9
9
412511
        my $class = shift;
126
9
100
34
        my $params = Params::Get::get_params(undef, \@_) || {};
127
128
9
100
100
155
        if(!defined($class)) {
129                # Weather::Meteo::new() used rather than Weather::Meteo->new()
130
1
1
                $class = __PACKAGE__;
131        } elsif(Scalar::Util::blessed($class)) {
132                # If $class is an object, clone it with new arguments
133
1
1
1
1
3
4
                return bless { %{$class}, %{$params} }, ref($class);
134        }
135
136
8
27
        $params = Object::Configure::configure($class, $params);
137
138
8
123416
        my $ua = $params->{ua};
139
8
100
18
        if(!defined($ua)) {
140
7
37
                $ua = LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION");
141
7
5919
                $ua->default_header(accept_encoding => 'gzip,deflate');
142        }
143
8
50
224
        my $host = $params->{host} || 'archive-api.open-meteo.com';
144
145        # Set up caching (default to an in-memory cache if none provided)
146
8
67
36
        my $cache = $params->{cache} || CHI->new(
147                driver => 'Memory',
148                global => 1,
149                expires_in => EXPIRES_IN,
150        );
151
152        # Set up rate-limiting: minimum interval between requests (in seconds)
153
8
100
183395
        my $min_interval = $params->{min_interval} || MIN_INTERVAL;
154
155        return bless {
156                min_interval => $min_interval,
157                last_request => 0,   # Initialize last_request timestamp
158
8
8
10
57
                %{$params},
159                cache => $cache,
160                host => $host,
161                ua => $ua
162        }, $class;
163}
164
165 - 188
=head2 weather

    use Geo::Location::Point;

    my $ramsgate = Geo::Location::Point->new({ latitude => 51.34, longitude => 1.42 });
    # Print snowfall at 1AM on Christmas morning in Ramsgate
    $weather = $meteo->weather($ramsgate, '2022-12-25');
    @snowfall = @{$weather->{'hourly'}->{'snowfall'}};

    print 'Number of cms of snow: ', $snowfall[1], "\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 date,
or an object that understands the strftime method.

Takes an optional argument, tz, containing the time zone.
If not given, the module tries to work it out from the given location,
for that to work set TIMEZONEDB_KEY to be your API key from L<https://timezonedb.com>.
If all else fails, the module falls back to Europe/London.

=cut
189
190sub weather
191{
192
8
8
2862
        my $self = shift;
193
8
6
        my $params;
194
195
8
50
25
20
        if((scalar(@_) == 2) && Scalar::Util::blessed($_[0]) && ($_[0]->can('latitude'))) {
196                # Two arguments - a location object and a date
197
0
0
                my $location = $_[0];
198
0
0
                $params->{latitude} = $location->latitude();
199
0
0
                $params->{longitude} = $location->longitude();
200
0
0
                $params->{'date'} = $_[1];
201
0
0
0
0
                if($_[0]->can('tz') && $ENV{'TIMEZONEDB_KEY'}) {
202
0
0
                        $params->{'tz'} = $_[0]->tz();
203                }
204        } else {
205
8
18
                $params = Params::Get::get_params(undef, \@_);
206        }
207
208
8
97
        my $latitude = $params->{latitude};
209
8
7
        my $longitude = $params->{longitude};
210
8
8
        my $location = $params->{'location'};
211
8
5
        my $date = $params->{'date'};
212
8
50
18
        my $tz = $params->{'tz'} || 'Europe/London';
213
214
8
0
40
20
        if((!defined($latitude)) && defined($location) &&
215           Scalar::Util::blessed($location) && $location->can('latitude')) {
216
0
0
                $latitude = $location->latitude();
217
0
0
                $longitude = $location->longitude();
218        }
219
8
50
50
23
        if((!defined($latitude)) || (!defined($longitude)) || (!defined($date))) {
220
2
50
8
                if(my $logger = $self->{'logger'}) {
221
2
7
                        $logger->error('Usage: weather(latitude => $latitude, longitude => $longitude, date => "YYYY-MM-DD")');
222                }
223
2
702
                Carp::croak('Usage: weather(latitude => $latitude, longitude => $longitude, date => "YYYY-MM-DD")');
224
0
0
                return;
225        }
226
227        # Handle numbers starting with a decimal point
228
6
50
21
        if($latitude =~ /^\./) {
229
0
0
                $latitude = "0$latitude";
230        }
231
6
50
13
        if($latitude =~ /^\-\.(\d+)$/) {
232
0
0
                $latitude = "-0.$1";
233        }
234
6
50
13
        if($longitude =~ /^\./) {
235
0
0
                $longitude = "0$longitude";
236        }
237
6
50
7
        if($longitude =~ /^\-\.(\d+)$/) {
238
0
0
                $longitude = "-0.$1";
239        }
240
241
6
50
33
35
        if(($latitude !~ /^-?\d+(\.\d+)?$/) || ($longitude !~ /^-?\d+(\.\d+)?$/)) {
242
0
0
0
                if(my $logger = $self->{'logger'}) {
243
0
0
                        $self->error(__PACKAGE__ . ": Invalid latitude/longitude format ($latitude, $longitude)");
244                }
245
0
0
                Carp::croak(__PACKAGE__, ": Invalid latitude/longitude format ($latitude, $longitude)");
246        }
247
248
6
50
100
33
22
        if(Scalar::Util::blessed($date) && $date->can('strftime')) {
249
0
0
                $date = $date->strftime('%F');
250        } elsif($date =~ /^(\d{4})-/) {
251
5
100
12
                return if($1 < FIRST_YEAR);
252        } else {
253
1
3
                Carp::carp("'$date' is not a valid date");
254
1
144
                return;
255        }
256
257
4
50
7
        unless($date =~ /^\d{4}-\d{2}-\d{2}$/) {
258
0
0
0
                if(my $logger = $self->{'logger'}) {
259
0
0
                        $self->error('Invalid date format. Expected YYYY-MM-DD');
260                }
261
0
0
                croak('Invalid date format. Expected YYYY-MM-DD');
262        }
263
264
4
22
        my $uri = URI->new("https://$self->{host}/v1/archive");
265
4
7507
        my %query_parameters = (
266                'latitude' => $latitude,
267                'longitude' => $longitude,
268                'start_date' => $date,
269                'end_date' => $date,
270                'hourly' => 'temperature_2m,rain,snowfall,weathercode',
271                'daily' => 'weathercode,temperature_2m_max,temperature_2m_min,rain_sum,snowfall_sum,precipitation_hours,windspeed_10m_max,windgusts_10m_max',
272                'timezone' => $tz,
273                        # https://stackoverflow.com/questions/16086962/how-to-get-a-time-zone-from-a-location-using-latitude-and-longitude-coordinates
274                'windspeed_unit' => 'mph',
275                'precipitation_unit' => 'inch'
276        );
277
278
4
15
        $uri->query_form(%query_parameters);
279
4
616
        my $url = $uri->as_string();
280
281
4
19
        $url =~ s/%2C/,/g;
282
283        # Create a cache key based on the location, date and time zone (might want to use a stronger hash function if needed)
284
4
18
        my $cache_key = "weather:$latitude:$longitude:$date:$tz";
285
4
50
20
        if(my $cached = $self->{cache}->get($cache_key)) {
286
0
0
                return $cached;
287        }
288
289        # Enforce rate-limiting: ensure at least min_interval seconds between requests
290
4
259
        my $now = time();
291
4
10
        my $elapsed = $now - $self->{last_request};
292
4
100
5
        if($elapsed < $self->{min_interval}) {
293
1
1000202
                Time::HiRes::sleep($self->{min_interval} - $elapsed);
294        }
295
296
4
27
        my $res = $self->{ua}->get($url);
297
298        # Update last_request timestamp
299
4
243
        $self->{last_request} = time();
300
301
4
50
11
        if($res->is_error()) {
302
0
0
                Carp::carp(ref($self), ": $url API returned error: ", $res->status_line());
303
0
0
                return;
304        }
305        # $res->content_type('text/plain');  # May be needed to decode correctly
306
307
4
24
        my $rc;
308
4
4
5
58
        eval { $rc = JSON::MaybeXS->new()->utf8()->decode($res->decoded_content()) };
309
4
100
685
        if($@) {
310
1
5
                Carp::carp("Failed to parse JSON response: $@");
311
1
433
                return;
312        }
313
314
3
50
7
        if($rc) {
315
3
50
5
                if($rc->{'error'}) {
316                        # TODO: print error code
317
0
0
                        return;
318                }
319
3
50
5
                if(defined($rc->{'hourly'})) {
320                        # Cache the result before returning it
321
3
15
                        $self->{'cache'}->set($cache_key, $rc);
322
323
3
835
                        return Return::Set::set_return($rc, { type => 'hashref', min => 1 });     # No support for list context, yet
324                }
325        }
326
327        # my @results = @{ $data || [] };
328        # wantarray ? @results : $results[0];
329}
330
331 - 347
=head2 ua

Accessor method to get and set UserAgent object used internally.
You can call I<env_proxy> for example, to get the proxy information from
environment variables:

    $meteo->ua()->env_proxy(1);

You can also set your own User-Agent object:

    use LWP::UserAgent::Throttled;

    my $ua = LWP::UserAgent::Throttled->new();
    $ua->throttle('open-meteo.com' => 1);
    $meteo->ua($ua);

=cut
348
349sub ua {
350
0
0
        my $self = shift;
351
352
0
0
        if (@_) {
353
0
                my $params = Params::Validate::Strict::validate_strict({
354                        args => Params::Get::get_params('ua', @_),
355                        schema => {
356                                ua => {
357                                        type => 'object',
358                                        can => 'get'
359                                }
360                        }
361                });
362
0
                $self->{ua} = $params->{ua};
363        }
364
0
        return $self->{ua};
365}
366
367 - 436
=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 * L<Test Dashboard|https://nigelhorne.github.io/Weather-Meteo/coverage/>

=item * Open Meteo API: L<https://open-meteo.com/en/docs#api_form>

=item * L<Object::Configure>

=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 LICENSE AND COPYRIGHT

Copyright 2023-2025 Nigel Horne.

This program is released under the following licence: GPL2

=cut
437
4381;