#!/usr/bin/perl -w
use LWP::Simple;

# Version History:
#   2009-05-24  Arne Rossius
#      - modified for use with external display
#   2010-04-13  Arne Rossius
#      - updated for new website layout
#      - added second URL for current weather
#      - added pressure and humidity

$id = "DE0000003026";

$url = "http://www.wetter.com/wetter_aktuell/wettervorhersage/3_tagesvorhersage/?id=$id";
$url2 = "http://www.wetter.com/wetter_aktuell/aktuell/?id=$id";
$interval = 15 * 60; # 15 minutes
$port = "/dev/ttyUSB0";

while (1) {
	system "stty -F $port 38400 raw";
	open SER, ">$port";
	
	while (1) {
		$html1 = get($url);
		last if (substr($html1, 0, 9) eq "<!DOCTYPE");
	}
	while (1) {
		$html2 = get($url2);
		last if (substr($html2, 0, 9) eq "<!DOCTYPE");
	}
	@HTML1 = split("\n", $html1);
	@HTML2 = split("\n", $html2);
	@HTML = (@HTML2, @HTML1);
	
	# Use data from seperate page (including pressure and humidity)
	scan('>Aktuell<');
	$_ = scan('[0-9]{2}\.[0-9]{2}\.[0-9]{4}');
	if (/([0-9]{2})\.([0-9]{2})\.([0-9]{4})/) {
		$Cur{year} = $3;
		$Cur{month} = $2;
		$Cur{day} = $1;
	} else {
		$Cur{year} = 0;
		$Cur{month} = 0;
		$Cur{day} = 0;
	}
	$_ = scan('Uhr');
	if (/([0-9]{2}:[0-9]{2}) Uhr/) {
		$Cur{time} = $1;
	} else {
		$Cur{time} = "ERROR";
	}
	scan('class="wx_icon"');
	$_ = scan('>[^<]+<');
	if (/>([^<]+)</) {
		$Cur{cond} = $1;
	} else {
		$Cur{cond} = "ERROR";
	}
	$_ = scan('class="deg"');
	if (/>([0-9.-]+)/) {
		$Cur{temp} = $1;
	} else {
		$Cur{temp} = 1000;
	}
	$_ = scan('winddir');
	if (/\/([NOSW]+)\.gif/) {
		$Cur{dir} = $1;
	} else {
		$Cur{dir} = "ERR";
	}
	scan('Windgeschwindigkeit');
	$_ = scan('[0-9.]+ km');
	if (/([0-9.]+) km/) {
		$Cur{speed} = $1;
	} else {
		$Cur{speed} = -1;
	}
	scan('Luftdruck');
	$_ = scan('[0-9.]+ hPa');
	if (/([0-9.]+) hPa/) {
		$Cur{press} = $1;
	} else {
		$Cur{press} = -1;
	}
	scan('Relative Feuchte');
	$_ = scan('[0-9.]+ %');
	if (/([0-9.]+) %/) {
		$Cur{rh} = $1;
	} else {
		$Cur{rh} = -1;
	}
	
#	# Use data from main page (w/o pressure and humidity)
#	scan('OBSERVATION');
#	$_ = scan('Uhr');
#	if (/([0-9]{2})\.([0-9]{2})\.([0-9]{4}), ([0-9]{2}:[0-9]{2}) Uhr/) {
#		$Cur{year} = $3;
#		$Cur{month} = $2;
#		$Cur{day} = $1;
#		$Cur{time} = $4;
#	} else {
#		$Cur{year} = 0;
#		$Cur{month} = 0;
#		$Cur{day} = 0;
#		$Cur{time} = "ERROR";
#	}
#	$_ = scan('<td class="text_m">');
#	if (/>([0-9.-]+).*div>([^<]*)</) {
#		$Cur{temp} = $1;
#		$Cur{cond} = $2;
#	} else {
#		$Cur{temp} = 1000;
#		$Cur{cond} = "ERROR";
#	}
#	$_ = scan('[a-z]wind');
#	if (/>([0-9.]+) km.*?>([a-zA-Z]+)/) {
#		$Cur{speed} = $1;
#		$Cur{dir} = $2;
#		$Cur{dir} =~ s/wind//i;
#		$Cur{dir} =~ s/Nord/N/gi;
#		$Cur{dir} =~ s/Ost/O/gi;
#		$Cur{dir} =~ s/S.d/S/gi;
#		$Cur{dir} =~ s/West/W/gi;
#	} else {
#		$Cur{speed} = -1;
#		$Cur{dir} = "ERR";
#	}
#	$Cur{press} = -1;
#	$Cur{rh} = -1;

	scan('FORECAST');
	%Day1 = forecast();
	%Day2 = forecast();
	%Day3 = forecast();
	@DAY1 = prepare(%Day1);
	@DAY2 = prepare(%Day2);
	@DAY3 = prepare(%Day3);
	
	print SER "\x0c";
	
	# Display size: 8 lines @ 40 chars
	printf SER "%04d-%02d-%02d, %5s  |  %-18s\n", $Cur{year},
		$Cur{month}, $Cur{day}, $Cur{time}, $DAY2[1];
	printf SER "%-6s %-10s  |  %-18s\n",
		$Cur{temp}."\xf8C", short($Cur{cond}, 10), $DAY2[2];
	printf SER "Wind %3s %3d km/h  |  %-18s\n",
		$Cur{dir}, $Cur{speed}, $DAY2[3];
	printf SER "%4d hPa, %3d%% rH  |  %-18s\n",
		$Cur{press}, $Cur{rh}, $DAY2[4];
	
	print SER $DAY1[1], " |  ", $DAY3[1], "\n";
	print SER $DAY1[2], " |  ", $DAY3[2], "\n";
	print SER $DAY1[3], " |  ", $DAY3[3], "\n";
	print SER $DAY1[4], " |  ", $DAY3[4], "\n";
	
	close SER;
	sleep $interval;
}

