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|.*?