mirror of
git://scm.dxcluster.org/scm/spider
synced 2024-09-21 07:47:10 +00:00
add back the contents of this directory
This commit is contained in:
parent
a6627ef7af
commit
b4ab8d5020
157
Geo/TAF/example/cgi_weather.pl
Executable file
157
Geo/TAF/example/cgi_weather.pl
Executable file
@ -0,0 +1,157 @@
|
||||
#!/usr/bin/perl -w
|
||||
#
|
||||
# fetch a metar, taf or short taf from http://weather.noaa.gov
|
||||
#
|
||||
# This is designed to be used in a IFRAME and returns HTML.
|
||||
# It will only query the website once every 30 minutes, the rest
|
||||
# of the time it will cache the result in an 'easily guessable'
|
||||
# place in /tmp (consider that as a warning).
|
||||
#
|
||||
# Call it from a web page like this:-
|
||||
#
|
||||
# <iframe src="cgi-bin/fetch_weather.pl?icao=EGSH&metar=1"
|
||||
# name="METAR for EGSH" frameborder="1" width="90%" height="50">
|
||||
# [Your user agent does not support frames or is currently configured
|
||||
# not to display frames. However, you may visit
|
||||
# <A href="cgi-bin/fetch_weather.pl?icao=EGSH&metar=1">METAR for EGSH</A>]
|
||||
# </iframe>
|
||||
#
|
||||
# You can set as many of these as you like:-
|
||||
# metar=1 for a metar (default, if no options)
|
||||
# staf=1 for a short form (usually more uptodate) TAF
|
||||
# taf=1 for a full 18 hour TAF
|
||||
# break=1 insert a "<br /><br />" between each result
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
# Copyright (c) 2003 Dirk Koopman G1TLH
|
||||
#
|
||||
use strict;
|
||||
use CGI;
|
||||
use Geo::TAF;
|
||||
use LWP::UserAgent;
|
||||
|
||||
my $q = new CGI;
|
||||
my $site_code = uc $q->param('icao');
|
||||
my @sort;
|
||||
push @sort, 'taf' if $q->param('taf');
|
||||
push @sort, 'staf' if $q->param('staf');
|
||||
push @sort, 'metar' if $q->param('metar') || @sort == 0;
|
||||
my $dobrk = $q->param('break');
|
||||
|
||||
error("No ICAO (valid) site code ($site_code) specified") unless $site_code && $site_code =~ /^[A-Z]{4}$/;
|
||||
|
||||
my $base = "/tmp";
|
||||
my ($sort, $fn, $started);
|
||||
|
||||
while ($sort = shift @sort) {
|
||||
$fn = "$base/${sort}_$site_code";
|
||||
|
||||
my ($mt, $size) = (stat $fn)[9,7];
|
||||
$mt ||= 0;
|
||||
$size ||= 0;
|
||||
|
||||
my $brk = "<br /></br />" unless @sort;
|
||||
|
||||
if ($mt + 30*60 < time || $size == 0) {
|
||||
fetch_icao($brk);
|
||||
} else {
|
||||
my $s = retrieve();
|
||||
send_metar($s, $brk);
|
||||
}
|
||||
}
|
||||
|
||||
sub retrieve
|
||||
{
|
||||
open IN, "$fn" or die "cannot open $fn $!\n";
|
||||
my $s = <IN>;
|
||||
close IN;
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub fetch_icao
|
||||
{
|
||||
my $brk = shift || "";
|
||||
my $ua = new LWP::UserAgent;
|
||||
|
||||
my $req = new HTTP::Request GET =>
|
||||
"http://weather.noaa.gov/cgi-bin/mget$sort.pl?cccc=$site_code";
|
||||
|
||||
my $response = $ua->request($req);
|
||||
|
||||
if (!$response->is_success) {
|
||||
error("METAR Fetch $site_code Error", $response->error_as_HTML);
|
||||
} else {
|
||||
|
||||
# Yep, get the data and find the METAR.
|
||||
|
||||
my $m = new Geo::TAF;
|
||||
my $data;
|
||||
$data = $response->as_string; # grap response
|
||||
$data =~ s/\n//go; # remove newlines
|
||||
$data =~ m/($site_code\s\d+Z.*?)</go; # find the METAR string
|
||||
my $metar = $1; # keep it
|
||||
|
||||
# Sanity check
|
||||
if (length($metar)<10) {
|
||||
error("METAR ($metar) is too short");
|
||||
}
|
||||
|
||||
# pass the data to the METAR module.
|
||||
if ($sort =~ /taf/) {
|
||||
$m->taf($metar);
|
||||
} else {
|
||||
$m->metar($metar);
|
||||
}
|
||||
my $s = $m->as_string;
|
||||
send_metar($s, $brk);
|
||||
store($s);
|
||||
}
|
||||
}
|
||||
|
||||
finish();
|
||||
|
||||
sub start
|
||||
{
|
||||
return if $started;
|
||||
print $q->header(-type=>'text/html', -expires=>'+60m');
|
||||
print $q->start_html(-title=>"Weather for $site_code", -style=>{'src'=>'/style.css'},);
|
||||
$started = 1;
|
||||
}
|
||||
|
||||
sub finish
|
||||
{
|
||||
print $q->end_html;
|
||||
}
|
||||
|
||||
sub store
|
||||
{
|
||||
my $s = shift;
|
||||
open OUT, ">$fn" or die "cannot open $fn $!\n";
|
||||
print OUT $s;
|
||||
close OUT;
|
||||
}
|
||||
|
||||
sub send_metar
|
||||
{
|
||||
my $s = shift;
|
||||
my $brk = shift || "";
|
||||
|
||||
start();
|
||||
print "<div class=frame>$s</div>$brk";
|
||||
}
|
||||
|
||||
sub error
|
||||
{
|
||||
my $err = shift;
|
||||
my $more = shift;
|
||||
print $q->header(-type=>'text/html', -expires=>'+60m');
|
||||
print $q->start_html($err);
|
||||
print $q->h3($err);
|
||||
print $more if $more;
|
||||
print $q->end_html;
|
||||
warn($err);
|
||||
|
||||
exit(0);
|
||||
}
|
||||
|
68
Geo/TAF/example/cmd_chunks.pl
Executable file
68
Geo/TAF/example/cmd_chunks.pl
Executable file
@ -0,0 +1,68 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# This example takes METARs and TAFs from the standard input, parses them
|
||||
# and prints them out in a (sort of readable) normalised form
|
||||
#
|
||||
# Note that this is a state machine which can take any old rubbish and looks
|
||||
# for a start of a forecast in the input. It then searches for a blank line
|
||||
# before looking for the next.
|
||||
#
|
||||
# You can get METARs from ftp://weather.noaa.gov/data/observations/metar
|
||||
# TAFs from ftp://weather.noaa.gov/data/forecasts/taf/ and
|
||||
# from ftp://weather.noaa.gov/data/forecasts/shorttaf/
|
||||
# directories. This program will parse these files directly
|
||||
#
|
||||
# You will need to press <return> twice to get any output if you are entering
|
||||
# stuff manually.
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
# Copyright (c) 2003 Dirk Koopman G1TLH
|
||||
#
|
||||
|
||||
use strict;
|
||||
use Geo::TAF;
|
||||
|
||||
my $in;
|
||||
my $t;
|
||||
|
||||
while (<STDIN>) {
|
||||
chomp;
|
||||
if (/^\s*$/) {
|
||||
if ($in) {
|
||||
$t = new Geo::TAF;
|
||||
if ($in =~ /(?:METAR|TAF)/) {
|
||||
$t->decode($in);
|
||||
} elsif ($in =~ /[QA]\d\d\d\d/) {
|
||||
$t->metar($in);
|
||||
} else {
|
||||
$t->taf($in);
|
||||
}
|
||||
print_taf($t);
|
||||
undef $in;
|
||||
undef $t ;
|
||||
}
|
||||
} else {
|
||||
if ($in) {
|
||||
$in .= $_;
|
||||
} else {
|
||||
next unless Geo::TAF::is_weather($_);
|
||||
$in = $_;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print_taf($t) if $t;
|
||||
|
||||
sub print_taf
|
||||
{
|
||||
my $t = shift;
|
||||
|
||||
print $t->raw, "\n\n";
|
||||
|
||||
my $spc = "";
|
||||
foreach my $c ($t->chunks) {
|
||||
print $c->as_chunk, "\n";
|
||||
}
|
||||
print "\n\n";
|
||||
}
|
79
Geo/TAF/example/cmd_taf.pl
Executable file
79
Geo/TAF/example/cmd_taf.pl
Executable file
@ -0,0 +1,79 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# This example takes METARs and TAFs from the standard input and
|
||||
# prints them out in a readable form, in something approaching English
|
||||
#
|
||||
# Note that this is a state machine which can take any old rubbish and looks
|
||||
# for a start of a forecast in the input. It then searches for a blank line
|
||||
# before looking for the next.
|
||||
#
|
||||
# You can METARs from ftp://weather.noaa.gov/data/observations/metar/ and
|
||||
# TAFs from ftp://weather.noaa.gov/data/forecasts/taf/ and
|
||||
# from ftp://weather.noaa.gov/data/forecasts/shorttaf/
|
||||
# directories. This program will parse these files directly
|
||||
#
|
||||
# You will need to press <return> twice to get any output if you are entering
|
||||
# stuff manually.
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
# Copyright (c) 2003 Dirk Koopman G1TLH
|
||||
#
|
||||
|
||||
use strict;
|
||||
use Geo::TAF;
|
||||
|
||||
my $in;
|
||||
my $t;
|
||||
|
||||
while (<STDIN>) {
|
||||
chomp;
|
||||
if (/^\s*$/) {
|
||||
if ($in) {
|
||||
$t = new Geo::TAF;
|
||||
if ($in =~ /(?:METAR|TAF)/) {
|
||||
$t->decode($in);
|
||||
} elsif ($in =~ /[QA]\d\d\d\d/) {
|
||||
$t->metar($in);
|
||||
} else {
|
||||
$t->taf($in);
|
||||
}
|
||||
print_taf($t);
|
||||
undef $in;
|
||||
undef $t ;
|
||||
}
|
||||
} else {
|
||||
if ($in) {
|
||||
$in .= $_;
|
||||
} else {
|
||||
next unless Geo::TAF::is_weather($_);
|
||||
$in = $_;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print_taf($t) if $t;
|
||||
|
||||
sub print_taf
|
||||
{
|
||||
my $t = shift;
|
||||
|
||||
print $t->raw, "\n\n";
|
||||
|
||||
my $spc = "";
|
||||
foreach my $c ($t->chunks) {
|
||||
# print "\n", $c->as_chunk, " ";
|
||||
if ((ref $c) =~ /::(?:PROB|TEMPO|BECMG|FROM)$/) {
|
||||
print "\n\t";
|
||||
$spc = '';
|
||||
}
|
||||
print $spc, $c->as_string;
|
||||
if ((ref $c) =~ /::(?:VALID)$/) {
|
||||
print "\n\t";
|
||||
$spc = '';
|
||||
} else {
|
||||
$spc = ' ';
|
||||
}
|
||||
}
|
||||
print "\n\n";
|
||||
}
|
101
Geo/TAF/example/fetch_weather.pl
Executable file
101
Geo/TAF/example/fetch_weather.pl
Executable file
@ -0,0 +1,101 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
# $Id$
|
||||
|
||||
# this has been taken from Geo::METAR and modified
|
||||
#
|
||||
# Brief Description
|
||||
# =================
|
||||
#
|
||||
# fetch_temp.pl is a program that demonstrates how to get the current
|
||||
# temperature from a nearby (or not) airport using Geo::METAR and the
|
||||
# LWP modules.
|
||||
#
|
||||
# Given an airport site code on the command line, fetch_temp.pl
|
||||
# fetches the current temperature and displays it on the
|
||||
# command-line. For fun, here are some example airports:
|
||||
#
|
||||
# LA : KLAX
|
||||
# Dallas : KDFW
|
||||
# Detroit: KDTW
|
||||
# Chicago: KMDW
|
||||
#
|
||||
# and of course: EGSH (Norwich)
|
||||
#
|
||||
#
|
||||
|
||||
# Get the site code.
|
||||
my ($debug, $raw);
|
||||
my @sort;
|
||||
while ($ARGV[0] =~ /^-/ && @ARGV > 1) {
|
||||
my @f = split //, shift @ARGV;
|
||||
shift @f;
|
||||
foreach $f (@f) {
|
||||
push @sort, 'taf' if $f eq 't' && ! grep $_ eq 'taf', @sort;
|
||||
push @sort, 'staf' if $f eq 's' && ! grep $_ eq 'staf', @sort;
|
||||
push @sort, 'metar' if $f eq 'm' && ! grep $_ eq 'metar', @sort;
|
||||
$debug++ if $f eq 'x';
|
||||
$raw++ if $f eq 'r';
|
||||
}
|
||||
}
|
||||
push @sort, 'metar' unless @sort;
|
||||
|
||||
my $site_code = uc shift @ARGV;
|
||||
|
||||
die "Usage: $0 [-mts] <site_code>\n" unless $site_code;
|
||||
|
||||
# Get the modules we need.
|
||||
|
||||
use Geo::TAF;
|
||||
use LWP::UserAgent;
|
||||
use strict;
|
||||
|
||||
my $sort;
|
||||
|
||||
foreach $sort (@sort) {
|
||||
|
||||
my $ua = new LWP::UserAgent;
|
||||
|
||||
my $req = new HTTP::Request GET =>
|
||||
"http://weather.noaa.gov/cgi-bin/mget$sort.pl?cccc=$site_code";
|
||||
|
||||
my $response = $ua->request($req);
|
||||
|
||||
if ($response->is_success) {
|
||||
|
||||
# Yep, get the data and find the METAR.
|
||||
|
||||
my $m = new Geo::TAF;
|
||||
my $data;
|
||||
$data = $response->as_string; # grap response
|
||||
$data =~ s/\n//go; # remove newlines
|
||||
$data =~ m/($site_code\s\d+Z.*?)</go; # find the METAR string
|
||||
my $metar = $1; # keep it
|
||||
|
||||
# Sanity check
|
||||
|
||||
if (length($metar)<10) {
|
||||
die "METAR is too short! Something went wrong.";
|
||||
}
|
||||
|
||||
# pass the data to the METAR module.
|
||||
if ($sort =~ /taf$/) {
|
||||
$m->taf($metar);
|
||||
} else {
|
||||
$m->metar($metar);
|
||||
}
|
||||
print $m->raw, "\n" if $raw;
|
||||
print join "\n", $m->as_chunk_strings, "\n" if $debug;
|
||||
print $m->as_string, "\n";
|
||||
|
||||
} else {
|
||||
|
||||
print $response->as_string, "\n";
|
||||
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
|
||||
exit 0;
|
||||
|
||||
|
428
Geo/TAF/example/scgi_weather.pl
Executable file
428
Geo/TAF/example/scgi_weather.pl
Executable file
@ -0,0 +1,428 @@
|
||||
#!/usr/bin/perl -w
|
||||
#
|
||||
# fetch a metar, taf or short taf from http://weather.noaa.gov
|
||||
#
|
||||
# This is a module which shows me doing my own thing using the
|
||||
# normalised input. It does essentially the same job as
|
||||
# cgi_weather.pl, it's just a lot more complicated but returns
|
||||
# a much shorter string that is a bit more cryptic.
|
||||
#
|
||||
# It also is designed really to just get the forecast and
|
||||
# actual weather.
|
||||
#
|
||||
# This is designed to be used in a IFRAME and returns HTML.
|
||||
# It will only query the website once every 30 minutes, the rest
|
||||
# of the time it will cache the result in an 'easily guessable'
|
||||
# place in /tmp (consider that as a warning).
|
||||
#
|
||||
# Call it from a web page like this:-
|
||||
#
|
||||
# <iframe src="cgi-bin/fetch_weather.pl?icao=EGSH&metar=1"
|
||||
# name="METAR for EGSH" frameborder="1" width="90%" height="50">
|
||||
# [Your user agent does not support frames or is currently configured
|
||||
# not to display frames. However, you may visit
|
||||
# <A href="cgi-bin/fetch_weather.pl?icao=EGSH&metar=1">METAR for EGSH</A>]
|
||||
# </iframe>
|
||||
#
|
||||
# You can set as many of these as you like:-
|
||||
#
|
||||
# break=1 insert a "<br /><br />" between each result
|
||||
# onediv=1 make a multiple one div (not one div per thing)
|
||||
# raw=1 will display the raw weather string
|
||||
# debug=1 will display the objects
|
||||
# force=1 always fetch the data (don't use any cached stuff)
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
# Copyright (c) 2003 Dirk Koopman G1TLH
|
||||
#
|
||||
use strict;
|
||||
|
||||
package main;
|
||||
|
||||
use CGI;
|
||||
use Geo::TAF;
|
||||
use LWP::UserAgent;
|
||||
|
||||
my $q = new CGI;
|
||||
my $site_code = uc $q->param('icao');
|
||||
my @sort = qw(metar staf);
|
||||
my $debug = $q->param('debug');
|
||||
my $raw = $q->param('raw');
|
||||
my $force = $q->param('force');
|
||||
my $dobrk = "<br /><br />" if $q->param('break') && @sort > 1;
|
||||
my $onediv = $q->param('onediv') && @sort > 1;
|
||||
|
||||
|
||||
my %st = (
|
||||
VV => 'vert. viz',
|
||||
SKC => "no cloud",
|
||||
CLR => "no cloud no sig wthr",
|
||||
BKN => "5-7okt",
|
||||
SCT => "3-4okt",
|
||||
FEW => "0-2okt",
|
||||
OVC => "8okt",
|
||||
CAVOK => "CAVOK(no cloud >10Km viz no sig wthr)",
|
||||
CB => 'CuNim',
|
||||
TCU => 'tower Cu',
|
||||
NSC => 'no sig cloud',
|
||||
BLU => '3okt 2500ft 8Km viz',
|
||||
WHT => '3okt 1500ft 5Km viz',
|
||||
GRN => '3okt 700ft 3700m viz',
|
||||
YLO => '3okt 300ft 1600m viz',
|
||||
AMB => '3okt 200ft 800m viz',
|
||||
RED => '3okt <200ft <800m viz',
|
||||
NIL => 'no weather',
|
||||
'///' => 'some',
|
||||
);
|
||||
|
||||
my %wt = (
|
||||
'+' => 'heavy',
|
||||
'-' => 'light',
|
||||
'VC' => 'in the vicinity',
|
||||
|
||||
MI => 'shallow',
|
||||
PI => 'partial',
|
||||
BC => 'patches of',
|
||||
DR => 'low drifting',
|
||||
BL => 'blowing',
|
||||
SH => 'showers',
|
||||
TS => 'thunderstorms containing',
|
||||
FZ => 'freezing',
|
||||
RE => 'recent',
|
||||
|
||||
DZ => 'drizzle',
|
||||
RA => 'rain',
|
||||
SN => 'snow',
|
||||
SG => 'snow grains',
|
||||
IC => 'ice crystals',
|
||||
PE => 'ice pellets',
|
||||
GR => 'hail',
|
||||
GS => 'small hail/snow pellets',
|
||||
UP => 'unknown precip',
|
||||
|
||||
BR => 'mist',
|
||||
FG => 'fog',
|
||||
FU => 'smoke',
|
||||
VA => 'volcanic ash',
|
||||
DU => 'dust',
|
||||
SA => 'sand',
|
||||
HZ => 'haze',
|
||||
PY => 'spray',
|
||||
|
||||
PO => 'dust/sand whirls',
|
||||
SQ => 'squalls',
|
||||
FC => 'tornado',
|
||||
SS => 'sand storm',
|
||||
DS => 'dust storm',
|
||||
'+FC' => 'water spouts',
|
||||
WS => 'wind shear',
|
||||
'BKN' => 'broken',
|
||||
|
||||
'NOSIG' => 'no significant weather',
|
||||
|
||||
);
|
||||
|
||||
start();
|
||||
|
||||
error("No ICAO (valid) site code ($site_code) specified") unless $site_code && $site_code =~ /^[A-Z]{4}$/;
|
||||
|
||||
my $base = "/tmp";
|
||||
my ($sort, $fn, $started);
|
||||
|
||||
print "<div class=\"weather\">$site_code ";
|
||||
|
||||
while ($sort = shift @sort) {
|
||||
$fn = "$base/${sort}_$site_code";
|
||||
|
||||
if (!$force && -e $fn) {
|
||||
my ($mt, $size) = (stat $fn)[9,7] ;
|
||||
$mt ||= 0;
|
||||
$size ||= 0;
|
||||
if ($mt + 30*60 < time || $size == 0) {
|
||||
my $s = fetch_icao($sort);
|
||||
store($s);
|
||||
print $s;
|
||||
} else {
|
||||
my $s = retrieve($fn);
|
||||
print $s;
|
||||
}
|
||||
} else {
|
||||
my $s = fetch_icao($sort);
|
||||
store($s);
|
||||
print $s;
|
||||
}
|
||||
|
||||
if (@sort > 0) {
|
||||
print $onediv ? ' ' : '</div>';
|
||||
print $dobrk if $dobrk;
|
||||
print '<div class="weather">' unless $onediv;
|
||||
}
|
||||
}
|
||||
|
||||
finish();
|
||||
exit(0);
|
||||
|
||||
sub retrieve
|
||||
{
|
||||
my $fn = shift;
|
||||
open IN, "$fn" or die "cannot open $fn $!\n";
|
||||
my $s = <IN>;
|
||||
close IN;
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub fetch_thing
|
||||
{
|
||||
my $sort = shift;
|
||||
|
||||
my $ua = new LWP::UserAgent;
|
||||
my $req = new HTTP::Request GET =>
|
||||
"http://weather.noaa.gov/cgi-bin/mget$sort.pl?cccc=$site_code";
|
||||
|
||||
my $response = $ua->request($req);
|
||||
|
||||
my $metar;
|
||||
if (!$response->is_success) {
|
||||
error("METAR Fetch $site_code Error", $response->error_as_HTML);
|
||||
} else {
|
||||
|
||||
my $data = $response->as_string;
|
||||
($metar) = $data =~ /($site_code\s+\d+Z?[^<]*)/; # find the METAR string
|
||||
|
||||
# Sanity check
|
||||
if (length $metar < 10) {
|
||||
error("METAR ($metar) is too short");
|
||||
}
|
||||
}
|
||||
return $metar;
|
||||
}
|
||||
|
||||
sub fetch_icao
|
||||
{
|
||||
my $sort = shift;
|
||||
my $metar = fetch_thing($sort);
|
||||
|
||||
# pass the data to the METAR module.
|
||||
my $m = new Geo::TAF;
|
||||
if ($sort =~ /taf$/) {
|
||||
$m->taf($metar);
|
||||
} else {
|
||||
$m->metar($metar);
|
||||
}
|
||||
|
||||
my @in;
|
||||
my $s;
|
||||
$s .= join "<br />", $m->raw, "<br />" if $raw;
|
||||
$s .= join "<br />", $m->as_chunk_strings, "<br />" if $debug;
|
||||
foreach my $c ($m->chunks) {
|
||||
my ($sub) = (ref $c) =~ /::([A-Z]+)$/;
|
||||
no strict 'refs';
|
||||
if ($sub eq 'HEAD') {
|
||||
$sub = $sort =~ /taf$/ ? "taf$sub" : "metar$sub";
|
||||
}
|
||||
push @in, &$sub($c);
|
||||
}
|
||||
$s .= join ' ', @in;
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub start
|
||||
{
|
||||
return if $started;
|
||||
print $q->header(-type=>'text/html', -expires=>'+60m');
|
||||
print $q->start_html(-title=>"Weather for $site_code", -style=>{'src'=>'/style.css'},);
|
||||
$started = 1;
|
||||
}
|
||||
|
||||
sub finish
|
||||
{
|
||||
print "</div>";
|
||||
print $q->end_html, "\n";
|
||||
}
|
||||
|
||||
sub store
|
||||
{
|
||||
my $s = shift;
|
||||
open OUT, ">$fn" or die "cannot open $fn $!\n";
|
||||
print OUT $s;
|
||||
close OUT;
|
||||
}
|
||||
|
||||
sub error
|
||||
{
|
||||
my $err = shift;
|
||||
my $more = shift;
|
||||
print $q->h3($err);
|
||||
print $more if $more;
|
||||
print "</div>", $q->end_html;
|
||||
warn($err);
|
||||
|
||||
exit(0);
|
||||
}
|
||||
|
||||
sub tafHEAD
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
return "FORECAST Issued $in[3] on " . Geo::TAF::EN::day($in[2]);
|
||||
}
|
||||
|
||||
sub metarHEAD
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
return "CURRENT Issued $in[3] on " . Geo::TAF::EN::day($in[2]);
|
||||
}
|
||||
|
||||
sub VALID
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
return "Valid $in[1]-\>$in[2] on " . Geo::TAF::EN::day($in[0]);
|
||||
}
|
||||
|
||||
sub WIND
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
my $out = "Wind";
|
||||
$out .= $in[0] eq 'VRB' ? " variable" : " $in[0]";
|
||||
$out .= " varying $in[4]-\>$in[5]" if defined $in[4];
|
||||
$out .= ($in[0] eq 'VRB' ? '' : "deg") . " $in[1]";
|
||||
$out .= " gust $in[2]" if defined $in[2];
|
||||
$out .= $in[3];
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub PRESS
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
return "QNH $in[0]";
|
||||
}
|
||||
|
||||
sub TEMP
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
my $out = "Temp $in[0]C";
|
||||
$out .= " Dewp $in[1]C" if defined $in[1];
|
||||
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub CLOUD
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
|
||||
return $st{$in[0]} if @in == 1;
|
||||
return "Cloud $st{$in[0]} \@ $in[1]ft" if $in[0] eq 'VV';
|
||||
my $out = "Cloud $st{$in[0]} \@ $in[1]ft";
|
||||
$out .= " $st{$in[2]}" if defined $in[2];
|
||||
return $out;
|
||||
}
|
||||
|
||||
#sub WEATHER
|
||||
#{
|
||||
# goto &Geo::TAF::EN::WEATHER::as_string;
|
||||
#}
|
||||
|
||||
|
||||
sub WEATHER
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
my @out;
|
||||
|
||||
my ($vic, $shower);
|
||||
my $one = $in[0];
|
||||
|
||||
while (@in) {
|
||||
my $t = shift @in;
|
||||
|
||||
if (!defined $t) {
|
||||
next;
|
||||
} elsif ($t eq 'VC') {
|
||||
$vic++;
|
||||
next;
|
||||
} elsif ($t eq 'SH') {
|
||||
$shower++;
|
||||
next;
|
||||
} elsif ($t eq '+' && $one eq 'FC') {
|
||||
push @out, $wt{'+FC'};
|
||||
shift;
|
||||
next;
|
||||
}
|
||||
|
||||
push @out, $wt{$t};
|
||||
|
||||
if (@out && $shower) {
|
||||
$shower = 0;
|
||||
push @out, $wt{'SH'};
|
||||
}
|
||||
}
|
||||
push @out, $wt{'VC'} if $vic;
|
||||
|
||||
return join ' ', @out;
|
||||
}
|
||||
|
||||
sub RVR
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
my $out = "RVR R$in[0] $in[1]$in[3]";
|
||||
$out .= " vary $in[2]$in[3]" if defined $in[2];
|
||||
if (defined $in[4]) {
|
||||
$out .= " decr" if $in[4] eq 'D';
|
||||
$out .= " incr" if $in[4] eq 'U';
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub RWY
|
||||
{
|
||||
return "";
|
||||
}
|
||||
|
||||
sub PROB
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
|
||||
my $out = "Prob $in[0]%";
|
||||
$out .= " $in[1]-\>$in[2]" if defined $in[1];
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub TEMPO
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
my $out = "Temporary";
|
||||
$out .= " $in[0]-\>$in[1]" if defined $in[0];
|
||||
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub BECMG
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
my $out = "Becoming";
|
||||
$out .= " $in[0]-\>$in[1]" if defined $in[0];
|
||||
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub VIZ
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
|
||||
return "Viz $in[0]$in[1]";
|
||||
}
|
||||
|
||||
sub FROM
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
|
||||
return "From $in[0]";
|
||||
}
|
||||
|
||||
sub TIL
|
||||
{
|
||||
my @in = @{$_[0]};
|
||||
|
||||
return "Until $in[0]";
|
||||
}
|
||||
|
||||
1;
|
40
Geo/TAF/t/1.t
Normal file
40
Geo/TAF/t/1.t
Normal file
@ -0,0 +1,40 @@
|
||||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl 1.t'
|
||||
|
||||
#########################
|
||||
|
||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
|
||||
use Test;
|
||||
BEGIN { plan tests => 16 };
|
||||
|
||||
use Geo::TAF;
|
||||
ok(1); # If we made it this far, we're ok.
|
||||
|
||||
|
||||
#########################
|
||||
|
||||
# Insert your test code below, the Test::More module is use()ed here so read
|
||||
# its man page ( perldoc Test::More ) for help writing this test script.
|
||||
|
||||
|
||||
my $m;
|
||||
|
||||
ok ($m = new Geo::TAF);
|
||||
ok (! $m->metar("EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M02 Q1021"));
|
||||
ok (length $m->as_string > 30);
|
||||
ok ($m->icao eq 'EGSH');
|
||||
ok ($m->day == 31);
|
||||
ok ($m->pressure == 1021);
|
||||
ok ($m->temp == 1);
|
||||
ok ($m->dewpoint == -2);
|
||||
ok ($m->wind_dir == 290);
|
||||
ok ($m->wind_speed == 10);
|
||||
ok ($m->viz_dist == 1600);
|
||||
ok ($m = new Geo::TAF);
|
||||
ok (! $m->taf("EGSH 311205Z 311322 04010KT 9999 SCT020
|
||||
TEMPO 1319 3000 SHSN BKN008 PROB30
|
||||
TEMPO 1318 0700 +SHSN VV///
|
||||
BECMG 1619 22005KT"));
|
||||
ok ($m->chunks);
|
||||
ok ($m->as_chunk_string);
|
Loading…
Reference in New Issue
Block a user