#!/usr/athena/bin/perl
# No apologies can be made for this code ... state based parsers
# are always sick and perverted, and this is no exception. Almost
# everything is in the order it is for a reason, be it speed or
# to massage bizzare output of the weather service. It is fairly
# easy to follow, though.
#
# If you make any useful extensions or even manage a rewrite, please
# let me know.
#
#		Dan Lovinger (dl2n+@andrew.cmu.edu)

# usage:
#	weather <citycode>
#		return weather report for <citycode>
#	weather <citycode> <statecode>
#		return weather report and all current condition
#		data for <statecode>
#	weather <citycode> <statecode> <cityprefix> ...
#		as above but filter current condition info
#		down to cities beginning with one of the <cityprefix>
#	weather -c <statecode>
#		only current info data
#	weather -c <statecode> <cityprefix> ...
#		current info data with filtration
#	weather -l
#		return all valid statecodes
#	weather -l <statecode>
#		return all valid citycodes for <statecode>
#
# all citycodes may substitute _ for a space for ease of use

# weather requires the chat2 package from Randall Schwartz
# Among other places, it is avaliable from uunet.uu.net in
# /languages/perl/scripts/chat2.shar.Z
require "chat2.pl";

die "usage: $0 <citycode | -c | -l> [statecode] [cityprefix ...]\n"
	if ! defined @ARGV;

for (@ARGV) {
	if (/-l/) {
		$code_listing = 1;
	}
	elsif (/-c/) {
		$current_only = 1;
	}
	else {
		# turn new_york into "new york" - convenience hack
		s/_/ /;
		push(@citylist, $_);
	}
}

if (! @citylist && ! $code_listing) {
    die "$0: -c needs at least a statecode (use -l to acquire)\n" 
	if $current_only;
    die "$0: need a citycode (use -l <statecode> to acquire)\n";
}

$us_listing = 1 if ! @citylist && $code_listing;
$state_listing = 1 if @citylist && $code_listing;

# cross newline boundaries in regex matches
$* = 1;

# turn on to see everything that happens
#$trace = 1;

# timeout period (seconds)
$timeout = 5; # extra long because of our slow modem

$weather_handle = &chat'open_port("downwind.sprl.umich.edu", 3000) ||
	die "$0: cannot connect to server ($!)\n";

