From 42c0c882a3feb6dd2c70447066f980cc0f3d1b85 Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 3 Feb 2003 17:26:34 +0000 Subject: [PATCH] changed BKN for SCT detail changes to TAF.pm and scgi_weather.pl --- Geo/TAF/Changes | 6 ++++ Geo/TAF/README | 2 -- Geo/TAF/TAF.pm | 53 ++++++++++++++++++++++----------- Geo/TAF/example/scgi_weather.pl | 23 ++++---------- Geo/TAF/t/1.t | 25 +++++++++++++++- 5 files changed, 70 insertions(+), 39 deletions(-) diff --git a/Geo/TAF/Changes b/Geo/TAF/Changes index 861714f7..f5471442 100644 --- a/Geo/TAF/Changes +++ b/Geo/TAF/Changes @@ -7,3 +7,9 @@ Revision history for Perl extension Geo::TAF. 1.02 Mon Feb 3 01:28:00 2003 - fixed some uninitialised data errors in TAF.pm - included example scgi_weather.pl + +1.03 Mon Feb 3 17:00:00 2003 + - swapped BKN with SCT + - added dayend function in Geo::TAF::EN + - detail changes to example/scgi_weather.pl + - added some tests diff --git a/Geo/TAF/README b/Geo/TAF/README index 15cabdeb..a12b490d 100644 --- a/Geo/TAF/README +++ b/Geo/TAF/README @@ -27,8 +27,6 @@ DEPENDENCIES COPYRIGHT AND LICENCE -Put the correct copyright and licence information here. - Copyright (C) 2003 Dirk Koopman G1TLH This library is free software; you can redistribute it and/or modify diff --git a/Geo/TAF/TAF.pm b/Geo/TAF/TAF.pm index 04f3ddd0..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.02'; +$VERSION = '1.03'; my %err = ( @@ -286,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'; @@ -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,6 +419,21 @@ sub as_string return join ' ', ucfirst $n, map {defined $_ ? $_ : ()} @$self; } +sub day +{ + 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); @@ -426,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; @@ -436,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]); } @@ -490,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', @@ -642,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; } @@ -654,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; } @@ -667,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; } @@ -770,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 @@ -784,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. @@ -853,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. @@ -965,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 diff --git a/Geo/TAF/example/scgi_weather.pl b/Geo/TAF/example/scgi_weather.pl index ddb2e605..7453a328 100755 --- a/Geo/TAF/example/scgi_weather.pl +++ b/Geo/TAF/example/scgi_weather.pl @@ -58,8 +58,8 @@ my %st = ( VV => 'vert. viz', SKC => "no cloud", CLR => "no cloud no sig wthr", - SCT => "5-7okt", - BKN => "3-4okt", + BKN => "5-7okt", + SCT => "3-4okt", FEW => "0-2okt", OVC => "8okt", CAVOK => "CAVOK(no cloud >10Km viz no sig wthr)", @@ -261,35 +261,22 @@ sub error exit(0); } -sub _dayend -{ - my $d = sprintf "%d", shift; - if ($d =~ /1$/) { - return "${d}st"; - } elsif ($d =~ /2$/) { - return "${d}nd"; - } elsif ($d =~ /3$/) { - return "${d}rd"; - } - return "${d}th"; -} - sub tafHEAD { my @in = @{$_[0]}; - return "FORECAST Issued $in[3] " . _dayend($in[2]); + return "FORECAST Issued $in[3] on " . Geo::TAF::EN::_dayend($in[2]); } sub metarHEAD { my @in = @{$_[0]}; - return "CURRENT Issued $in[3] " . _dayend($in[2]); + return "CURRENT Issued $in[3] on " . Geo::TAF::EN::_dayend($in[2]); } sub VALID { my @in = @{$_[0]}; - return "Valid $in[1]-\>$in[2] " . _dayend($in[0]); + return "Valid $in[1]-\>$in[2] on " . Geo::TAF::EN::_dayend($in[0]); } sub WIND diff --git a/Geo/TAF/t/1.t b/Geo/TAF/t/1.t index ca5230cd..c54f63d5 100644 --- a/Geo/TAF/t/1.t +++ b/Geo/TAF/t/1.t @@ -6,12 +6,35 @@ # change 'tests => 1' to 'tests => last_test_to_print'; use Test; -BEGIN { plan tests => 1 }; +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); -- 2.43.0