-#
-# 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