[Groningen-pm] Het weer in Eelde

[Johan Vromans]

http://vromans.org/cgi-bin/weer.cgi?double=1&type=2

Voor de liefhebbers:

#!/usr/bin/perl

use strict;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);

use Time::Local qw(timelocal timelocal_nocheck);

my @months = qw(januari februari maart april
		mei juni juli augustus
		september oktober november december);
my @days = qw(zondag maandag dinsdag woensdag donderdag vrijdag zaterdag);

my $date    = param("date");
my $double  = param("double");
my $nocache = param("nocache");
my $type    = param("type") || 3;
my $prev    = param("prev");

my $loc = "Eelde";

my $cache_dir = "/home/jv/cgi-bin/cache/%s";
my $cache_url = "cache/%s";

my @current = localtime(time);
$current[4] += 1;
$current[5] += 1900;
my $today = sprintf("%4d%02d%02d", @current[5,4,3]);

unless ( $date && $date =~ /^\d{8}$/ ) {
    $date = $today;
}
$date = $today if $date gt $today;
$date = $today if $date lt "20050101";

my ($y, $m, $d) = $date =~ /(\d\d\d\d)(\d\d)(\d\d)/;
$m += 0;
$d += 0;

my $url = "http://www.wunderground.com/cgi-bin/histGraphAll?year=%d&month=%d&day=%d&ID=EHGG&type=$type";

my ($y1, $m1, $d1);

if ( $prev ) {
    ($y, $m, $d) = calc_prev($y, $m, $d);
    $date = sprintf("%4d%02d%02d", $y, $m, $d);
}

if ( $double ) {
    ($y1, $m1, $d1) = calc_prev($y, $m, $d);
}

################ Main ################

print(header,
      start_html("Weeroverzicht $loc"),
      "<table border=0>\n",
      "  <tr>\n");
print("    <td align=\"center\" colspan=2><strong><font size=\"+2\">",
      "Weeroverzicht</font></strong></td>\n</tr>\n");

print("    <td align=\"center\"><strong><font size=\"+1\">$loc, ",
      dpdate($y1,$m1,$d1), "</font></strong></td>\n")
  if $double;

print("    <td align=\"center\"><strong><font size=\"+1\">$loc, ",
      dpdate($y,$m,$d), "</font></strong></td>\n",
      "  </tr>\n",
      "  <tr>\n");

print("    <td><img src=\"",
      dpurl($y1, $m1, $d1), "\" width=600 height=480></td>\n")
      if $double;

print("    <td><img src=\"",
      dpurl($y, $m, $d), "\" width=600 height=480></td>\n",
      "  </tr>\n",
      "</table>\n");

print
  ("<hr>\n",
   start_form,
   "<table border=1 cellpadding=5>\n",
   "<tr><td>",
   "Datum: ",
   textfield(-name => 'date',
	     -default => $date,
	     -value => $date,
	     -size => 8,
	     -maxlength => 8,
	     -override => 1,
	    ),
   "</td><td>",
   checkbox(-name=>'double',
	    -checked=>0,
	    -value=>1,
	    -label=>'Vorige ook'),
   "</td><td>",
   radio_group(-name => 'type',
	       -values => [1,2,3],
	       -default => 3,
	       -labels => { 1 => "Maand",
			    2 => "Week",
			    3 => "Dag",
			  }),
   "</td><td>",
   submit(-name => "submit",
	  -value => "Toon overzicht"),
   "</td><td>",
   submit(-name => "prev",
	  -value => "Toon vorige"),
   "</td></tr></table>\n",
   end_form, "\n");

print end_html;

################ Subroutines ################

sub calc_prev {
    my ($y, $m, $d) = @_;
    my $time;
    if ( $type == 1 ) {
	$time = timelocal_nocheck(0, 0, 0, $d, $m-2, $y-1900);
    }
    elsif ( $type == 2 ) {
	$time = timelocal_nocheck(0, 0, 0, $d-7, $m-1, $y-1900);
    }
    else {
	$time = timelocal_nocheck(0, 0, 0, $d-1, $m-1, $y-1900);
    }
    my @tm = localtime($time);
    (1900 +$tm[5], 1+$tm[4], $tm[3]);
}

sub dpdate {
    my ($y, $m, $d) = @_;
    my $time = timelocal(0, 0, 0, $d, $m-1, $y-1900);
    my @tm = localtime($time);

    if ( $type == 1 ) {
	join(" ", $months[$tm[4]], 1900+$tm[5]);
    }
    elsif ( $type == 2 ) {
	$time = timelocal_nocheck(0, 0, 0, $d-$tm[6], $m-1, $y-1900);
	@tm = localtime($time);
	join(" ", "week van", $tm[3], $months[$tm[4]], 1900+$tm[5]);
    }
    else {
	join(" ", $days[$tm[6]], $tm[3], $months[$tm[4]], 1900+$tm[5]);
    }

}

use LWP::Simple qw(get);

sub dpurl {
    my ($y, $m, $d) = @_;
    my $nocache = $nocache;

    if ( $type == 1 ) {
	# Monthly overview. Get first of month date.
	my $time = timelocal(0, 0, 0, 1, $m-1, $y-1900);
	my @tm = localtime($time);
	$tm[4] += 1;
	$tm[5] += 1900;
	($y, $m, $d) = @tm[5,4,3];

	# Bypass cache if current month.
	if ( $m == $current[4] && $y == $current[5] ) {
	    $nocache++;
	}
    }
    elsif ( $type == 2 ) {
	# Weekly overview. Get first day of week.
	my $time = timelocal(0, 0, 0, $d, $m-1, $y-1900);
	my @tm = localtime($time);
	$time = timelocal_nocheck(0, 0, 0, $d-$tm[6], $m-1, $y-1900);
	@tm = localtime($time);
	$tm[4] += 1;
	$tm[5] += 1900;
	($y, $m, $d) = @tm[5,4,3];

	# Bypass cache if it is current week.
	$time = timelocal_nocheck(0, 0, 0,
				  $current[3]-$current[6],
				  $current[4]-1,
				  $current[5]-1900);

	@tm = localtime($time);
	$tm[4] += 1;
	$tm[5] += 1900;

	if ( $d == $tm[3] && $m == $tm[4] && $y == $tm[5] ) {
	    $nocache++;
	}
    }
    elsif ( $d == $current[3] && $m == $current[4] && $y == $current[5] ) {
	$nocache++;
    }

    if ( $nocache ) {
	return sprintf($url, $y, $m ,$d);
    }

    my $date = sprintf("%4d%02d%02d", $y, $m, $d);
    my $img = "EHGG-$date-$type.gif";
    my $curl = sprintf($cache_dir, $img);
    unless ( -s $curl ) {
	unlink($curl);
	my $doc = get(sprintf($url, $y, $m, $d));
	open(my $fh, ">", $curl) or die("$curl: $!\n");
	binmode($fh);
	print {$fh} ($doc) or die("$curl: $!\n");
	close($fh) or die("$curl: $!\n");
    }
    return sprintf($cache_url, $img);
}