sub scan {
	# scan for expression in HTML, return matching line (if any)
	my $line;
	my ($match) = @_;
	do {
		return unless (scalar(@HTML));
		$line = shift(@HTML);
	} until ($line =~ /$match/);
	return $line;
}

sub forecast {
	# process forecast for one day
	local %Day;
	scan('Morgens'); forecast_part(1);
	scan('Mittags'); forecast_part(2);
	scan('Abends'); forecast_part(3);
	scan('Nachts'); forecast_part(4);
	return %Day;
}

sub forecast_part {
	# return weather for current part of the day
	my ($n) = @_;
	$_ = scan('class="wx"');
	if (/>([^<]+)</) {
		$Day{"cond$n"} = $1;
	} else {
		$Day{"cond$n"} = "ERROR";
	}
	$_ = scan('class="deg');
	if (/>([0-9.-]+) \/ ([0-9.-]+)/) {
		$Day{"min$n"} = $1;
		$Day{"max$n"} = $2;
	} else {
		$Day{"min$n"} = 999;
		$Day{"max$n"} = 999;
	}
	scan('gef.hlt wie');
	$_ = scan('class="deg');
	if (/>([0-9.-]+) \/ ([0-9.-]+)/) {
		$Day{"gmin$n"} = $1;
		$Day{"gmax$n"} = $2;
	} else {
		$Day{"gmin$n"} = 999;
		$Day{"gmax$n"} = 999;
	}
	$_ = scan(' mm<');
	if (/>(<{0,1}[0-9. ]+) mm.*>([0-9]+) %/) {
		$Day{"rain$n"} = $1;
		$Day{"percent$n"} = $2;
	} else {
		$Day{"rain$n"} = -1;
		$Day{"percent$n"} = -1;
	}
}

sub prepare {
	# prepare 4 strings (18 chars each) for output for a given day
	my (@OUT, $i);
	my (%Day) = @_;
	for ($i = 1; $i <= 3; $i++) {
		$OUT[1] .= sprintf("%2d/%2d ", $Day{"min$i"}, $Day{"max$i"});
		$OUT[2] .= sprintf("%2d/%2d ", $Day{"gmin$i"}, $Day{"gmax$i"});
		$OUT[3] .= sprintf("%3d%%  ", $Day{"percent$i"});
		$OUT[4] .= sprintf("%-5s ", short($Day{"cond$i"}, 5));
	}
	return @OUT;
}

sub short {
	# shorten string to given number of chars by concatenating capitalised
	# beginning of each word
	my ($string, $len) = @_;
	my $newstring = "";
	my @STRING = split(" ", $string);
	my $words = scalar(@STRING);
	my $wordlen = int($len / $words);
	my $remaining = $len;
	for (my $i = 0; $i < $words; $i++) {
		$thislen = $wordlen;
		if ($remaining > $wordlen * ($words - $i)) {
			$thislen++;
		}
		if (length($STRING[$i]) < $thislen) {
			$thislen = length($STRING[$i]);
		}
		$remaining -= $thislen;
		$addstr = substr($STRING[$i], 0, $thislen);
		$addstr = uc(substr($addstr, 0, 1)) . lc(substr($addstr, 1));
		$newstring .= $addstr;
	}
	$newstring = substr($newstring . " " x $len, 0, $len); # do this before convrting
	# convert Umlauts and Eszett from ISO8859-1 to CP437
	$newstring =~ tr/\xc4\xd6\xdc\xe4\xf6\xfc\xdf/\x8e\x99\x9a\x84\x94\x81\xe1/;
	return $newstring;
}