#!/usr/bin/perl
# vi:sw=4:ts=4:ai:cindent
# $Id: bbc-weather-forecast,v 1.3 2010-07-09 22:13:58 dave Exp $
# Dave Holland <dave@biff.org.uk>

use warnings;
use strict;
use utf8;

use XML::RSS;
use HTML::Entities qw(:DEFAULT encode_entities_numeric);
use LWP::UserAgent;
use Gnome2::PanelApplet;
use Gtk2;
use Glib qw(:constants);

my $debug=1;
our $hbox;
our $applet;

# Cambridge = 1413
my $feed='http://feeds.bbc.co.uk/weather/feeds/rss/5day/id/1413.xml';
my $freq=60; # minutes between RSS fetches
# http://backstage.bbc.co.uk/data/WeatherFeeds?v=151i says:
# "Forecast data is fully updated at least twice a day, at
# approximately 08:00 and 20:00 GMT. Minor updates can be made
# throughout the day."

Gnome2::Program->init ('BBC Weather Forecast', '0.1', 'libgnomeui',
                       sm_connect => FALSE);

Gnome2::PanelApplet::Factory->main (
  'OAFIID:PerlBBCWeatherApplet_Factory', # iid of the applet
  'Gnome2::PanelApplet',             # type of the applet
  \&fill                             # sub that populates the applet
);

# FIXME it would be nice to be able to force an update by clicking somewhere

sub fill {

our ($applet, $iid, $data) = @_;
# Safety measure: if we're passed the wrong IID, just return.
  if ($iid ne 'OAFIID:PerlBBCWeatherApplet') {
    return FALSE;
  }

# hack for transparency - cribbed from
# http://www.znasibov.info/blog/post/gnome-applet-with-python-part-2.html
$applet->set_background_widget($applet);

my $menu_xml = <<EOX;
<popup name="button3">
  <menuitem name="Preferences Item"
            verb="Preferences"
            label="_Preferences"
	    pixtype="stock"
	    pixname="gtk-preferences"/>
  <menuitem name="About Item"
	    verb="About"
	    label="_About"
	    pixtype="stock"
	    pixname="gnome-stock-about"/>
</popup>
EOX

#  <menuitem name="Help Item"
#	    verb="Help"
#	    label="_Help"
#	    pixtype="stock"
#	    pixname="gtk-help"/>

my $cb_mapping = {
  Preferences => [\&properties_callback, 'default!'],
  Help => \&help_callback,
  About => \&about_callback,
};

$applet->setup_menu($menu_xml, $cb_mapping, 'default?');

our $hbox = Gtk2::HBox->new;
$applet->add($hbox);

my $image = Gtk2::Image->new;
$image->set_from_file("/usr/share/icons/gnome/24x24/stock/generic/stock_unknown.png");
$hbox->add($image);
$applet->show_all;

# first call happens soon after the window is displayed, and will set
# subsequent updates to be less frequent
Glib::Timeout->add(10, \&update);

return TRUE;
}

##########################################

sub update {

debug('update');

# FIXME in the event of an error *after* a forecast has been
# successfully parsed and displayed, should that forecast be removed
# and an error icon displayed?

my $ua=LWP::UserAgent->new(timeout=>30);
# vile hack :-(
# Ought we to use env_proxy? but that's not guaranteed to be correct if
# the network connection changes while the applet is running.
# Maybe there'a a Glib function which would respect the current system
# proxy setting...
if(system('grep -q 172.18.255.1 /etc/resolv.conf') == 0) {
	$ua->proxy('http','http://wwwcache.sanger.ac.uk:3128');
} elsif(system('grep -q 10.0.0.138 /etc/resolv.conf') != 0) {
	$ua->env_proxy;
}
my $response=$ua->get($feed);
if(!$response->is_success) {
	# FIXME display this as a tooltip to an icon
	print STDERR "problem fetching $feed: ".$response->status_line." \n";
	Glib::Timeout->add(1 * 60 * 1000, \&update);
	return FALSE;
	}

my $rss=XML::RSS->new;

eval { $rss->parse(encode_entities_numeric($response->content,
	"\200-\377")); };
if($@) {
	# FIXME display this as a tooltip to an icon
	print STDERR "problem parsing $feed: $@\n";
	Glib::Timeout->add(1 * 60 * 1000, \&update);
	return FALSE;
}

# empty the window (hbox) and repopulate it based on the RSS feed
$hbox->foreach( sub { $_[0]->destroy(); } );

my @items=@{$rss->{'items'}};
foreach my $item (@items) {
	my $ititle = decode_entities($item->{'title'} || "(untitled)");
	$ititle =~ s/^\s+//;
	$ititle =~ s/\s+/ /g;
	my $f='stock_dialog-question';
	my $fore=$ititle; $fore =~ s/\s*\S+day://i;

	# FIXME more parsing needed... these are not tested...
	# there's no documentation on what words/phrases are in use.
	if($fore=~/fog/i) { $f='weather-fog'; }
	if($fore=~/snow/i) { $f='weather-snow'; }
	if($fore=~/storm/i) { $f='weather-storm'; }
	# these are tested and so override the above...
	if($fore=~/light (rain|showers)/i) { $f='weather-showers-scattered'; }
	if($fore=~/drizzle/i) { $f='weather-showers-scattered'; }
	if($fore=~/misty/i) { $f='weather-fog'; }
	if($fore=~/heavy (rain|showers)/i) { $f='weather-showers'; }
	if($fore=~/sun/i) { $f='weather-clear'; }
	if($fore=~/sunny interval/i) { $f='weather-few-clouds'; }
	if($fore=~/cloud/i) { $f='weather-overcast'; }
	if($fore=~/sleet/i) { $f='weather-showers-scattered'; }

	my $file='/usr/share/icons/gnome/24x24/status/' . $f . '.png';
	debug($ititle, "->", $f);

	my $image = Gtk2::Image->new;
	$image->set_from_file($file);
	my $ttip = Gtk2::Tooltips->new;
	$ttip->set_tip($image,$ititle);

	$hbox->add($image);
	}
$hbox->show_all;

# this is what we've got to choose from in "standard" Gnome...
# the Debian package is "gnome-icon-theme"
# /usr/share/icons/gnome/24x24/status/weather- * .png
# clear-night
# clear
# few-clouds-night
# few-clouds
# fog
# overcast
# severe-alert
# showers
# showers-scattered
# snow
# storm

Glib::Timeout->add($freq * 60 * 1000, \&update);
return FALSE;
}

sub debug {
	return unless $debug;
	print STDERR scalar(localtime), ' ', join(" ",@_), "\n";
}

sub properties_callback {
  my $dialog = Gtk2::MessageDialog->new (undef, [],
                                         'question', 'ok',
				'FIXME allow setting location');
  $dialog->run;
  $dialog->destroy;
}

#sub help_callback {
#  my $dialog = Gtk2::MessageDialog->new (undef, [],
#                                         'info', 'ok',
#                                         'Help');
#  $dialog->run;
#  $dialog->destroy;
#}

sub about_callback {
  my $about = Gnome2::About->new ('BBC Weather', '0.1',
                                  'Displays the BBC Weather Forecast',
                                  '© 2010 Dave Holland',
                                  'Dave Holland <dave@biff.org.uk>');
  $about->show;
}