while (length($return = &listen($timeout)) != 0) {
    
    if ($end_of_blurb == 0) {
	next unless $return =~ /city code:/;
	&talk("\n");
	$end_of_blurb = 1;
	next;
    }

    # scuttle michigan specific special info if present
    if ($ck_mi_special == 0) {
	if ($return =~ /to display main menu: /) {
	    &talk("M\n");
	    $ck_mi_special = 1;
	    next;
	}
    }
    
    # unset scrolling region so we get everything at once
    if ($wait_main_menu == 0) {
	next unless $return =~ /Change scrolling to screen/;
	&talk("C\n4\n");
	$wait_main_menu = 1;
	next;
    }
    
    goto CURRENT if $current_only;
    
    # go into the city menu
    if ($wait_main_menu_2 == 0) {
	next unless $return =~ /Change scrolling to screen/;
	&talk("1\n");
	$wait_main_menu_2 = 1;
	next;
    }
    
    # get city prompt
    if ($wait_city_menu == 0 && ! $code_listing) {
	next unless $return =~ /Help/;
	&talk("1\n");
	$wait_city_menu = 1;
	next;
    }
    elsif ($wait_city_menu == 0 && $state_listing) {
	next unless $return =~ /Help/;
	&talk("2\n");
	$wait_city_menu = 1;
	next;
    }
    elsif ($wait_city_menu == 0 && $us_listing) {
	next unless $return =~ /Help/;
	&talk("3\n");
	$wait_city_menu = 1;
	next;
    }
    
    # ask for weather report
    if ($wait_city_prompt == 0 && ! $code_listing) {
	next unless $return =~ / city code:/;
	&talk("$citylist[0]\n");
	shift @citylist;
	$wait_city_prompt = 1;
	next;
    }
    elsif ($wait_city_prompt == 0 && $state_listing) {
	next unless $return =~ / state code:/;
	&talk("$citylist[0]\n");
	$wait_city_prompt = 1;
	undef @citylist;	# can't pull multiple state lists
	next;
    }
    
    # eat weather report
    if ($slrp_report == 0) {
	@report = split(/\n/, $return);
	$blank = 0;
	for (@report) {
	    next if /^\s*$/ && ! $slrp_printed;
	    $slrp_printed = 1;
	    # report without extras
	    if (/CITY FORECAST MENU/) {
		$slrp_report = 1;
		last;
	    }
	    s/\015//;
	    # detect banner that says we have more to grab
	    if (/Special/) {
		# get it ready
		&talk("\n");
		last;
	    }
	    # this is a quick way to smash blank lines
	    if (/^\s*$/) {
		$blank = 1;
	    } else {
		if ($blank) {
		    print "\n";
		    $blank =  0;
		}
		print "$_\n";
	    }
	}
	# jump back to main menu after the report is in
	&talk("M\n");
	next;
    }
    
    # don't try to get current condition reports unless
    # user supplies data to use to get them
    if ($wait_current_menu == 0 && $#citylist < 0) {
	$clean_finish = 1;
	last;
    }
    
    # go into the current report menu
  CURRENT: if ($wait_current_menu == 0) {
      next unless $return =~ /Change scrolling to screen/;
      &talk("3\n");
      $wait_current_menu = 1;
      next;
  }
    
    # get state prompt
    if ($wait_state_menu == 0) {
	next unless $return =~ /Exit program/;
	&talk("1\n");
	$wait_state_menu = 1;
	next;
    }
    
    # ask for current report
    if ($wait_state_prompt == 0) {
	next unless $return =~ / province:/;
	&talk("$citylist[0]\n");
	shift @citylist;
	$wait_state_prompt = 1;
	next;
    }
    
    print "\n" unless $current_only;
    print "CURRENT CONDITIONS:\n";
    
    # eat current report
    if ($slrp_current_report == 0) {
	@report = split(/\n/, $return);
	# echo everything until we hit the data
	$echo_on = 1;
	$blank = 0;
	for (@report) {
	    next if /WEATHER ROUNDUP/ || /MAX TEMP/;
	    s/\015//;
	    # detect start of menu/end of report
	    if (/CURRENT WEATHER MENU/) {
		$slrp_current_report = 1;
		last;
	    }
	    # tags like this are seperators for multiple
	    # station listings
	    if (/^END\s*$/) {
		# Deal. Reset.
		print "\n";
		$echo_on = 1;
		next;
	    }
	    # this is at the end of the header line 
	    # - reports start here, turn off echo
	    if (/REMARKS/){
		# extra newline seperator
		print "\n$_\n";
		$echo_on = 0;
		next;
	    }
	    if ($echo_on == 1){
		# don't emit blank lines in echo mode
		next if /^\s*$/;
		print "$_\n";
		next;
	    }
	    # pull in report, extracting spec'd cities
	    foreach $city (@citylist) {
		# don't emit header items - entries
		# are at least 5 tokens long
		print "$_\n" 
		    if /^$city/i && split(/\s+/) > 5;
	    }
	    # pure echo mode if no cities specified
	    if (! @citylist) {
		# don't bother emitting cities with 
		# unavaliable data
		next if /NOT AVBL/;
		if (/^\s*$/) {
		    $blank = 1;
		} else {
		    if ($blank) {
			print "\n";
			$blank = 0;
		    }
		    print "$_\n";
		}
	    }
	}
    }
    
    $clean_finish = 1;
}

if ($clean_finish) {
    # send an exit request
    &talk("X\n");
}

&chat'close($weather_handle);

if (! $clean_finish) {
    $! = 1;
    die "$0: report incomplete (weather server slow or dead)\n";
}

exit 0;

##################################################
## some telnet-protocol routines - from Randall Schwartz
##################################################

sub talk {
    local($text) = @_;
    print "{$text}" if $trace;
    &chat'print($text);
}

sub listen {
    local($secs) = @_;
    local($return,$tmp) = "";
    while (length($tmp = &telnet_read($secs))) {
	print $tmp if $trace;
	$return .= $tmp;
    }
    $return;
}

sub telnet_read {
    local($secs) = @_;
    &chat'expect($secs,
		 '^\377[\375\376](.|\n)',
		 q#&chat'print ("\377\374".$1); redo LOOP#,
		 # WON'T do these do/don't requests
		 '^\377[\373\374](.|\n)', 'redo LOOP',
		 # ignore these will/won't changes
		 '^\377\377', '"\377"',
		 # escaping the IAC
		 '^\377(.|\n)', 'redo LOOP',
		 # ignoring these
		 '^[^\377]+', '$&'
		 # return these
		 );
}
