| File: | blib/lib/TimeZone/TimeZoneDB.pm |
| Coverage: | 76.6% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package TimeZone::TimeZoneDB; | |||||
| 2 | ||||||
| 3 | 4 4 4 | 328646 4 53 | use strict; | |||
| 4 | 4 4 4 | 6 3 66 | use warnings; | |||
| 5 | ||||||
| 6 | 4 4 4 | 8 2 76 | use Carp; | |||
| 7 | 4 4 4 | 800 96344 56 | use CHI; | |||
| 8 | 4 4 4 | 12 1 120 | use JSON::MaybeXS; | |||
| 9 | 4 4 4 | 911 61980 56 | use LWP::UserAgent; | |||
| 10 | 4 4 4 | 763 148659 60 | use Object::Configure; | |||
| 11 | 4 4 4 | 13 23 58 | use Params::Get 0.13; | |||
| 12 | 4 4 4 | 6 26 46 | use Params::Validate::Strict 0.10; | |||
| 13 | 4 4 4 | 7 2 37 | use Return::Set; | |||
| 14 | 4 4 4 | 4 4 36 | use Scalar::Util; | |||
| 15 | 4 4 4 | 7 3 13 | use Time::HiRes; | |||
| 16 | 4 4 4 | 145 3 1505 | use URI; | |||
| 17 | ||||||
| 18 - 26 | =head1 NAME TimeZone::TimeZoneDB - Interface to L<https://timezonedb.com> for looking up Timezone data =head1 VERSION Version 0.04 =cut | |||||
| 27 | ||||||
| 28 | our $VERSION = '0.04'; | |||||
| 29 | ||||||
| 30 - 116 | =head1 SYNOPSIS
use TimeZone::TimeZoneDB;
my $tzdb = TimeZone::TimeZoneDB->new(key => 'XXXXXXXX');
my $tz = $tzdb->get_time_zone({ latitude => 0.1, longitude => 0.2 });
=head1 DESCRIPTION
The C<TimeZone::TimeZoneDB> Perl module provides an interface to the L<https://timezonedb.com> API,
enabling users to retrieve timezone data based on geographic coordinates.
It supports configurable HTTP user agents, allowing for proxy settings and request throttling.
The module includes robust error handling, ensuring proper validation of input parameters and secure API interactions.
JSON responses are safely parsed with error handling to prevent crashes.
Designed for flexibility,
it allows users to override default configurations while maintaining a lightweight and efficient structure for querying timezone information.
=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 $tzdb = TimeZone::TimeZoneDB->new();
my $ua = LWP::UserAgent::Throttled->new();
$ua->env_proxy(1);
$tzdb = TimeZone::TimeZoneDB->new(ua => $ua, key => 'XXXXX');
my $tz = $tzdb->get_time_zone({ latitude => 51.34, longitude => 1.42 })->{'zoneName'};
print "Ramsgate's time zone is $tz.\n";
Creates a new instance. Acceptable options include:
=over 4
=item * C<ua>
An object to use for HTTP requests.
If not provided, a default user agent is created.
=item * C<host>
The API host endpoint.
Defaults to L<https://api.timezonedb.com>
=item * C<cache>
A caching object.
If not provided,
an in-memory cache is created with a default expiration of one day.
=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.
=back
=cut | |||||
| 117 | ||||||
| 118 | sub new | |||||
| 119 | { | |||||
| 120 | 5 | 213384 | my $class = shift; | |||
| 121 | 5 | 11 | my $params = Params::Get::get_params(undef, \@_) || {}; | |||
| 122 | ||||||
| 123 | 5 | 86 | if(!defined($class)) { | |||
| 124 | # TimeZone::TimeZoneDB::new() used rather than TimeZone::TimeZoneDB->new() | |||||
| 125 | 0 | 0 | $class = __PACKAGE__; | |||
| 126 | } elsif(Scalar::Util::blessed($class)) { | |||||
| 127 | # If $class is an object, clone it with new arguments | |||||
| 128 | 0 0 0 | 0 0 0 | return bless { %{$class}, %{$params} }, ref($class); | |||
| 129 | } | |||||
| 130 | ||||||
| 131 | 5 | 13 | $params = Object::Configure::configure($class, $params); # Reads in the runtime configuration settings | |||
| 132 | ||||||
| 133 | 5 | 49244 | my $key = $params->{'key'} or Carp::croak("'key' argument is required"); | |||
| 134 | ||||||
| 135 | 4 | 3 | my $ua = $params->{ua}; | |||
| 136 | 4 | 5 | if(!defined($ua)) { | |||
| 137 | 1 | 4 | $ua = LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION"); | |||
| 138 | 1 | 1236 | $ua->default_header(accept_encoding => 'gzip,deflate'); | |||
| 139 | } | |||||
| 140 | 4 | 49 | my $host = $params->{host} || 'api.timezonedb.com'; | |||
| 141 | ||||||
| 142 | # Set up caching (default to an in-memory cache if none provided) | |||||
| 143 | 4 | 9 | my $cache = $params->{cache} || CHI->new( | |||
| 144 | driver => 'Memory', | |||||
| 145 | global => 0, | |||||
| 146 | expires_in => '1 day', | |||||
| 147 | ); | |||||
| 148 | ||||||
| 149 | # Set up rate-limiting: minimum interval between requests (in seconds) | |||||
| 150 | 4 | 44055 | my $min_interval = $params->{min_interval} || 0; # default: no delay | |||
| 151 | ||||||
| 152 | return bless { | |||||
| 153 | key => $key, | |||||
| 154 | min_interval => $min_interval, | |||||
| 155 | last_request => 0, # Initialize last_request timestamp | |||||
| 156 | 4 4 | 4 19 | %{$params}, | |||
| 157 | cache => $cache, | |||||
| 158 | host => $host, | |||||
| 159 | ua => $ua, | |||||
| 160 | }, $class; | |||||
| 161 | } | |||||
| 162 | ||||||
| 163 - 192 | =head2 get_time_zone
Returns a hashref with at least one key (the zoneName)
use Geo::Location::Point;
my $ramsgate = Geo::Location::Point->new({ latitude => 51.34, longitude => 1.42 });
# Find Ramsgate's time zone
$tz = $tzdb->get_time_zone($ramsgate)->{'zoneName'}, "\n";
=head3 API SPECIFICATION
=head4 INPUT
{
'latitude' => { type => 'number', min => -90, max => 90 },
'longitude' => { type => 'number', min => -180, max => 180 },
}
=head4 OUTPUT
Argument error: croak
No matches found: undef
{
'type' => 'hashref',
'min' => 1
}
=cut | |||||
| 193 | ||||||
| 194 | sub get_time_zone | |||||
| 195 | { | |||||
| 196 | 4 | 127 | my $self = shift; | |||
| 197 | 4 | 6 | my $params; | |||
| 198 | ||||||
| 199 | 4 | 15 | if((@_ == 1) && Scalar::Util::blessed($_[0]) && $_[0]->can('latitude')) { | |||
| 200 | 2 | 2 | my $location = $_[0]; | |||
| 201 | 2 | 3 | $params->{latitude} = $location->latitude(); | |||
| 202 | 2 | 17 | $params->{longitude} = $location->longitude(); | |||
| 203 | } else { | |||||
| 204 | 2 | 3 | $params = Params::Get::get_params(undef, \@_); | |||
| 205 | } | |||||
| 206 | ||||||
| 207 | 4 | 35 | $params = Params::Validate::Strict::validate_strict( | |||
| 208 | args => $params, | |||||
| 209 | schema => { | |||||
| 210 | 'latitude' => { type => 'number', min => -90, max => 90 }, | |||||
| 211 | 'longitude' => { type => 'number', min => -180, max => 180 }, | |||||
| 212 | } | |||||
| 213 | ); | |||||
| 214 | ||||||
| 215 | 3 | 172 | my $latitude = $params->{latitude}; | |||
| 216 | 3 | 2 | my $longitude = $params->{longitude}; | |||
| 217 | ||||||
| 218 | 3 | 8 | if((!defined($latitude)) || (!defined($longitude))) { | |||
| 219 | 0 | 0 | Carp::carp('Usage: get_time_zone(latitude => $latitude, longitude => $longitude)'); | |||
| 220 | 0 | 0 | return; | |||
| 221 | } | |||||
| 222 | ||||||
| 223 | 3 | 11 | my $uri = URI->new("https://$self->{host}/v2.1/get-time-zone"); | |||
| 224 | ||||||
| 225 | # Note - we have to pass in the key in the URL, as the API doesn't support the Authorization header | |||||
| 226 | $uri->query_form( | |||||
| 227 | by => 'position', | |||||
| 228 | lat => $latitude, | |||||
| 229 | lng => $longitude, | |||||
| 230 | format => 'json', | |||||
| 231 | 3 | 7302 | key => $self->{'key'} | |||
| 232 | ); | |||||
| 233 | 3 | 270 | my $url = $uri->as_string(); | |||
| 234 | ||||||
| 235 | # # Set up HTTP headers | |||||
| 236 | # my $req = HTTP::Request->new(GET => $url); | |||||
| 237 | # $req->header('Authorization' => "Bearer $self->{key}"); | |||||
| 238 | ||||||
| 239 | # $url =~ s/%2C/,/g; | |||||
| 240 | ||||||
| 241 | # Create a cache key based on the location (might want to use a stronger hash function if needed) | |||||
| 242 | # Normalize the key so that 0.1 vs 0.1000000 use the same key | |||||
| 243 | 3 | 19 | my $cache_key = sprintf('tz:%.6f:%.6f', $latitude, $longitude); | |||
| 244 | 3 | 11 | if(my $cached = $self->{cache}->get($cache_key)) { | |||
| 245 | 0 | 0 | return $cached; | |||
| 246 | } | |||||
| 247 | ||||||
| 248 | # Enforce rate-limiting: ensure at least min_interval seconds between requests | |||||
| 249 | 3 | 186 | my $now = time(); | |||
| 250 | 3 | 5 | my $elapsed = $now - $self->{last_request}; | |||
| 251 | 3 | 8 | if($elapsed < $self->{min_interval}) { | |||
| 252 | 1 | 1000203 | Time::HiRes::sleep($self->{min_interval} - $elapsed); | |||
| 253 | } | |||||
| 254 | ||||||
| 255 | 3 | 26 | my $res = $self->{ua}->get($url); | |||
| 256 | # my $res = $self->{ua}->request($req); | |||||
| 257 | ||||||
| 258 | # Update last_request timestamp | |||||
| 259 | 3 | 184 | $self->{last_request} = time(); | |||
| 260 | ||||||
| 261 | 3 | 7 | if($res->is_error()) { | |||
| 262 | 0 | 0 | Carp::croak("$url API returned error: ", $res->status_line()); | |||
| 263 | 0 | 0 | return; | |||
| 264 | } | |||||
| 265 | # $res->content_type('text/plain'); # May be needed to decode correctly | |||||
| 266 | ||||||
| 267 | 3 | 20 | my $rc; | |||
| 268 | 3 3 | 4 45 | eval { $rc = JSON::MaybeXS->new()->utf8()->decode($res->decoded_content()) }; | |||
| 269 | 3 | 372 | if($@) { | |||
| 270 | 0 | 0 | Carp::carp("Failed to parse JSON response: $@"); | |||
| 271 | 0 | 0 | return; | |||
| 272 | } | |||||
| 273 | ||||||
| 274 | # Cache the result before returning it | |||||
| 275 | 3 | 12 | $self->{'cache'}->set($cache_key, $rc); | |||
| 276 | ||||||
| 277 | 3 | 744 | if($rc && defined($rc->{'status'}) && ($rc->{'status'} ne 'OK')) { | |||
| 278 | 0 | 0 | if(my $logger = $self->{'logger'}) { | |||
| 279 | 0 | 0 | $logger->warn(__PACKAGE__, ": $url returns $rc->{status}"); | |||
| 280 | } | |||||
| 281 | 0 | 0 | return; | |||
| 282 | } | |||||
| 283 | ||||||
| 284 | # Assert output: a hashref with at least one key (the zoneName) | |||||
| 285 | 3 | 13 | return Return::Set::set_return($rc, { 'type' => 'hashref', 'min' => 1 }); # No support for list context, yet | |||
| 286 | ||||||
| 287 | # my @results = @{ $data || [] }; | |||||
| 288 | # wantarray ? @results : $results[0]; | |||||
| 289 | } | |||||
| 290 | ||||||
| 291 - 308 | =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:
$tzdb->ua()->env_proxy(1);
Free accounts are limited to one search a second,
so you can use L<LWP::UserAgent::Throttled> to keep within that limit.
use LWP::UserAgent::Throttled;
my $ua = LWP::UserAgent::Throttled->new();
$ua->throttle('timezonedb.com' => 1);
$tzdb->ua($ua);
=cut | |||||
| 309 | ||||||
| 310 | sub ua { | |||||
| 311 | 0 | my $self = shift; | ||||
| 312 | 0 | if (@_) { | ||||
| 313 | 0 | $self->{ua} = shift; | ||||
| 314 | } | |||||
| 315 | 0 | $self->{ua}; | ||||
| 316 | } | |||||
| 317 | ||||||
| 318 - 353 | =head1 AUTHOR Nigel Horne, C<< <njh@bandsman.co.uk> >> 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://timezonedb.com>. =head1 BUGS This module is provided as-is without any warranty. Please report any bugs or feature requests to C<bug-timezone-timezonedb at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=TimeZone-TimeZoneDB>. 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 * TimezoneDB API: L<https://timezonedb.com/api> =item * Testing Dashboard: L<https://nigelhorne.github.io/TimeZone-TimeZoneDB/coverage/> =back =head1 LICENSE AND COPYRIGHT Copyright 2023-2025 Nigel Horne. This program is released under the following licence: GPL2 =cut | |||||
| 354 | ||||||
| 355 | 1; | |||||