From 66cb28e55db2670c68b93f35904d9ed134355708 Mon Sep 17 00:00:00 2001
From: timriker <timriker@c11ca15a-4712-0410-83d8-924469b57eb5>
Date: Thu, 7 Aug 2003 00:50:48 +0000
Subject: [PATCH] working infobot module

git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@795 c11ca15a-4712-0410-83d8-924469b57eb5
---
 files/sample/sample.chan |   1 +
 src/Modules/Weather.pl   | 167 +++++++++++++++++++++++++++++----------
 2 files changed, 126 insertions(+), 42 deletions(-)

diff --git a/files/sample/sample.chan b/files/sample/sample.chan
index 68d5adf..920f4d2 100644
--- a/files/sample/sample.chan
+++ b/files/sample/sample.chan
@@ -57,6 +57,7 @@ _default
     +topic
     +units
     +userinfo
+    +weather
     +wwwsearch
     +zfi
     -zippy
diff --git a/src/Modules/Weather.pl b/src/Modules/Weather.pl
index b80d238..2cdf25b 100644
--- a/src/Modules/Weather.pl
+++ b/src/Modules/Weather.pl
@@ -1,61 +1,144 @@
-#
-#  Weather.pl: Frontend to GEO::Weather (weather.com).
-#      Author: logeist
-#     Version: v0.1 (20020512).
-#     Created: 20020512.
-#
+#!/usr/bin/perl
 
 package Weather;
 
-use IO::Socket;
-use strict;
+# kevin lenzo (C) 1999 -- get the weather forcast NOAA.
+# feel free to use, copy, cut up, and modify, but if
+# you do something cool with it, let me know.
 
-###local $SIG{ALRM} = sub { die "alarm\n" };
+# 16-SEP-99 lenzo@cs.cmu.edu switched to LWP::UA and
+#           put in a timeout.
 
-sub Weather {
-    my ($query) = @_;
-    my (@weatherloc, $whash); 
-    my $retval;
+my $no_weather;
+my $cache_time = 60 * 40 ; # 40 minute cache time
+my $default = 'KAGC';
 
-    return unless &::loadPerlModule("Geo::Weather");
-    my $weather = new Geo::Weather;
+BEGIN {
+    $no_weather = 0;
+    eval "use LWP::UserAgent";
+    $no_weather++ if ($@);
+}
 
-    for ($query) {
-	s/^[\s\t]+//;
-	s/[\s\t]+$//;
-	s/[\s\t]+/ /;
-    }
+sub Weather {
+	my ($args) = @_;
+	&::performStrictReply(&queryText($args));
+	return;
+}
 
-    @weatherloc = split /,\s*/, $query;
+sub queryText {
+    my ($station) = shift;
+    $station = uc($station);
+    my $result;
 
-    if (@weatherloc == 1) { 
-        $whash = $weather->get_weather ("$weatherloc[0]");
+    if ($no_weather) {
+	return 0;
     } else {
-	$whash = $weather->get_weather ("$weatherloc[0]", "$weatherloc[1]");
-    }
 
-    if (!ref $whash) {
-	$retval = "I'm sorry, not able to return weather conditions for $query";
-	&::performStrictReply($retval);
-	undef $weather;
-	return;
-    }
+	if (exists $cache{$station}) {
+	    my ($time, $response) = split $; , $cache{$station};
+	    if ((time() - $time) < $cache_time) {
+		return $response;
+	    }
+	}
 
-    $retval = "Current conditions in $whash->{city}, $whash->{state}: $whash->{cond}, $whash->{temp}° F.  Winds $whash->{wind} MPH.  Dewpoint: $whash->{dewp}° F, Relative Humidity: $whash->{humi}%,";
+	my $ua = new LWP::UserAgent;
+	$ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
 
-    if ($whash->{visb} eq 'Unlimited') {
-	$retval .= " Visibility: $whash->{visb}, ";
-    } else {
-	$retval .= " Visibility: $whash->{visb} mi., ";
-    }
+	$ua->timeout(10);
+	my $request = new HTTP::Request('GET', "http://weather.noaa.gov/weather/current/$station.html");
+	my $response = $ua->request($request); 
+
+	if (!$response->is_success) {
+	    if ($response->code == 404) {
+		return "I can't find station code \"$station\""
+		    . " (see http://www.nws.noaa.gov/oso/site.shtml"
+		    . " for ICAO locations codes).";
+	    } else {
+		return "Something failed in connecting to the NOAA web"
+		    . " server. Try again later.";
+	    }
+	}
+
+	$content = $response->content;
+	$content =~ s|.*?current weather conditions.*?<BR>([^<]*)<.*?</TR>||is;
+	my $place = $1;
+	$content =~ s|.*?<TR>(?:\s*<[^>]+>)*\s*([^<]+)\s<.*?</TR>||is;
+	$place .= $1;
+	chomp $place;
+
+	$content =~ s|.*?<TR>(?:\s*<[^>]+>)*\s*([^<]+)\s<.*?</TR>||is;
+	my $id = $1;
+	chomp $id;
+
+	$content =~ s|.*?conditions at.*?</TD>||is;
+
+	$content =~ s|.*?<OPTION SELECTED>\s+([^<]+)\s<OPTION>.*?</TR>||s;
+	my $time = $1;
+	$time =~ s/-//g;
+	$time =~ s/\s+/ /g;
+
+	$content =~ s|\s(.*?)<TD COLSPAN=2>||s;
+	my $features = $1;
 
-    $retval .= " Barometric Pressure: $whash->{baro} in.";
-    if($whash->{heat} ne 'N/A') {
-	$retval .= " Heat Index: $whash->{heat}° F.";
+	while ($features =~ s|.*?<TD ALIGN[^>]*>(?:\s*<[^>]+>)*\s+([^<]+?)\s+<.*?<TD>(?:\s*<[^>]+>)*\s+([^<]+?)\s<.*?/TD>||s) {
+	    my ($f,$v) = ($1, $2);
+	    chomp $f; chomp $v;
+	    $feat{$f} = $v;
+	}
+
+	$content =~ s|.*?>(\d+\S+\s+\(\S+\)).*?</TD>||s;  # max temp;
+	$max_temp = $1;
+	$content =~ s|.*?>(\d+\S+\s+\(\S+\)).*?</TD>||s;
+	$min_temp = $1;
+
+	if ($time) {
+	    $result = "$place; $id; last updated: $time";
+	    foreach (sort keys %feat) {
+		next if $_ eq 'ob';
+		$result .= "; $_: $feat{$_}";
+	    }
+	    my $t = time();
+	    $cache{$station} = join $;, $t, $result;
+	} else {
+	    $result = "I can't find that station code (see http://weather.noaa.gov/weather/curcond.html for locations and codes)";
+	}
+	return $result;
     }
+}
 
-    &::performStrictReply($retval);
-    undef $weather;
+if (0) {
+    if (-t STDIN) {
+	my $result = Weather::NOAA::get($default);
+	$result =~ s/; /\n/g;
+	print "\n$result\n\n";
+    }
 }
 
 1;
+
+__END__
+
+=head1 NAME
+
+NOAA.pl - Get the weather from a NOAA server
+
+=head1 PREREQUISITES
+
+	LWP::UserAgent
+
+=head1 PARAMETERS
+
+weather
+
+=head1 PUBLIC INTERFACE
+
+	weather [for] <station>
+
+=head1 DESCRIPTION
+
+Contacts C<weather.noaa.gov> and gets the weather report for a given
+station.
+
+=head1 AUTHORS
+
+Kevin Lenzo
-- 
2.39.2