#!/usr/bin/perl package Weather; # 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. # 16-SEP-99 lenzo@cs.cmu.edu switched to LWP::UA and # put in a timeout. my $no_weather; my $cache_time = 60 * 40 ; # 40 minute cache time my $default = 'KAGC'; BEGIN { $no_weather = 0; eval "use LWP::UserAgent"; $no_weather++ if ($@); } sub Weather::NOAA::get { my ($station) = shift; $station = uc($station); my $result; if ($no_weather) { return 0; } else { if (exists $cache{$station}) { my ($time, $response) = split $; , $cache{$station}; if ((time() - $time) < $cache_time) { return $response; } } my $ua = new LWP::UserAgent; if (my $proxy = main::getparam('httpproxy')) { $ua->proxy('http', $proxy) }; $ua->timeout(10); my $request = new HTTP::Request('GET', "http://tgsv22.nws.noaa.gov/weather/current/$station.html"); my $response = $ua->request($request); if (!$response->is_success) { return "Something failed in connecting to the NOAA web server. Try again later."; } $content = $response->content; if ($content =~ /ERROR/i) { return "I can't find that station code (see http://weather.noaa.gov/weather/curcond.html for locations codes)"; } $content =~ s|.*?current weather conditions.*?||is; $content =~ s|.*?(?:\s*<[^>]+>)*\s*([^<]+)\s<.*?||is; my $place = $1; chomp $place; $content =~ s|.*?(?:\s*<[^>]+>)*\s*([^<]+)\s<.*?||is; my $id = $1; chomp $id; $content =~ s|.*?conditions at.*?||is; $content =~ s|.*?