Skip to content

Commit

Permalink
Add a weather grabber using the official MetOffice API for the UK
Browse files Browse the repository at this point in the history
This will probably replace the broken BBC grabbers.

This is still a work in progress. Currently offers 6 (just 5 available) and 3
day screens. An 18 hour and possibly a new 24 hour screen will be
added soon. A current observations grabber is also planned but a lower
priority for now.

Search doesn't include any caching yet, but the plan is to have it
fully cached.

Please report bugs to the mailing list.
  • Loading branch information
stuartm committed Jul 14, 2012
1 parent aaed391 commit c887dad
Show file tree
Hide file tree
Showing 4 changed files with 302 additions and 0 deletions.
@@ -0,0 +1,4 @@

This script uses the MetOffice Datapoint API.
© Crown copyright 2012, the Met Office
Contains public sector information licensed under the Open Government Licence v1.0
@@ -0,0 +1,5 @@
DATA = MetOffLocation.pm
SCRIPTS = metoffice_fivedayapi.pl

include ../Makefile.inc

@@ -0,0 +1,93 @@
#! /usr/bin/perl
# vim:ts=4:sw=4:ai:et:si:sts=4

package MetOffCommon;
use strict;
use warnings;
require Exporter;

use utf8;
use encoding 'utf8';
use LWP::UserAgent;
use LWP::Simple;
use XML::Simple;
#use Data::Dumper;


our @EXPORT = qw(Search FindLoc);
our @EXPORT_OK = qw($apikey $copyrightstr $copyrightlogo $forecast_url);
our $VERSION = 0.1;


# MythTV API key, DO NOT reuse in another application
# Free keys can be requested from
# https://register.metoffice.gov.uk/register/ddc
our $api_key = '40af3680-8fd5-4c68-a762-4a6fe107f4e2';
our $copyright_str = '© Crown copyright 2012, the Met Office';
our $copyright_logo = 'http://www.metoffice.gov.uk/lib/template/logos/MO_Landscape_W.jpg';
our $forecast_url = 'http://partner.metoffice.gov.uk/public/val/wxfcs/all/xml/';

my @searchresults;
my @resulturl;
my $resultcount = -1;

sub Search {
my ($search_string, $dir, $timeout, $logdir) = @_;
$search_string = uri_escape($search_string);

my %locations = GetLocationsList();

my @searchresults = ();
foreach my $key (keys %locations)
{
if ($locations{$key} =~ /.*$search_string.*/i) {
my $resultline = $key . "::" . $locations{$key};
push (@searchresults, $resultline);
}
}
return @searchresults;
}

sub GetLocationsList {

my $locations_url = $forecast_url . 'sitelist/?key=' . $api_key;

my $response = get $locations_url;
die "404 retrieving " . $locations_url unless defined $response;

my $xml = XMLin($response, KeyAttr => {});

if (!$xml) {
die "Response not xml";
}

my $i = 0;
my %locations;

#print Dumper($xml);

foreach my $loc (@{$xml->{Location}}) {
if (defined $loc->{id}) {
$locations{$loc->{id}} = $loc->{name};
}
$i++;
}

return %locations;
# open OF, "<:utf8", $cachefile or die "Can't read $cachefile: $!\n";
# my $content = do { local $/; <OF> };
# close OF;

}

sub log_print {
return if not defined $::opt_D;
my $dir = shift;

open OF, ">>$dir/uk_metoff.log";
print OF @_;
close OF;
}


1;
@@ -0,0 +1,200 @@
#! /usr/bin/perl
# vim:ts=4:sw=4:ai:et:si:sts=4

use strict;
use warnings;

use utf8;
use encoding 'utf8';
use English;

use File::Basename;
use Cwd 'abs_path';
use lib dirname(abs_path($0 or $PROGRAM_NAME)),
'/usr/share/mythtv/mythweather/scripts/uk_metoffice',
'/usr/local/share/mythtv/mythweather/scripts/uk_metoffice';

use XML::Simple;
use LWP::Simple;
use Getopt::Std;
use File::Path;
use Switch;

use Date::Parse;
use Date::Calc qw(Day_of_Week);
use File::Basename;
use lib dirname($0);
use MetOffCommon qw(:DEFAULT $apikey);

our ($opt_v, $opt_t, $opt_T, $opt_l, $opt_u, $opt_d, $opt_D);

my $name = 'MetOffice-Forecast-API';
my $version = 0.1;
my $author = 'Stuart Morgan';
my $email = 'smorgan@mythtv.org';

my $updateInterval = 3*60*60; # 3 Hours
my $retrieveTimeout = 30;
my @types = ('3dlocation', '6dlocation', 'station_id', 'copyright',
'copyrightlogo', 'weather_icon', 'updatetime',
'date-0', 'icon-0', 'low-0', 'high-0',
'date-1', 'icon-1', 'low-1', 'high-1',
'date-2', 'icon-2', 'low-2', 'high-2',
'date-3', 'icon-3', 'low-3', 'high-3',
'date-4', 'icon-4', 'low-4', 'high-4',
'date-5', 'icon-5', 'low-5', 'high-5');
my $dir = "/tmp/uk_metoffice";
my $logdir = "/tmp/uk_metoffice";

binmode(STDOUT, ":utf8");

if (!-d $logdir) {
mkpath( $logdir, {mode => 0755} );
}

