5 # kevin lenzo (C) 1999 -- get the weather forcast NOAA.
6 # feel free to use, copy, cut up, and modify, but if
7 # you do something cool with it, let me know.
9 # 16-SEP-99 lenzo@cs.cmu.edu switched to LWP::UA and
13 my $cache_time = 60 * 40 ; # 40 minute cache time
18 eval "use LWP::UserAgent";
19 $no_weather++ if ($@);
24 &::performStrictReply(&queryText($args, 'weather'));
30 &::performStrictReply(&queryText($args, 'metar'));
35 my ($station) = shift;
39 $station = uc($station);
40 $station =~ s/for //i;
46 if (exists $cache{$station}) {
47 my ($time, $response) = split $; , $cache{$station};
48 if ((time() - $time) < $cache_time) {
53 my $ua = new LWP::UserAgent;
54 $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
57 my $request = new HTTP::Request('GET', "http://weather.noaa.gov/weather/current/$station.html");
58 my $response = $ua->request($request);
60 if (!$response->is_success) {
61 if ($response->code == 404) {
62 return "I can't find station code \"$station\""
63 . " (see http://www.nws.noaa.gov/oso/site.shtml"
64 . " or http://www.nws.noaa.gov/tg/siteloc.shtml"
65 . " for ICAO locations codes).";
67 return "Something failed in connecting to the NOAA web"
68 . " server. Try again later.";
72 $content = $response->content;
73 $content =~ s|.*?<BODY[^>]*>||is;
74 #$content =~ s|.*?current weather conditions.*?<BR>([^<]*?)\s*<.*?</TR>||is;
75 $content =~ s|.*?current weather conditions[^<]*(<[^>]+>\s*)+||is;
76 $content =~ s|([^<]*?)\s*<.*?</TR>||is;
80 $content =~ s|.*?<TR>(?:\s*<[^>]+>)*\s*([^<]+)\s<.*?</TR>||is;
84 $content =~ s|.*?conditions at.*?</TD>||is;
86 #$content =~ s|.*?<OPTION SELECTED>\s+([^<]+)\s<OPTION>.*?</TR>||s; # local time
87 $content =~ s|.*?<BR>\s+([^<]+?)\s*</FORM>.*?</TR>||s; # UTC
92 $content =~ s|\s(.*?)<TD COLSPAN=2>||s;
95 while ($features =~ s|.*?<TD ALIGN[^>]*>(?:\s*<[^>]+>)*\s+([^<]+?)\s+<.*?<TD>(?:\s*<[^>]+>)*\s+([^<]+?)\s<.*?/TD>||s) {
96 my ($f,$v) = ($1, $2);
101 $content =~ s|.*?>(\d+\S+\s+\(\S+\)).*?</TD>||s; # max temp;
103 $content =~ s|.*?>(\d+\S+\s+\(\S+\)).*?</TD>||s;
107 if ($wxmode eq 'metar' && defined($feat{'ob'})) {
108 return ("METAR " . $place . ": " . $feat{'ob'});
111 $result = "$place; $id; last updated: $time";
112 foreach (sort keys %feat) {
114 $result .= "; $_: $feat{$_}";
117 $cache{$station} = join $;, $t, $result;
119 $result = "I can't find that station code (see http://weather.noaa.gov/weather/curcond.html for locations and codes)";
127 my $result = Weather::NOAA::get($default);
128 $result =~ s/; /\n/g;
129 print "\n$result\n\n";
139 NOAA.pl - Get the weather from a NOAA server
149 =head1 PUBLIC INTERFACE
151 weather [for] <station>
155 Contacts C<weather.noaa.gov> and gets the weather report for a given