#!/usr/bin/env perl

#
# weather - retrieve National Weather Service reports
#
# This script connects to a weather report telnet service, and
# retrieves a weather report for the station named on the command
# line.  If no station is named, Lebanon, NH is assumed.
#
# by Michael J. Fromberger <http://www.dartmouth.edu/~sting/>
#
# Usage: weather [station]
#
# Writes results to standard output, or exits with an error
# and diagnostics to standard error.
#
# Copyright (C) 1997-1998 Michael J. Fromberger.
#
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
# 
# $Id: weather,v 1.2 2004/04/20 16:10:35 sting Exp $
#
use Socket;

chomp($prog = `basename $0`);

$DEBUG = $ENV{'DEBUG'};
$WHOST = $ENV{'WEATHERHOST'} || "rainmaker.wunderground.com";
$WPORT = $ENV{'WEATHERPORT'} || 23; # used to be 3000
$WCITY = uc(shift(@ARGV)) || "LEB";

# This is the connexion program.  We support a simple scripting
# dialect similar to modem connexion scripts The commands of this
# language are:
#    WAIT:text    - discard input until the given <text> is matched
#    SEND:text    - send this <text>.  <CR> is an alias for end of line
#    READ:text    - read data until <text> is encountered.  The <text>
#                   is discarded from the input, the data is broken up
#                   into lines, and saved in @DATA.
#    PRNT:text    - print the given <text> on the local console.
#    DBUG:text    - like PRNT, except only if $DEBUG is true
#    QUIT         - disconnect from server
#

@PROG = (
	 "WAIT:Return to continue:",
	 "SEND:<CR>",
	 "WAIT:forecast city code--",
	 "SEND:<CR>",
	 "WAIT:Selection:",
	 "SEND:C<CR>",
	 "WAIT:Selection:",
	 "SEND:4<CR>",
	 "WAIT:Selection:",
	 "SEND:1<CR>",
	 "WAIT:Selection:",
	 "SEND:1<CR>",
	 "WAIT:3-letter city code:",
	 "SEND:$WCITY<CR>",
	 "READ:CITY FORECAST MENU",
	 "WAIT:Selection:",
	 "SEND:X<CR>",
	 "QUIT"
	 );

$proto = getprotobyname('tcp');
socket(WS, AF_INET, SOCK_STREAM, $proto) or die "$prog: socket: $!\n";

$addr = gethostbyname($WHOST);
die "$prog: host '$WHOST' not found\n" unless $addr;

$addr = sockaddr_in($WPORT, $addr);
print STDERR "$prog: connecting to $WHOST $WPORT\n" if $DEBUG;
connect(WS, $addr) or die "$prog: connect $WHOST: $!\n";

@DATA = ();

 PROGLOOP:
    foreach $elt (@PROG) {
	$elt =~ /^([A-Za-z]+):(.*)$/m;
	$cmd = uc($1); $arg = $2;
	
	print STDERR "<$cmd> $arg\n" if($DEBUG);
      SWITCH: {
	  $cmd eq "SEND" && do {
	      send_cmd(\*WS, $arg);
	      last SWITCH;
	  };
	  
	  $cmd eq "WAIT" && do {
	      if(!wait_text(\*WS, $arg)) {
		  warn "$prog: wait failed, end of input\n";
		  close(WS);
		  last PROGLOOP;
	      }
	      last SWITCH;
	  };
	  
	  $cmd eq "READ" && do {
	      $data = ""; $line = "";
	    READLOOP:
	      while(sysread(WS, $data, 80)) {
		  $data =~ s/\r+//g;
		  print STDERR "$data" if $DEBUG;
		  $line .= $data;
		  last READLOOP if($line =~ /$arg/);
	      }
	      $line =~ s/$arg//;
	      @DATA = split(/\n/, $line);
	      last SWITCH;
	  };
	  
	  $cmd eq "QUIT" && do {
	      close(WS);
	      last SWITCH;
	  };

	  $cmd eq "PRNT" && do {
	      print STDERR "$arg";
	      last SWITCH;
	  };

	  $cmd eq "DBUG" && do {
	      print STDERR "$arg" if($DEBUG);
	  }
      }
    }

foreach $line (@DATA) {
    print $line . "\n";
}
exit(0);

sub wait_text {
    my($fd, $text) = @_;
    my($data, $line);

    while(sysread($fd, $data, 80)) {
	$data =~ s/\r+//g;
	$line .= $data;

	print STDERR "$data" if $DEBUG;

	return 1 if($line =~ /$text/);
    }

    0;
}

sub send_cmd {
    my($fd, $cmd) = @_;

    $cmd =~ s/<CR>/\r\n/g;
    send($fd, $cmd, 0);
}