testing #29

Merged
marko merged 73 commits from testing into main 2023-01-07 12:49:01 +00:00
Showing only changes of commit c600937332 - Show all commits

View File

@ -23,14 +23,11 @@ eval {
require JSON::MaybeXS; require JSON::MaybeXS;
import JSON::MaybeXS qw( decode_json encode_json ); import JSON::MaybeXS qw( decode_json encode_json );
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# try to use JSON wrapper # try to use JSON wrapper
# for chance of better performance # for chance of better performance
eval { eval {
# JSON preference order # JSON preference order
local $ENV{PERL_JSON_BACKEND} = local $ENV{PERL_JSON_BACKEND} =
'Cpanel::JSON::XS,JSON::XS,JSON::PP,JSON::backportPP' 'Cpanel::JSON::XS,JSON::XS,JSON::PP,JSON::backportPP'
@ -39,10 +36,7 @@ if ($@) {
require JSON; require JSON;
import JSON qw( decode_json encode_json ); import JSON qw( decode_json encode_json );
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# In rare cases, Cpanel::JSON::XS may # In rare cases, Cpanel::JSON::XS may
# be installed but JSON|JSON::MaybeXS not ... # be installed but JSON|JSON::MaybeXS not ...
@ -50,10 +44,7 @@ if ($@) {
require Cpanel::JSON::XS; require Cpanel::JSON::XS;
import Cpanel::JSON::XS qw(decode_json encode_json); import Cpanel::JSON::XS qw(decode_json encode_json);
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# In rare cases, JSON::XS may # In rare cases, JSON::XS may
# be installed but JSON not ... # be installed but JSON not ...
@ -61,10 +52,7 @@ if ($@) {
require JSON::XS; require JSON::XS;
import JSON::XS qw(decode_json encode_json); import JSON::XS qw(decode_json encode_json);
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# Fallback to built-in JSON which SHOULD # Fallback to built-in JSON which SHOULD
# be available since 5.014 ... # be available since 5.014 ...
@ -72,20 +60,17 @@ if ($@) {
require JSON::PP; require JSON::PP;
import JSON::PP qw(decode_json encode_json); import JSON::PP qw(decode_json encode_json);
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# Fallback to JSON::backportPP in really rare cases # Fallback to JSON::backportPP in really rare cases
require JSON::backportPP; require JSON::backportPP;
import JSON::backportPP qw(decode_json encode_json); import JSON::backportPP qw(decode_json encode_json);
1; 1;
} };
} };
} };
} };
} };
use Data::Dumper; # for Debug only use Data::Dumper; # for Debug only
## API URL ## API URL
@ -109,6 +94,8 @@ sub new {
lat => ( split( ',', $argsRef->{location} ) )[0], lat => ( split( ',', $argsRef->{location} ) )[0],
long => ( split( ',', $argsRef->{location} ) )[1], long => ( split( ',', $argsRef->{location} ) )[1],
fetchTime => 0, fetchTime => 0,
forecast => $argsRef->{forecast},
alerts => $argsRef->{alerts},
}; };
$self->{cachemaxage} = ( $self->{cachemaxage} = (
@ -173,7 +160,7 @@ sub setRetrieveData {
} }
sub setLocation { sub setLocation {
my ($self,$lat,$long) = @_; my ( $self, $lat, $long ) = @_;
$self->{lat} = $lat; $self->{lat} = $lat;
$self->{long} = $long; $self->{long} = $long;
@ -181,6 +168,22 @@ sub setLocation {
return 0; return 0;
} }
sub setAlerts {
my $self = shift;
my $alerts = shift // 0;
$self->{alerts} = $alerts;
return;
}
sub setForecast {
my $self = shift;
my $forecast = shift // '';
$self->{forecast} = $forecast;
return;
}
sub getFetchTime { sub getFetchTime {
my $self = shift; my $self = shift;
@ -199,8 +202,7 @@ sub _RetrieveDataFromWU($) {
# retrieve data from cache # retrieve data from cache
if ( ( time() - $self->{fetchTime} ) < $self->{cachemaxage} if ( ( time() - $self->{fetchTime} ) < $self->{cachemaxage}
and $self->{cached}->{lat} == $self->{lat} and $self->{cached}->{lat} == $self->{lat}
and $self->{cached}->{long} == $self->{long} and $self->{cached}->{long} == $self->{long} )
)
{ {
return _CallWeatherCallbackFn($self); return _CallWeatherCallbackFn($self);
} }
@ -239,6 +241,7 @@ sub _RetrieveDataFromWU($) {
my $options = 'geocode=' . $self->{lat} . ',' . $self->{long}; my $options = 'geocode=' . $self->{lat} . ',' . $self->{long};
$options .= '&format=json'; $options .= '&format=json';
$options .= '&units=' . $self->{units}; $options .= '&units=' . $self->{units};
$options .= '&numericPrecision=decimal';
$options .= '&language=' $options .= '&language='
. ( . (
$self->{lang} eq 'en' $self->{lang} eq 'en'