Geo/TAF/example/cgi_weather.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # fetch a metar, taf or short taf from http://weather.noaa.gov
   4 #
   5 # This is designed to be used in a IFRAME and returns HTML.
   6 # It will only query the website once every 30 minutes, the rest
   7 # of the time it will cache the result in an 'easily guessable'
   8 # place in /tmp (consider that as a warning).
   9 #
  10 # Call it from a web page like this:-
  11 #
  12 # <iframe src="cgi-bin/fetch_weather.pl?icao=EGSH&metar=1"
  13 #  name="METAR for EGSH" frameborder="1" width="90%" height="50">
  14 # [Your user agent does not support frames or is currently configured
  15 #  not to display frames. However, you may visit
  16 #  <A href="cgi-bin/fetch_weather.pl?icao=EGSH&metar=1">METAR for EGSH</A>]
  17 # </iframe>
  18 #
  19 # You can set as many of these as you like:-
  20 #    metar=1   for a metar (default, if no options)
  21 #    staf=1    for a short form (usually more uptodate) TAF
  22 #    taf=1     for a full 18 hour TAF
  23 #    break=1   insert a "<br /><br />" between each result
  24 #
  25 # $Id$
  26 #
  27 # Copyright (c) 2003 Dirk Koopman G1TLH
  28 #
  29 use strict;
  30 use CGI;
  31 use Geo::TAF;
  32 use LWP::UserAgent;
  33
  34 my $q = new CGI;
  35 my $site_code = uc $q->param('icao');
  36 my @sort;
  37 push @sort, 'taf' if $q->param('taf');
  38 push @sort, 'staf' if $q->param('staf');
  39 push @sort, 'metar' if $q->param('metar') || @sort == 0;
  40 my $dobrk = $q->param('break');
  41
  42 error("No ICAO (valid) site code ($site_code) specified") unless $site_code && $site_code =~ /^[A-Z]{4}$/;
  43
  44 my $base = "/tmp";
  45 my ($sort, $fn, $started);
  46
  47 while ($sort = shift @sort) {
  48         $fn = "$base/${sort}_$site_code";
  49
  50         my ($mt, $size) = (stat $fn)[9,7];
  51         $mt ||= 0;
  52         $size ||= 0;
  53
  54         my $brk = "<br /></br />" unless @sort;
  55
  56         if ($mt + 30*60 < time || $size == 0) {
  57                 fetch_icao($brk);
  58         } else {
  59         my $s = retrieve();
  60                 send_metar($s, $brk);
  61         }
  62 }
  63
  64 sub retrieve
  65 {
  66         open IN, "$fn" or die "cannot open $fn $!\n";
  67         my $s = <IN>;
  68         close IN;
  69         return $s;
  70 }
  71
  72 sub fetch_icao
  73 {
  74         my $brk = shift || "";
  75         my $ua = new LWP::UserAgent;
  76
  77         my $req = new HTTP::Request GET =>
  78         "http://weather.noaa.gov/cgi-bin/mget$sort.pl?cccc=$site_code";
  79
  80         my $response = $ua->request($req);
  81
  82         if (!$response->is_success) {
  83                 error("METAR Fetch $site_code Error", $response->error_as_HTML);
  84         } else {
  85
  86         # Yep, get the data and find the METAR.
  87
  88         my $m = new Geo::TAF;
  89         my $data;
  90         $data = $response->as_string;               # grap response
  91         $data =~ s/\n//go;                          # remove newlines
  92         $data =~ m/($site_code\s\d+Z.*?)</go;       # find the METAR string
  93         my $metar = $1;                             # keep it
  94
  95         # Sanity check
  96         if (length($metar)<10) {
  97                         error("METAR ($metar) is too short");
  98         }
  99
 100         # pass the data to the METAR module.
 101                 if ($sort =~ /taf/) {
 102                         $m->taf($metar);
 103                 } else {
 104                         $m->metar($metar);
 105                 }
 106                 my $s = $m->as_string;
 107         send_metar($s, $brk);
 108                 store($s);
 109         }
 110 }
 111
 112 finish();
 113
 114 sub start
 115 {
 116         return if $started;
 117         print $q->header(-type=>'text/html', -expires=>'+60m');
 118     print $q->start_html(-title=>"Weather for $site_code", -style=>{'src'=>'/style.css'},);
 119         $started = 1;
 120 }
 121
 122 sub finish
 123 {
 124         print $q->end_html;
 125 }
 126
 127 sub store
 128 {
 129         my $s = shift;
 130         open OUT, ">$fn" or die "cannot open $fn $!\n";
 131         print OUT $s;
 132         close OUT;
 133 }
 134
 135 sub send_metar
 136 {
 137         my $s = shift;
 138         my $brk = shift || "";
 139
 140         start();
 141     print "<div class=frame>$s</div>$brk";
 142 }
 143
 144 sub error
 145 {
 146         my $err = shift;
 147         my $more = shift;
 148         print $q->header(-type=>'text/html', -expires=>'+60m');
 149     print $q->start_html($err);
 150         print $q->h3($err);
 151         print $more if $more;
 152         print $q->end_html;
 153         warn($err);
 154
 155     exit(0);
 156 }
 157