src/Modules/Weather.pl

   1 #!/usr/bin/perl
   2
   3 package Weather;
   4
   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.
   8
   9 # 16-SEP-99 lenzo@cs.cmu.edu switched to LWP::UA and
  10 #           put in a timeout.
  11
  12 my $no_weather;
  13 my $cache_time = 60 * 40;    # 40 minute cache time
  14 my $default    = 'KAGC';
  15
  16 BEGIN {
  17     $no_weather = 0;
  18     eval "use LWP::UserAgent";
  19     $no_weather++ if ($@);
  20 }
  21
  22 sub Weather {
  23     my ($args) = @_;
  24     &::performStrictReply( &queryText( $args, 'weather' ) );
  25     return;
  26 }
  27
  28 sub Metar {
  29     my ($args) = @_;
  30     &::performStrictReply( &queryText( $args, 'metar' ) );
  31     return;
  32 }
  33
  34 sub queryText {
  35     my ($station) = shift;
  36     my ($wxmode)  = shift;
  37     my $result;
  38
  39     $station = uc($station);
  40     $station =~ s/for //i;
  41
  42     if ($no_weather) {
  43         return 0;
  44     }
  45     else {
  46
  47         if ( exists $cache{$station} ) {
  48             my ( $time, $response ) = split $;, $cache{$station};
  49             if ( ( time() - $time ) < $cache_time ) {
  50                 return $response;
  51             }
  52         }
  53
  54         my $ua = new LWP::UserAgent;
  55         $ua->proxy( 'http', $::param{'httpProxy'} )
  56           if ( &::IsParam('httpProxy') );
  57
  58         $ua->timeout(10);
  59         my $request =
  60           new HTTP::Request( 'GET',
  61             "http://weather.noaa.gov/weather/current/$station.html" );
  62         my $response = $ua->request($request);
  63
  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).";
  70             }
  71             else {
  72                 return 'Something failed in connecting to the NOAA web'
  73                   . " server. Try again later.";
  74             }
  75         }
  76
  77         $content = $response->content;
  78         $content =~ s|.*?<BODY[^>]*>||is;
  79
  80     #$content =~ s|.*?current weather conditions.*?<BR>([^<]*?)\s*<.*?</TR>||is;
  81         $content =~ s|.*?current weather conditions[^<]*(<[^>]+>\s*)+||is;
  82         $content =~ s|([^<]*?)\s*<.*?</TR>||is;
  83         my $place = $1;
  84         chomp $place;
  85
  86         $content =~ s|.*?<TR>(?:\s*<[^>]+>)*\s*([^<]+)\s<.*?</TR>||is;
  87         my $id = $1;
  88         chomp $id;
  89
  90         $content =~ s|.*?conditions at.*?</TD>||is;
  91
  92 #$content =~ s|.*?<OPTION SELECTED>\s+([^<]+)\s<OPTION>.*?</TR>||s; # local time
  93         $content =~ s|.*?<BR>\s+([^<]+?)\s*</FORM>.*?</TR>||s;    # UTC
  94         my $time = $1;
  95         $time =~ s/-//g;
  96         $time =~ s/\s+/ /g;
  97
  98         $content =~ s|\s(.*?)<TD COLSPAN=2>||s;
  99         my $features = $1;
 100
 101         while ( $features =~
 102 s|.*?<TD ALIGN[^>]*>(?:\s*<[^>]+>)*\s+([^<]+?)\s+<.*?<TD>(?:\s*<[^>]+>)*\s+([^<]+?)\s<.*?/TD>||s
 103           )
 104         {
 105             my ( $f, $v ) = ( $1, $2 );
 106             chomp $f;
 107             chomp $v;
 108             $feat{$f} = $v;
 109         }
 110
 111         $content =~ s|.*?>(\d+\S+\s+\(\S+\)).*?</TD>||s;    # max temp;
 112         $max_temp = $1;
 113         $content =~ s|.*?>(\d+\S+\s+\(\S+\)).*?</TD>||s;
 114         $min_temp = $1;
 115
 116         if ($time) {
 117             if ( $wxmode eq 'metar' && defined( $feat{'ob'} ) ) {
 118                 return ( 'METAR ' . $place . ": " . $feat{'ob'} );
 119             }
 120
 121             $result = "$place; $id; last updated: $time";
 122             foreach ( sort keys %feat ) {
 123                 next if $_ eq 'ob';
 124                 $result .= "; $_: $feat{$_}";
 125             }
 126             my $t = time();
 127             $cache{$station} = join $;, $t, $result;
 128         }
 129         else {
 130             $result =
 131 "I can't find that station code (see http://weather.noaa.gov/weather/curcond.html for locations and codes)";
 132         }
 133         return $result;
 134     }
 135 }
 136
 137 if (0) {
 138     if ( -t STDIN ) {
 139         my $result = Weather::NOAA::get($default);
 140         $result =~ s/; /\n/g;
 141         print "\n$result\n\n";
 142     }
 143 }
 144
 145 1;
 146
 147 # vim:ts=4:sw=4:expandtab:tw=80
 148
 149 __END__
 150
 151 =head1 NAME
 152
 153 NOAA.pl - Get the weather from a NOAA server
 154
 155 =head1 PREREQUISITES
 156
 157         LWP::UserAgent
 158
 159 =head1 PARAMETERS
 160
 161 weather
 162
 163 =head1 PUBLIC INTERFACE
 164
 165         weather [for] <station>
 166
 167 =head1 DESCRIPTION
 168
 169 Contacts C<weather.noaa.gov> and gets the weather report for a given
 170 station.
 171
 172 =head1 AUTHORS
 173
 174 Kevin Lenzo