changed BKN for SCT

detail changes to TAF.pm and scgi_weather.pl

diff --git a/Geo/TAF/Changes b/Geo/TAF/Changes
index 861714f7f6ce345ee91355052ccc799833265d51..f5471442e58a79a0aa4768316a007e106b04209c 100644 (file)
--- 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 15cabdeb31cfd82e17eeb6bb258679f7eedf6314..a12b490d19799b46a3c37cbc9fc8af9f80fe1896 100644 (file)
--- 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 04f3ddd006bf86c0ec50ff825c65b8ede1b104bf..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);
 
-$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:-
  
-  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.
 
@@ -853,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 
-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.
@@ -965,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 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/>
 

diff --git a/Geo/TAF/example/scgi_weather.pl b/Geo/TAF/example/scgi_weather.pl
index ddb2e6058c6a8aac524971461ecc88276bba1f6c..7453a3289308fd9a1cc7532b8ca172f6fba2fcc5 100755 (executable)
--- 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 ca5230cd87e924693dc95f6990151f151652aecb..c54f63d5b962242e6abfb136e17f1bb79b8cd6f7 100644 (file)
--- 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);