X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=Geo%2FTAF%2FTAF.pm;h=fdda68d7141275ef9e512e20079a984f2b479426;hb=42c0c882a3feb6dd2c70447066f980cc0f3d1b85;hp=a3c3f19c6ef298ea3cbe1806bf326bd60d7a8cb9;hpb=269cd9a66c7ac586373a4e8a01276dbeb5ad4637;p=spider.git diff --git a/Geo/TAF/TAF.pm b/Geo/TAF/TAF.pm index a3c3f19c..fdda68d7 100644 --- a/Geo/TAF/TAF.pm +++ b/Geo/TAF/TAF.pm @@ -13,7 +13,7 @@ use 5.005; use strict; use vars qw($VERSION); -$VERSION = '1.01'; +$VERSION = '1.03'; my %err = ( @@ -196,7 +196,7 @@ sub decode # 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); @@ -247,7 +247,7 @@ sub decode # 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); @@ -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)$/) { - # 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; } - + # 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; @@ -287,7 +286,8 @@ sub decode # 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'; @@ -315,7 +315,8 @@ sub decode # 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; @@ -383,11 +384,10 @@ sub _time 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; } @@ -419,18 +419,21 @@ sub as_string 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); @@ -438,7 +441,7 @@ use vars qw(@ISA); 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; @@ -448,7 +451,7 @@ use vars qw(@ISA); 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", - 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)", - CB => 'thunderstorms', + CB => 'thunder clouds', 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]%"; - $out .= " $self->[1] till $self->[2]" if defined $self->[1]; + $out .= " $self->[1] to $self->[2]" if defined $self->[1]; return $out; } @@ -666,7 +669,7 @@ sub as_string { my $self = shift; my $out = "temporarily"; - $out .= " $self->[0] till $self->[1]" if defined $self->[0]; + $out .= " $self->[0] to $self->[1]" if defined $self->[0]; return $out; } @@ -679,7 +682,7 @@ sub as_string { my $self = shift; my $out = "becoming"; - $out .= " $self->[0] till $self->[1]" if defined $self->[0]; + $out .= " $self->[0] to $self->[1]" if defined $self->[0]; 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 -translation to other langauages. +translation to other langauages. =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:- - Cnew(chunk_package =E 'Geo::TAF::ES');> + my $t = Geo::TAF->new(chunk_package => 'Geo::TAF::ES'); or whatever takes your fancy. @@ -865,7 +868,9 @@ as an array. Returns a list of (as default) C objects. You can use C<$c-Eas_string> or C<$c-Eas_chunk> to -translate the internal form into something readable. +translate the internal form into something readable. There +is also a routine (C<$c-Eday>)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 method. @@ -977,7 +982,7 @@ L For a example of a weather forecast from the Norwich Weather Centre (EGSH) see L -For data see +For data see L L and also L