aboutsummaryrefslogtreecommitdiff
path: root/wmstatus-weather.pl
blob: d5252f21c312767b30c62882eeb5ce1d4f175a96 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
#!/usr/bin/env perl
# Example slave command showing how to easily add additional things to the bar.
#
# You can place this in ~/.local/bin, customize it and direct wmstatus.conf
# towards by setting e.g.: command=~/.local/bin/wmstatus-weather.pl
use strict;
use warnings;
use Time::Piece;
use File::Basename;

# Retrieve current weather information from the Norwegian weather service,
# 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);
}

sub weather {
	# We might want to rewrite this to use the JSON API (/compact),
	# see https://developer.yr.no/doc/guides/getting-started-from-forecast-xml
	open(my $sock, '-|', 'curl', '-sA', $agent,
		"$base/locationforecast/2.0/classic?$where") or return $!;

	# Quick and dirty XML parsing is more than fine for our purpose
	my ($acceptable, $temp, $symbol) = (0, undef, undef);
	while (<$sock>) {
		next unless m|<time| .. m|</time|;

		# It gives forecast, so it doesn't necessarily contain the present;
		# just process the earliest entries that aren't yet invalid
		$acceptable = Time::Piece->strptime($2, '%Y-%m-%dT%H:%M:%SZ') >= gmtime
			if /from="(.+?)" to="(.+?)"/;
		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) . ")";
		}
	}
	close($sock);
	return "No weather ($?)";
}

# 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; }