p
/
desktop-tools
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

wmstatus-weather.pl: update to use a newer API 

The old one has been obsoleted, and sometimes refuses to work.

The "classic" endpoint is, sadly, not fully backwards-compatible.
This commit is contained in:
Přemysl Eric Janouch 2021-10-08 23:09:19 +02:00
parent 83b4d96b15
commit 2ea58abdf0
Signed by: p
GPG Key ID: A0420B94F92B9493
1 changed files with 46 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
wmstatus-weather.pl
View File

@ -6,45 +6,55 @@
use strict; use strict;
use warnings; use warnings;
use Time::Piece; use Time::Piece;
use IO::Socket::INET; use File::Basename;
my $host = 'www.yr.no'; # Retrieve current weather information from the Norwegian weather service,
my $path = '/place/Czech_Republic/Prague/Prague/forecast.xml'; # see https://api.met.no/doc/ for its documentation
my $base = 'https://api.met.no/weatherapi';
my $agent = basename($0) =~ s/[^-!#$%&'*+.^_`|~[:alnum:]]//gr;
# https://www.yr.no/storage/lookup/English.csv.zip
my $where = 'lat=50.08804&lon=14.42076&altitude=202'; # Prague
my %legends;
sub retrieve_legends {
# HTTP/Tiny supports TLS, but with non-core IO::Socket::SSL, so use cURL
open(my $sock, '-|', 'curl', '-sSA', $agent,
"$base/weathericon/2.0/legends.txt") or return $!;
while (local $_ = <$sock>) { $legends{$1} = $2 if /^(.+?),(.+?),/ }
close($sock);
}
# Retrieve current weather information from the Norwegian weather service
sub weather { sub weather {
# There are no redirects and it's not exactly confidential either # We might want to rewrite this to use the JSON API (/compact),
my $sock = IO::Socket::INET->new( # see https://developer.yr.no/doc/guides/getting-started-from-forecast-xml
PeerAddr => $host, open(my $sock, '-|', 'curl', '-sA', $agent,
PeerPort => 'http(80)', "$base/locationforecast/2.0/classic?$where") or return $!;
Proto => 'tcp'
) or return '?';
print $sock "GET $path HTTP/1.1\r\n"
. "Host: $host\r\n"
. "Connection: close\r\n\r\n";
# Quick and dirty XML parsing is more than fine for our purpose # Quick and dirty XML parsing is more than fine for our purpose
my ($offset, $acceptable, $temp, $symbol) = (0, 0); my ($acceptable, $temp, $symbol) = (0, undef, undef);
while (<$sock>) { while (<$sock>) {
$offset = $1 * 60 if /utcoffsetMinutes="(.+?)"/; next unless m|<time| .. m|</time|;
next unless /<time/ .. /<\/time/;
# It gives forecast, so it doesn't necessarily contain the present; # It gives forecast, so it doesn't necessarily contain the present;
# just pick the first thing that's no longer invalid # just process the earliest entries that aren't yet invalid
if (/from="(.+?)" to="(.+?)"/) { $acceptable = Time::Piece->strptime($2, '%Y-%m-%dT%H:%M:%SZ') >= gmtime
$acceptable = Time::Piece->strptime($2, '%Y-%m-%dT%H:%M:%S') if /from="(.+?)" to="(.+?)"/;
- $offset >= gmtime; next unless $acceptable;
# Temperature comes from a zero-length time interval, separately
$symbol = $1 if /<symbol.*? code="([^_"]+)/;
$temp = "$2 °" . uc $1 if /<temperature.*? unit="(.).+?" value="(.+?)"/;
if ($temp && $symbol) {
retrieve_legends if !%legends;
close($sock);
return "$temp (" . ($legends{$symbol} || $symbol) . ")";
} }
if ($acceptable) {
$symbol = $1 if /<symbol .* name="(.+?)"/;
$temp = "$2 °${\uc $1}"
if /<temperature unit="(.).+?" value="(.+?)"/;
} }
return "$temp ($symbol)" if $temp && $symbol; close($sock);
} return "No weather ($?)";
return 'Weather error';
} }
# We need to be careful not to overload the service so that they don't ban us # Be careful not to overload the service so that they don't ban us
binmode STDOUT; $| = 1; while (1) { print weather() . "\n\n"; sleep 3600; } binmode STDOUT; $| = 1; while (1) { print weather() . "\n\n"; sleep 3600; }