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;
47 if ( exists $cache{$station} ) {
48 my ( $time, $response ) = split $;, $cache{$station};
49 if ( ( time() - $time ) < $cache_time ) {
54 my $ua = new LWP::UserAgent;
55 $ua->proxy( 'http', $::param{'httpProxy'} )
56 if ( &::IsParam('httpProxy') );
60 new HTTP::Request( 'GET',
61 "http://weather.noaa.gov/weather/current/$station.html" );
62 my $response = $ua->request($request);
64 if ( !$response->is_success ) {
65 if ( $response->code == 404 ) {
66 return "I can't find station code \"$station\""
67 . " (see http://www.nws.noaa.gov/oso/site.shtml"
68 . " or http://www.nws.noaa.gov/tg/siteloc.shtml"
69 . " for ICAO locations codes).";
72 return 'Something failed in connecting to the NOAA web'
73 . " server. Try again later.";
77 $content = $response->content;
78 $content =~ s|.*?<BODY[^>]*>||is;
80 #$content =~ s|.*?current weather conditions.*?<BR>([^<]*?)\s*<.*?</TR>||is;
81 $content =~ s|.*?current weather conditions[^<]*(<[^>]+>\s*)+||is;
82 $content =~ s|([^<]*?)\s*<.*?</TR>||is;
86 $content =~ s|.*?<TR>(?:\s*<[^>]+>)*\s*([^<]+)\s<.*?</TR>||is;
90 $content =~ s|.*?conditions at.*?</TD>||is;
92 #$content =~ s|.*?<OPTION SELECTED>\s+([^<]+)\s<OPTION>.*?</TR>||s; # local time
93 $content =~ s|.*?<BR>\s+([^<]+?)\s*</FORM>.*?</TR>||s; # UTC
98 $content =~ s|\s(.*?)<TD COLSPAN=2>||s;
102 s|.*?<TD ALIGN[^>]*>(?:\s*<[^>]+>)*\s+([^<]+?)\s+<.*?<TD>(?:\s*<[^>]+>)*\s+([^<]+?)\s<.*?/TD>||s
105 my ( $f, $v ) = ( $1, $2 );
111 $content =~ s|.*?>(\d+\S+\s+\(\S+\)).*?</TD>||s; # max temp;
113 $content =~ s|.*?>(\d+\S+\s+\(\S+\)).*?</TD>||s;
117 if ( $wxmode eq 'metar' && defined( $feat{'ob'} ) ) {
118 return ( 'METAR ' . $place . ": " . $feat{'ob'} );
121 $result = "$place; $id; last updated: $time";
122 foreach ( sort keys %feat ) {
124 $result .= "; $_: $feat{$_}";
127 $cache{$station} = join $;, $t, $result;
131 "I can't find that station code (see http://weather.noaa.gov/weather/curcond.html for locations and codes)";
139 my $result = Weather::NOAA::get($default);
140 $result =~ s/; /\n/g;
141 print "\n$result\n\n";
147 # vim:ts=4:sw=4:expandtab:tw=80
153 NOAA.pl - Get the weather from a NOAA server
163 =head1 PUBLIC INTERFACE
165 weather [for] <station>
169 Contacts C<weather.noaa.gov> and gets the weather report for a given