projects
/
spider.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
changed BKN for SCT
[spider.git]
/
Geo
/
TAF
/
TAF.pm
diff --git
a/Geo/TAF/TAF.pm
b/Geo/TAF/TAF.pm
index a3c3f19c6ef298ea3cbe1806bf326bd60d7a8cb9..fdda68d7141275ef9e512e20079a984f2b479426 100644
(file)
--- a/
Geo/TAF/TAF.pm
+++ b/
Geo/TAF/TAF.pm
@@
-13,7
+13,7
@@
use 5.005;
use strict;
use vars qw($VERSION);
use strict;
use vars qw($VERSION);
-$VERSION = '1.0
1
';
+$VERSION = '1.0
3
';
my %err = (
my %err = (
@@
-196,7
+196,7
@@
sub decode
# next token may be a time if it is a taf
my ($from, $to);
# next token may be a time if it is a taf
my ($from, $to);
- if (
($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/
) {
+ if (
@tok && (($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/)
) {
if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
shift @tok;
$from = _time($from * 100);
if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
shift @tok;
$from = _time($from * 100);
@@
-247,7
+247,7
@@
sub decode
# next token may be a time if it is a taf
my ($from, $to);
# next token may be a time if it is a taf
my ($from, $to);
- if (
($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/
) {
+ if (
@tok && (($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/)
) {
if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
shift @tok;
$from = _time($from * 100);
if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
shift @tok;
$from = _time($from * 100);
@@
-266,15
+266,14
@@
sub decode
# a wind group
} elsif (my ($wdir, $spd, $gust, $unit) = $t =~ /^(\d\d\d|VRB)(\d\d)(?:G(\d\d))?(KT|MPH|MPS|KMH)$/) {
# a wind group
} elsif (my ($wdir, $spd, $gust, $unit) = $t =~ /^(\d\d\d|VRB)(\d\d)(?:G(\d\d))?(KT|MPH|MPS|KMH)$/) {
- # the next word might be 'AUTO'
- if ($tok[0] eq 'AUTO') {
+ my ($fromdir, $todir);
+
+ if (@tok && (($fromdir, $todir) = $tok[0] =~ /^(\d\d\d)V(\d\d\d)$/)) {
shift @tok;
}
shift @tok;
}
-
+
# it could be variable so look at the next token
# it could be variable so look at the next token
- my ($fromdir, $todir) = $tok[0] =~ /^(\d\d\d)V(\d\d\d)$/;
- shift @tok if defined $fromdir;
$spd = 0 + $spd;
$gust = 0 + $gust if defined $gust;
$unit = ucfirst lc $unit;
$spd = 0 + $spd;
$gust = 0 + $gust if defined $gust;
$unit = ucfirst lc $unit;
@@
-287,7
+286,8
@@
sub decode
# pressure
} elsif (my ($u, $p, $punit) = $t =~ /^([QA])(?:NH)?(\d\d\d\d)(INS?)?$/) {
# pressure
} elsif (my ($u, $p, $punit) = $t =~ /^([QA])(?:NH)?(\d\d\d\d)(INS?)?$/) {
-
+
+ $p = 0 + $p;
if ($u eq 'A' || $punit && $punit =~ /^I/) {
$p = sprintf "%.2f", $p / 100;
$u = 'in';
if ($u eq 'A' || $punit && $punit =~ /^I/) {
$p = sprintf "%.2f", $p / 100;
$u = 'in';
@@
-315,7
+315,8
@@
sub decode
# viz group in miles and faction of a mile with space between
} elsif (my ($m) = $t =~ m!^(\d)$!) {
# viz group in miles and faction of a mile with space between
} elsif (my ($m) = $t =~ m!^(\d)$!) {
- if (my ($viz) = $tok[0] =~ m!^(\d/\d)SM$!) {
+ my $viz;
+ if (@tok && (($viz) = $tok[0] =~ m!^(\d/\d)SM$!)) {
shift @tok;
$viz = "$m $viz";
$self->{viz_dist} ||= $viz;
shift @tok;
$viz = "$m $viz";
$self->{viz_dist} ||= $viz;
@@
-383,11
+384,10
@@
sub _time
sub AUTOLOAD
{
no strict;
sub AUTOLOAD
{
no strict;
- my $name = $AUTOLOAD;
- return if $name =~ /::DESTROY$/;
- $name =~ s/^.*:://o;
+ my ($package, $name) = $AUTOLOAD =~ /^(.*)::(\w+)$/;
+ return if $name eq 'DESTROY';
- *$AUTOLOAD = sub { $_[0]->{$name}};
+ *$AUTOLOAD = sub {
return
$_[0]->{$name}};
goto &$AUTOLOAD;
}
goto &$AUTOLOAD;
}
@@
-419,18
+419,21
@@
sub as_string
return join ' ', ucfirst $n, map {defined $_ ? $_ : ()} @$self;
}
return join ' ', ucfirst $n, map {defined $_ ? $_ : ()} @$self;
}
-# accessors
-sub AUTOLOAD
+sub day
{
{
- no strict;
- my $name = $AUTOLOAD;
- return if $name =~ /::DESTROY$/;
- $name =~ s/^.*:://o;
-
- *$AUTOLOAD = sub { $_[0]->{$name}};
- goto &$AUTOLOAD;
+ my $pkg = shift;
+ my $d = sprintf "%d", ref($pkg) ? shift : $pkg;
+ if ($d =~ /1$/) {
+ return "${d}st";
+ } elsif ($d =~ /2$/) {
+ return "${d}nd";
+ } elsif ($d =~ /3$/) {
+ return "${d}rd";
+ }
+ return "${d}th";
}
}
+
package Geo::TAF::EN::HEAD;
use vars qw(@ISA);
@ISA = qw(Geo::TAF::EN);
package Geo::TAF::EN::HEAD;
use vars qw(@ISA);
@ISA = qw(Geo::TAF::EN);
@@
-438,7
+441,7
@@
use vars qw(@ISA);
sub as_string
{
my $self = shift;
sub as_string
{
my $self = shift;
- return "$self->[0] for $self->[1] issued
day $self->[2] at $self->[3]"
;
+ return "$self->[0] for $self->[1] issued
at $self->[3] on " . $self->day($self->[2])
;
}
package Geo::TAF::EN::VALID;
}
package Geo::TAF::EN::VALID;
@@
-448,7
+451,7
@@
use vars qw(@ISA);
sub as_string
{
my $self = shift;
sub as_string
{
my $self = shift;
- return "valid
day $self->[0] from $self->[1] till $self->[2]"
;
+ return "valid
from $self->[1] to $self->[2] on " . $self->day($self->[0])
;
}
}
@@
-502,12
+505,12
@@
my %st = (
VV => 'vertical visibility',
SKC => "no cloud",
CLR => "no cloud no significant weather",
VV => 'vertical visibility',
SKC => "no cloud",
CLR => "no cloud no significant weather",
- SCT => "
5-7
oktas",
- BKN => "
3-4
oktas",
+ SCT => "
3-4
oktas",
+ BKN => "
5-7
oktas",
FEW => "0-2 oktas",
OVC => "8 oktas overcast",
CAVOK => "no cloud below 5000ft >10Km visibility no significant weather (CAVOK)",
FEW => "0-2 oktas",
OVC => "8 oktas overcast",
CAVOK => "no cloud below 5000ft >10Km visibility no significant weather (CAVOK)",
- CB => 'thunder
storm
s',
+ CB => 'thunder
cloud
s',
TCU => 'towering cumulus',
NSC => 'no significant cloud',
BLU => '3 oktas at 2500ft 8Km visibility',
TCU => 'towering cumulus',
NSC => 'no significant cloud',
BLU => '3 oktas at 2500ft 8Km visibility',
@@
-654,7
+657,7
@@
sub as_string
my $self = shift;
my $out = "probability $self->[0]%";
my $self = shift;
my $out = "probability $self->[0]%";
- $out .= " $self->[1] t
ill
$self->[2]" if defined $self->[1];
+ $out .= " $self->[1] t
o
$self->[2]" if defined $self->[1];
return $out;
}
return $out;
}
@@
-666,7
+669,7
@@
sub as_string
{
my $self = shift;
my $out = "temporarily";
{
my $self = shift;
my $out = "temporarily";
- $out .= " $self->[0] t
ill
$self->[1]" if defined $self->[0];
+ $out .= " $self->[0] t
o
$self->[1]" if defined $self->[0];
return $out;
}
return $out;
}
@@
-679,7
+682,7
@@
sub as_string
{
my $self = shift;
my $out = "becoming";
{
my $self = shift;
my $out = "becoming";
- $out .= " $self->[0] t
ill
$self->[1]" if defined $self->[0];
+ $out .= " $self->[0] t
o
$self->[1]" if defined $self->[0];
return $out;
}
return $out;
}
@@
-782,7
+785,7
@@
English that is hopefully more understandable than the reports
themselves.
It is possible to sub-class the translation routines to enable
themselves.
It is possible to sub-class the translation routines to enable
-translation to other langauages.
+translation to other langauages.
=head1 METHODS
=head1 METHODS
@@
-796,7
+799,7
@@
a new constructor.
If you sub-class the built-in English translation routines then
you can pick this up by called the constructor thus:-
If you sub-class the built-in English translation routines then
you can pick this up by called the constructor thus:-
- C<my $t = Geo::TAF-E<gt>new(chunk_package =E<gt> 'Geo::TAF::ES');>
+ my $t = Geo::TAF->new(chunk_package => 'Geo::TAF::ES');
or whatever takes your fancy.
or whatever takes your fancy.
@@
-865,7
+868,9
@@
as an array.
Returns a list of (as default) C<Geo::TAF::EN> objects. You
can use C<$c-E<gt>as_string> or C<$c-E<gt>as_chunk> to
Returns a list of (as default) C<Geo::TAF::EN> objects. You
can use C<$c-E<gt>as_string> or C<$c-E<gt>as_chunk> to
-translate the internal form into something readable.
+translate the internal form into something readable. There
+is also a routine (C<$c-E<gt>day>)to turn a day number into
+things like "1st", "2nd" and "24th".
If you replace the English versions of these objects then you
will need at an L<as_string()> method.
If you replace the English versions of these objects then you
will need at an L<as_string()> method.
@@
-977,7
+982,7
@@
L<Geo::METAR>
For a example of a weather forecast from the Norwich Weather
Centre (EGSH) see L<http://www.tobit.co.uk>
For a example of a weather forecast from the Norwich Weather
Centre (EGSH) see L<http://www.tobit.co.uk>
-For data see <ftp://weather.noaa.gov/data/observations/metar/>
+For data see
L
<ftp://weather.noaa.gov/data/observations/metar/>
L<ftp://weather.noaa.gov/data/forecasts/taf/> and also
L<ftp://weather.noaa.gov/data/forecasts/shorttaf/>
L<ftp://weather.noaa.gov/data/forecasts/taf/> and also
L<ftp://weather.noaa.gov/data/forecasts/shorttaf/>