getopts('Tvtlu:d:');

if (defined $opt_v) {
print "$name,$version,$author,$email\n";
log_print( $logdir, "-v\n" );
exit 0;
}

if (defined $opt_T) {
print "$updateInterval,$retrieveTimeout\n";
log_print( $logdir, "-t\n" );
exit 0;
}

if (defined $opt_d) {
$dir = $opt_d;
}

if (!-d $dir) {
mkpath( $dir, {mode => 0755} );
}

if (defined $opt_l) {
my $search = shift;
log_print( $logdir, "-l $search\n" );
my @results = MetOffCommon::Search($search, $dir, $updateInterval, $logdir);
my $result;

foreach (@results) {
print $_ . "\n";
}

exit 0;
}

if (defined $opt_t) {
foreach (@types) {print; print "\n";}
exit 0;
}

my $locid = shift;
# we get here, we're doing an actual retrieval, everything must be defined
#my $locid = MetOffLocation::FindLoc(shift, $dir, $updateInterval, $logdir);
if (!(defined $locid && !$locid eq "")) {
die "Invalid usage";
}

my $units = $opt_u;
my $base_args = '?res=daily&key=' . $MetOffCommon::api_key;
my $url = "";

if ($locid =~ s/^(\d*)/$1/)
{
$url = $MetOffCommon::forecast_url . $1 . $base_args;
}
else
{
die "Invalid Location ID";
}


my $response = get $url;
die unless defined $response;

my $xml = XMLin($response);

if (!$xml) {
die "Not xml";
}

printf "copyright::" . $MetOffCommon::copyright_str . "\n";
printf "copyrightlogo::" . $MetOffCommon::copyright_logo . "\n";
printf "station_id::" . $locid . "\n";
my $location = $xml->{DV}->{Location}->{name};
printf "3dlocation::" . $location . "\n";
printf "6dlocation::" . $location . "\n";
printf "updatetime::Updated " . localtime() . "\n";

my $i = 0;
my $item;

foreach $item (@{$xml->{DV}->{Location}->{Period}}) {

my ($ss,$mm,$hh,$day,$month,$year,$zone) = strptime($item->{val});
$year += 1900; # Returns year as offset from 1900
$month += 1; # Returns month starting at zero
my $dow = Day_of_Week($year,$month,$day);
$dow = $dow == 7 ? 0 : $dow;
printf "date-" . $i . "::" . $dow . "\n";

my $daytime = $item->{Rep}[0];
my $nighttime = $item->{Rep}[1];

my $iconname = "unknown";
switch ($daytime->{W}) { # Weather Type
case 0 { $iconname = "fair"; } # Clear sky
case 1 { $iconname = "sunny"; } # Sunny
case 2 { $iconname = "pcloudy"; } # Partly cloudy (night)
case 3 { $iconname = "pcloudy"; } # Sunny intervals
case 4 { $iconname = "dusthaze"; } # Dust
case 5 { $iconname = "fog"; } # Mist
case 6 { $iconname = "fog"; } # Fog
case 7 { $iconname = "mcloudy"; } # Medium-level cloud
case 8 { $iconname = "cloudy"; } # Low-level cloud
case 9 { $iconname = "lshowers"; } # Light rain shower (night)
case 10 { $iconname = "lshowers"; } # Light rain shower (day)
case 11 { $iconname = "lshowers"; } # Drizzle
case 12 { $iconname = "lshowers"; } # Light rain
case 13 { $iconname = "showers"; } # Heavy rain shower (night)
case 14 { $iconname = "showers"; } # Heavy rain shower (day)
case 15 { $iconname = "showers"; } # Heavy rain
case 16 { $iconname = "rainsnow"; } # Sleet shower (night)
case 17 { $iconname = "rainsnow"; } # Sleet shower (day)
case 18 { $iconname = "rainsnow"; } # Sleet
case 19 { $iconname = "rainsnow"; } # Hail shower (night)
case 20 { $iconname = "rainsnow"; } # Hail shower (day)
case 21 { $iconname = "rainsnow"; } # Hail
case 22 { $iconname = "flurries"; } # Light snow shower (night)
case 23 { $iconname = "flurries"; } # Light snow shower (day)
case 24 { $iconname = "flurries"; } # Light snow
case 25 { $iconname = "snowshow"; } # Heavy snow shower (night)
case 26 { $iconname = "snowshow"; } # Heavy snow shower (day)
case 27 { $iconname = "snowshow"; } # Heavy snow
case 28 { $iconname = "thunshowers"; } # Thundery shower (night)
case 29 { $iconname = "thunshowers"; } # Thundery shower (day)
case 30 { $iconname = "thunshowers"; } # Thunder storm
case 31 { $iconname = "thunshowers"; } # Tropical storm
case 33 { $iconname = "dusthaze"; } # Haze
}

printf "icon-" . $i . "::" . $iconname . ".png\n";

printf "low-" . $i . "::" . $nighttime->{Nm} . "\n";
printf "high-" . $i . "::" . $daytime->{Dm} . "\n";

$i++;
}

sub log_print {
return if not defined $::opt_D;
my $dir = shift;

open OF, ">>$dir/uk_metoffice.log";
print OF @_;
close OF;
}

0 comments on commit c887dad

Please sign in to comment.