#!/usr/bin/perl
#
# Tom Moertel <tom@moertel.com>
# $Id: index.cgi,v 1.13 2004/08/12 21:54:52 thor Exp $
#
# LICENSE
#
# Copyright © 2004 Thomas Moertel
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# The text of the GNU GPL may be found online:
#     http://www.gnu.org/copyleft/gpl.html
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# Except as provided for in the GNU GPL, all rights are reserved
# worldwide.

use warnings;
use strict;

use CGI;
use File::Basename;
use HTML::Entities;
use Image::Magick;
use LWP::Simple;

#==============================================================================
# config

use constant {
    WEATHER_URL =>
        'http://www.srh.noaa.gov/data/PBZ/ZFPPBZ',
    RADAR_URL =>
        'http://www.erh.noaa.gov/radar/images/DS.p19r0/SI.kpbz/latest.gif',
    WORK_DIR => dirname($0) . '/work',
    IMAGE_SIZE => "110",
    CACHE_CONTROL => 'Cache-Control: max-age=300'
};

use constant RADAR_STORE   => WORK_DIR . '/latest-radar.gif';
use constant WEATHER_STORE => WORK_DIR . '/latest-weather.txt';

my %compression_dict =  qw(
        SATURDAY SAT   SUNDAY SUN    MONDAY MON    TUESDAY TUE
        WEDNESDAY WED  THURSDAY THU  FRIDAY FRI    SHOWERS SHWRS
        PERCENT %      THROUGH THRU  CLOUDY CLDY   AROUND ARND
        THUNDERSTORMS TSTORMS        AFTERNOON AFTRNN
        MIDNIGHT MIDNT NIGHT NITE
        MORNING MORNG  PARTLY PTLY   EVENING EVE   AND &
        NORTH N        SOUTH S       EAST E        WEST W
        NORTHEAST NE   NORTHWEST NW  SOUTHEAST SE  SOUTHWEST SW
        PITTSBURGH PGH NATIONAL NTL  WEATHER WTHR  SERVICE SVC
        FORECAST FCST  PRODUCT PROD        
);

#==============================================================================
# code

-d WORK_DIR or mkdir WORK_DIR, 0755 or die "can't find/make " . WORK_DIR;

( (new CGI)->param('q') ? \&do_map : \&do_weather )->();

sub do_weather {
    my @notices;
    my $rc = mirror(WEATHER_URL, WEATHER_STORE);
    push @notices, ".NWS not responding; using cached forecast..."
        if $rc != 304 && !is_success($rc);
    local $/ = "";
    open my $w, WEATHER_STORE or die "can't read " . WEATHER_STORE;
    my @paras = map {chomp;$_} <$w>;
    close $w;
    my @blocks = split m{<p>\$\$</p>}, join "\n", map {markup($_)} @paras;
    my $forecast = join "<hr/>\n", grep /ALLEGHENY/i, @blocks;
    my $body = do { local $/; <DATA> };
    for ($body) {
        s{::TIMESTAMP::} {localtime}eg;
        s{::FORECAST::}  {$forecast}g;
        s{::SIZE::}      {IMAGE_SIZE}eg;
        s{::NOTICES::}   {join "\n", map {markup($_)} @notices}eg;
    };
    print "Content-Type: application/xhtml+xml\r\n", CACHE_CONTROL,
          "\r\n\r\n$body";
}

sub do_map {
    my $notice;
    my $rc = mirror(RADAR_URL, RADAR_STORE);
    if (-e RADAR_STORE) {
        $notice = uc localtime((stat RADAR_STORE)[9]);
        $notice =~ s{\S+ (\w+)\s+(\w+)\s+(\w+:\w+):\w+\s+(\w+)}{$1 $2 $3 $4};
    }
    $notice = "OLD: $notice" if $rc != 304 && !is_success($rc);
    my $img = Image::Magick->new;
    $img->Read(RADAR_STORE);
    $img->Crop(geometry => "350x350+170+150"); # focus on Pittsburgh 
    $img->Resize(geometry => IMAGE_SIZE);
    if ($notice) {
        my $annotate = sub {
            $img->Annotate(@_, text=>$notice, gravity=>'South', pointsize=>10,
                           antialias=>'false') };
        $annotate->(fill=>'black', x=>1, y=>1);
        $annotate->(fill=>'white');
    }
    binmode STDOUT;
    print "Content-Type: image/png\r\n".CACHE_CONTROL."\r\n\r\n",
          $img->ImageToBlob(magick=>'png');
}

sub markup($) {
    local ($_) = @_;
    s{(\w+)}{word_compress($1)}eg;
    $_ = encode_entities($_);
    s{^\.+(.+?)\.\.\.}{<strong>$1:</strong> }mg;
    return "<p>$_</p>";
}

sub word_compress($) {
    my ($word) = @_;
    $compression_dict{$word} || $word;
}

#==============================================================================
# data

__DATA__
<?xml version="1.0"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"
    "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head><title>Pgh Weather</title></head>
<body>
<p><img src="index.cgi?q=map" width="::SIZE::" height="::SIZE::" alt="Radar"/></p>
<p>::TIMESTAMP::</p>
::NOTICES::
::FORECAST::
</body>
</html>