#!/usr/bin/perl -w

  # $Id: 4200wx.pl 2 2008-07-10 00:05:58Z yaakov $

  # Current Weather Condition on an HP 4200 Printer 
  # 
  # This program gets METAR weather conditions from the NOAA webiste and uses
  # Geo::METAR to parse the result.  It then hard formats the result so it
  # looks reasonably good on the 4200's display.
  #
  # The program need to know the four-letter ICAO airport code for your area,
  # as well as the IP address of the target printer.  I run this program as a
  # cron job at 10 minute intervals.  You can change the "WEATHER CONDITIONS"
  # heading to reflect your cities name.  You will have to pad it properly
  # to center it.
  #
  # THIS PROGRAM IS PROVIDED WITH NO WARRANTY OF ANY KIND EXPRESSED OR IMPLIED
  # THE AUTHOR CANNOT BE RESPONSIBLE FOR THE EFFECTS OF THIS PROGRAM
  # IF YOU ARE UNCERTAIN ABOUT THE ADVISABILITY OF USING IT, DO NOT!
  #
  # Yaakov (http://kovaya.com/)
  #
  # Updated 12/04/2008 by Joe McMahon
  #  - options parsing with Getopt::Long
  #  - lookup of ICAO code from location name
  #  - Fetches METAR data via JSON (Geo::METAR no longer works)

use strict;

use LWP::Simple;
use IO::Socket;
use Getopt::Long;
use WWW::Mechanize;
use JSON;

my($opt_n, $opt_v, $ip, $station_code, $location);
GetOptions(
	"n"     => \$opt_n,
	"v"     => \$opt_v,
	"ip=s" => \$ip,
	"icao=s" =>\$station_code,
	"location=s" => \$location,
);

$ip = '172.21.42.200' unless $ip;
my $mech = new WWW::Mechanize;
$|++ if $opt_v;

# Figure out ICAO code if not specified.
if ($station_code and $location) {
	warn "Both station code and location specified, choosing code\n";
}
elsif (!$station_code and !$location) {
	die "Must specify either -icao or -location to continue\n";
}
elsif ($location) {
	# Convert location into a station code.
	my ($city, $state, $error) = split /,\s*/, $location;
	$city =~ s/\s+/+/g;
	$state=~ s/\s+/+/g;
	print "Obtaining ICAO code ... " if $opt_v;
	$mech->get("http://www.jfast.org/Tools/Port2PortAirDist/GeoLookup.asp?Name=$city&Country=$state&Geo=&Icao=&Submit1=Look+up");
	die "Can't look up ICAO code for '$location': @{[$mech->status]}\n" unless $mech->success;
	my ($table) = ($mech->content =~ /(<TR><TD>.*)$/m);
	my @lines = ($table =~ m{<TR>(.*?)</TR>}g);
	my @content;
	foreach my $line (@lines) {
		@content = ($line =~ m{<TD>(.*?)</TD>}g);
		last if $content[3] ne "    ";
	}
	die "No ICAO station code found for '$location'\n" if $content[3] eq '    ';
	$station_code = $content[3];
}

# At this point we have an ICAO code.
print "Fetching weather info ... " if $opt_v;
$mech->get("http://ws.geonames.org/weatherIcaoJSON?ICAO=$station_code");
die "Can't get weather from geonames.org: @{[$mech->status]}" unless $mech->success;
my $weather = from_json($mech->content);

my $temp_c = $weather->{weatherObservation}->{temperature};
my $temp_f = 9/5*$temp_c + 32;
my $conditions = $weather->{weatherObservation}->{weatherCondition};
$conditions = "clear" if $conditions eq 'n/a';
my $wind_speed = $weather->{weatherObservation}->{windSpeed};

# Looks like 4 lines on the printer, but it's really just one. Embedding 
# carriage returns in an attempt to format the data will not work!
my $wx = qq(@{[hp_pad("Weather")]}@{[hp_pad("${temp_f}F/${temp_c}C")]}@{[hp_pad(ucfirst($conditions))]}@{[hp_pad("Wind $wind_speed mph")]});

setdisplay($wx, $ip);

sub hp_pad {
	my ($string) = @_;
	return substr($string,0,20) if length($string) >= 20;
	my $end_pad_length = int((20 - length($string) ) / 2);
	$string = ' ' x $end_pad_length . $string . ' ' x $end_pad_length;
	$string = "$string " if length $string == 19;
	return $string;
}

sub setdisplay {

  my ($rdymsg, $peeraddr) = @_;
  my $socket;

  if (! $opt_n) {
      $socket = IO::Socket::INET->new(
          PeerAddr	=> $peeraddr,
          PeerPort	=> "9100",
          Proto     => "tcp",
          Type	=> SOCK_STREAM
      ) or die "Could not create socket: $!";
  }

my $data = <<EOJ
\e%-12345X\@PJL JOB
\@PJL RDYMSG DISPLAY="$rdymsg"
\@PJL EOJ
\e%-12345X
EOJ
;

  if (! $opt_n) {
	  print "Setting up printer ... ";
      print $socket $data;
  }
  else {
      print $data;
  }
  print "\n";
}