X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FModules%2FWeather.pl;h=516e357f8d9eef814988d48496d2164ac37a2eb5;hb=24ea7acb85e25b73b587e1c27ba2b8f90e465569;hp=7cf8a94e58d8cc637eee315898bc7284b8be2a3b;hpb=efd0559a232976fc23bdc81ac895d0bff0c267e7;p=infobot.git
diff --git a/src/Modules/Weather.pl b/src/Modules/Weather.pl
index 7cf8a94..516e357 100644
--- a/src/Modules/Weather.pl
+++ b/src/Modules/Weather.pl
@@ -10,8 +10,8 @@ package Weather;
# put in a timeout.
my $no_weather;
-my $cache_time = 60 * 40 ; # 40 minute cache time
-my $default = 'KAGC';
+my $cache_time = 60 * 40; # 40 minute cache time
+my $default = 'KAGC';
BEGIN {
$no_weather = 0;
@@ -20,118 +20,132 @@ BEGIN {
}
sub Weather {
- my ($args) = @_;
- &::performStrictReply(&queryText($args, 'weather'));
- return;
+ my ($args) = @_;
+ &::performStrictReply( &queryText( $args, 'weather' ) );
+ return;
}
sub Metar {
- my ($args) = @_;
- &::performStrictReply(&queryText($args, 'metar'));
- return;
+ my ($args) = @_;
+ &::performStrictReply( &queryText( $args, 'metar' ) );
+ return;
}
sub queryText {
my ($station) = shift;
- my ($wxmode) = shift;
+ my ($wxmode) = shift;
my $result;
$station = uc($station);
$station =~ s/for //i;
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;
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
-
- $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 "
- . " or http://www.nws.noaa.gov/tg/siteloc.shtml "
- . " for ICAO locations codes).";
- } else {
- return "Something failed in connecting to the NOAA web"
- . " server. Try again later.";
- }
- }
-
- $content = $response->content;
- $content =~ s|.*?
]*>||is;
- #$content =~ s|.*?current weather conditions.*?
([^<]*?)\s*<.*?||is;
- $content =~ s|.*?current weather conditions[^<]*(<[^>]+>\s*)+||is;
- $content =~ 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|.*?