Geo/TAF/TAF.pm

   1 #
   2 # A set of routine for decode TAF and METAR a bit better and more comprehensively
   3 # than some other products I tried.
   4 #
   5 # $Id$
   6 #
   7 # Copyright (c) 2003 Dirk Koopman G1TLH
   8 #
   9
  10 package Geo::TAF;
  11
  12 use 5.005;
  13 use strict;
  14 use vars qw($VERSION);
  15
  16 $VERSION = '1.04-1';
  17
  18
  19 my %err = (
  20                    '1' => "No valid ICAO designator",
  21                    '2' => "Length is less than 10 characters",
  22                    '3' => "No valid issue time",
  23                    '4' => "Expecting METAR or TAF at the beginning",
  24                   );
  25
  26 my %clt = (
  27                    SKC => 1,
  28                    CLR => 1,
  29                    NSC => 1,
  30                    BLU => 1,
  31                    WHT => 1,
  32                    GRN => 1,
  33                    YLO => 1,
  34                    AMB => 1,
  35                    RED => 1,
  36                    BKN => 1,
  37                    NIL => 1,
  38                   );
  39
  40 my %ignore = (
  41                           AUTO => 1,
  42                           COR => 1,
  43                          );
  44
  45
  46 # Preloaded methods go here.
  47
  48 sub new
  49 {
  50         my $pkg = shift;
  51         my $self = bless {@_}, $pkg;
  52         $self->{chunk_package} ||= "Geo::TAF::EN";
  53         return $self;
  54 }
  55
  56 sub metar
  57 {
  58         my $self = shift;
  59         my $l = shift;
  60         return 2 unless length $l > 10;
  61         $l = 'METAR ' . $l unless $l =~ /^\s*(?:METAR|TAF)\s/i;
  62         return $self->decode($l);
  63 }
  64
  65 sub taf
  66 {
  67         my $self = shift;
  68         my $l = shift;
  69         return 2 unless length $l > 10;
  70         $l = 'TAF ' . $l unless $l =~ /^\s*(?:METAR|TAF)\s/i;
  71         return $self->decode($l);
  72 }
  73
  74 sub as_string
  75 {
  76         my $self = shift;
  77         return join ' ', $self->as_strings;
  78 }
  79
  80 sub as_strings
  81 {
  82         my $self = shift;
  83         my @out;
  84         for (@{$self->{chunks}}) {
  85                 push @out, $_->as_string;
  86         }
  87         return @out;
  88 }
  89
  90 sub chunks
  91 {
  92         my $self = shift;
  93         return exists $self->{chunks} ? @{$self->{chunks}} : ();
  94 }
  95
  96 sub as_chunk_strings
  97 {
  98         my $self = shift;
  99         my @out;
 100
 101         for (@{$self->{chunks}}) {
 102                 push @out, $_->as_chunk;
 103         }
 104         return @out;
 105 }
 106
 107 sub as_chunk_string
 108 {
 109         my $self = shift;
 110         return join ' ', $self->as_chunk_strings;
 111 }
 112
 113 sub raw
 114 {
 115         return shift->{line};
 116 }
 117
 118 sub is_weather
 119 {
 120         return $_[0] =~ /^\s*(?:(?:METAR|TAF)\s+)?[A-Z]{4}\s+\d{6}Z?\s+/;
 121 }
 122
 123 sub errorp
 124 {
 125         my $self = shift;
 126         my $code = shift;
 127         return $err{"$code"};
 128 }
 129
 130 # basically all metars and tafs are the same, except that a metar is short
 131 # and a taf can have many repeated sections for different times of the day
 132 sub decode
 133 {
 134         my $self = shift;
 135         my $l = uc shift;
 136
 137         $l =~ s/=$//;
 138
 139     # Fix dodgy TAFs.
 140     # TAFs like this are non-standard, but I have seen these examples in
 141     # real life, and that is, after all, what this code needs to cope with. [DW]
 142     $l =~ s/\b(BECMG)(\d{4})\b/$1 $2/g; # Some people can't use a space bar
 143     $l =~ s/\bTEMP0\b/TEMPO/g;          # Some people use zero instead of a letter O
 144     $l =~ s/\bBEC\b/BECMG/g;            # And some people can't spell BECMG
 145
 146         my @tok = split /\s+/, $l;
 147
 148         $self->{line} = join ' ', @tok;
 149
 150         # do we explicitly have a METAR or a TAF
 151         my $t = shift @tok;
 152         if ($t eq 'TAF') {
 153                 $self->{taf} = 1;
 154         } elsif ($t eq 'METAR') {
 155                 $self->{taf} = 0;
 156         } else {
 157             return 4;
 158         }
 159
 160         # next token is the ICAO dseignator
 161         $t = shift @tok;
 162     # ignore AMD (amendment) token if present.
 163     $t = shift @tok if $t eq 'AMD';
 164
 165         if ($t =~ /^[A-Z]{4}$/) {
 166                 $self->{icao} = $t;
 167         } else {
 168                 return 1;
 169         }
 170
 171         # next token is an issue time
 172         $t = shift @tok;
 173     # ignore AMD (amendment) token if present.
 174     $t = shift @tok if $t eq 'AMD';
 175
 176         if (my ($day, $time) = $t =~ /^(\d\d)(\d{4})Z?$/) {
 177                 $self->{day} = $day;
 178                 $self->{time} = _time($time);
 179         } else {
 180                 return 3;
 181         }
 182
 183         # if it is a TAF then expect a validity (may be missing)
 184         if ($self->{taf}) {
 185                 if (my ($vd, $vfrom, $vto) = $tok[0] =~ /^(\d\d)(\d\d)(\d\d)$/) {
 186                         $self->{valid_day} = $vd;
 187                         $self->{valid_from} = _time($vfrom * 100);
 188                         $self->{valid_to} = _time($vto * 100);
 189                         shift @tok;
 190                 }
 191         }
 192
 193         # we are now into the 'list' of things that can repeat over and over
 194
 195         my @chunk = (
 196                                  $self->_chunk('HEAD', $self->{taf} ? 'TAF' : 'METAR',
 197                                                            $self->{icao}, $self->{day}, $self->{time})
 198                                 );
 199
 200         push @chunk, $self->_chunk('VALID', $self->{valid_day}, $self->{valid_from},
 201                                                            $self->{valid_to}) if $self->{valid_day};
 202
 203         while (@tok) {
 204                 $t = shift @tok;
 205
 206                 # temporary
 207                 if ($t eq 'TEMPO' || $t eq 'BECMG') {
 208
 209                         # next token may be a time if it is a taf
 210                         my ($from, $to);
 211                         if (@tok && (($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/)) {
 212                                 if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
 213                                         shift @tok;
 214                                         $from = _time($from * 100);
 215                                         $to = _time($to * 100);
 216                                 } else {
 217                                         undef $from;
 218                                         undef $to;
 219                                 }
 220                         }
 221                         push @chunk, $self->_chunk($t, $from, $to);
 222
 223                 # ignore
 224                 } elsif ($ignore{$t}) {
 225                         ;
 226
 227         # no sig weather
 228                 } elsif ($t eq 'NOSIG' || $t eq 'NSW') {
 229                         push @chunk, $self->_chunk('WEATHER', 'NOSIG');
 230
 231                 # specific broken on its own
 232                 } elsif ($t eq 'BKN') {
 233                         push @chunk, $self->_chunk('WEATHER', $t);
 234
 235         # other 3 letter codes
 236                 } elsif ($clt{$t}) {
 237                         push @chunk, $self->_chunk('CLOUD', $t);
 238
 239                 # EU CAVOK viz > 10000m, no cloud, no significant weather
 240                 } elsif ($t eq 'CAVOK') {
 241                         $self->{viz_dist} ||= ">10000";
 242                         $self->{viz_units} ||= 'm';
 243                         push @chunk, $self->_chunk('CLOUD', 'CAVOK');
 244
 245         # AMD group (end for now)
 246         } elsif ($t eq 'AMD') {
 247             last;
 248
 249         # RMK group (end for now)
 250                 } elsif ($t eq 'RMK') {
 251                         last;
 252
 253         # from
 254         } elsif (my ($time) = $t =~ /^FM(\d\d\d?\d?)Z?$/ ) {
 255             $time .= '0' while length($time) < 4;
 256                         push @chunk, $self->_chunk('FROM', _time($time));
 257
 258         # Until
 259         } elsif (($time) = $t =~ /^TI?LL?(\d\d\d?\d?)Z?$/ ) {
 260             $time .= '0' while length($time) < 4;
 261                         push @chunk, $self->_chunk('TIL', _time($time));
 262
 263         # probability
 264         } elsif (my ($percent) = $t =~ /^PROB(\d\d)$/ ) {
 265
 266                         # next token may be a time if it is a taf
 267                         my ($from, $to);
 268                         if (@tok && (($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/)) {
 269                                 if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
 270                                         shift @tok;
 271                                         $from = _time($from * 100);
 272                                         $to = _time($to * 100);
 273                                 } else {
 274                                         undef $from;
 275                                         undef $to;
 276                                 }
 277                         }
 278                         push @chunk, $self->_chunk('PROB', $percent, $from, $to);
 279
 280         # runway
 281         } elsif (my ($sort, $dir) = $t =~ /^(RWY?|LDG)(\d\d[RLC]?)$/ ) {
 282                         push @chunk, $self->_chunk('RWY', $sort, $dir);
 283
 284                 # a wind group
 285                 } elsif (my ($wdir, $spd, $gust, $unit) = $t =~ /^(\d\d\d|VRB)(\d\d)(?:G(\d\d))?(KT|MPH|MPS|KMH)$/) {
 286
 287                         my ($fromdir, $todir);
 288
 289                         if      (@tok && (($fromdir, $todir) = $tok[0] =~ /^(\d\d\d)V(\d\d\d)$/)) {
 290                                 shift @tok;
 291                         }
 292
 293                         # it could be variable so look at the next token
 294
 295                         $spd = 0 + $spd;
 296                         $gust = 0 + $gust if defined $gust;
 297                         $unit = ucfirst lc $unit;
 298                         $unit = 'm/sec' if $unit eq 'Mps';
 299                         $self->{wind_dir} ||= $wdir;
 300                         $self->{wind_speed} ||= $spd;
 301                         $self->{wind_gusting} ||= $gust;
 302                         $self->{wind_units} ||= $unit;
 303                         push @chunk, $self->_chunk('WIND', $wdir, $spd, $gust, $unit, $fromdir, $todir);
 304
 305                 # pressure
 306                 } elsif (my ($u, $p, $punit) = $t =~ /^([QA])(?:NH)?(\d\d\d\d)(INS?)?$/) {
 307
 308                         $p = 0 + $p;
 309                         if ($u eq 'A' || $punit && $punit =~ /^I/) {
 310                                 $p = sprintf "%.2f", $p / 100;
 311                                 $u = 'in';
 312                         } else {
 313                                 $u = 'hPa';
 314                         }
 315                         $self->{pressure} ||= $p;
 316                         $self->{pressure_units} ||= $u;
 317                         push @chunk, $self->_chunk('PRESS', $p, $u);
 318
 319                 # viz group in metres
 320                 } elsif (my ($viz, $mist) = $t =~ m!^(\d\d\d\d[NSEW]{0,2})([A-Z][A-Z])?$!) {
 321                         $viz = $viz eq '9999' ? ">10000" : 0 + $viz;
 322                         $self->{viz_dist} ||= $viz;
 323                         $self->{viz_units} ||= 'm';
 324                         push @chunk, $self->_chunk('VIZ', $viz, 'm');
 325                         push @chunk, $self->_chunk('WEATHER', $mist) if $mist;
 326
 327                 # viz group in KM
 328                 } elsif (($viz) = $t =~ m!^(\d+)KM$!) {
 329                         $viz = $viz eq '9999' ? ">10000" : 0 + $viz;
 330                         $self->{viz_dist} ||= $viz;
 331                         $self->{viz_units} ||= 'Km';
 332                         push @chunk, $self->_chunk('VIZ', $viz, 'Km');
 333
 334         # viz group in miles and fraction of a mile with space between
 335                 } elsif (my ($m) = $t =~ m!^(\d)$!) {
 336             my ($viz, $denom);
 337             if (@tok && (($viz, $denom) = $tok[0] =~ m!^(\d)/(\d)SM$!)) {
 338                                 shift @tok;
 339                 $denom ||= 1;
 340                 $viz = $m + $viz / $denom;
 341                                 $self->{viz_dist} ||= $viz;
 342                 $self->{viz_units} ||= 'Miles';
 343                 push @chunk, $self->_chunk('VIZ', $viz, 'Miles');
 344                         }
 345
 346                 # viz group in miles (either in miles or under a mile)
 347         } elsif (my ($lt, $mviz, $denom) = $t =~ m!^([MP])?(\d+)(?:/(\d))?SM$!) {
 348             $denom ||= 1;
 349             $mviz /= $denom;
 350             $mviz = '<' . $mviz if $lt and $lt eq 'M';
 351             $mviz = '>' . $mviz if $lt and $lt eq 'P';
 352                         $self->{viz_dist} ||= $mviz;
 353             $self->{viz_units} ||= 'Miles';
 354                         push @chunk, $self->_chunk('VIZ', $mviz, 'Miles');
 355
 356                 # runway visual range
 357                 } elsif (my ($rw, $rlt, $range, $vlt, $var, $runit, $tend) = $t =~ m!^R(\d\d[LRC]?)/([MP])?(\d\d\d\d)(?:V([MP])(\d\d\d\d))?(?:(FT)/?)?([UND])?$!) {
 358                         $runit = 'm' unless $runit;
 359                         $runit = lc $unit;
 360                         $range = "<$range" if $rlt && $rlt eq 'M';
 361                         $range = ">$range" if $rlt && $rlt eq 'P';
 362                         $var = "<$var" if $vlt && $vlt eq 'M';
 363                         $var = ">$var" if $vlt && $vlt eq 'P';
 364                         push @chunk, $self->_chunk('RVR', $rw, $range, $var, $runit, $tend);
 365
 366                 # weather
 367                 } elsif (my ($deg, $w) = $t =~ /^(\+|\-|VC)?([A-Z][A-Z]{1,4})$/) {
 368                         push @chunk, $self->_chunk('WEATHER', $deg, $w =~ /([A-Z][A-Z])/g);
 369
 370         # cloud and stuff
 371                 } elsif (my ($amt, $height, $cb) = $t =~ m!^(FEW|SCT|BKN|OVC|SKC|CLR|VV|///)(\d\d\d|///)(CB|TCU)?$!) {
 372                         push @chunk, $self->_chunk('CLOUD', $amt, $height eq '///' ? 0 : $height * 100, $cb) unless $amt eq '///' && $height eq '///';
 373
 374                 # temp / dew point
 375         } elsif (my ($ms, $t, $n, $d) = $t =~ m!^T?(M)?(\d\d)/(M)?(\d\dZ?)?$!) {
 376                         $t = 0 + $t;
 377                         $d = 0 + $d;
 378                         $t = -$t if defined $ms;
 379                         $d = -$d if defined $d && defined $n;
 380                         $self->{temp} ||= $t;
 381                         $self->{dewpoint} ||= $d;
 382                         push @chunk, $self->_chunk('TEMP', $t, $d);
 383                 }
 384
 385         }
 386         $self->{chunks} = \@chunk;
 387         return undef;
 388 }
 389
 390 sub _chunk
 391 {
 392         my $self = shift;
 393         my $pkg = shift;
 394         no strict 'refs';
 395         $pkg = $self->{chunk_package} . '::' . $pkg;
 396         return $pkg->new(@_);
 397 }
 398
 399 sub _time
 400 {
 401         return sprintf "%02d:%02d", unpack "a2a2", sprintf "%04d", shift;
 402 }
 403
 404 # accessors
 405 sub AUTOLOAD
 406 {
 407         no strict;
 408         my ($package, $name) = $AUTOLOAD =~ /^(.*)::(\w+)$/;
 409         return if $name eq 'DESTROY';
 410
 411         *$AUTOLOAD = sub {return $_[0]->{$name}};
 412     goto &$AUTOLOAD;
 413 }
 414
 415 #
 416 # these are the translation packages
 417 #
 418 # First the factory method
 419 #
 420
 421 package Geo::TAF::EN;
 422
 423 sub new
 424 {
 425         my $pkg = shift;
 426         return bless [@_], $pkg;
 427 }
 428
 429 sub as_chunk
 430 {
 431         my $self = shift;
 432         my ($n) = (ref $self) =~ /::(\w+)$/;
 433         return '[' . join(' ', $n, map {defined $_ ? $_ : '?'} @$self) . ']';
 434 }
 435
 436 sub as_string
 437 {
 438         my $self = shift;
 439         my ($n) = (ref $self) =~ /::(\w+)$/;
 440         return join ' ', ucfirst $n, map {defined $_ ? $_ : ()} @$self;
 441 }
 442
 443 sub day
 444 {
 445         my $pkg = shift;
 446         my $d = sprintf "%d", ref($pkg) ? shift : $pkg;
 447         if ($d =~ /1$/) {
 448                 return "${d}st";
 449         } elsif ($d =~ /2$/) {
 450                 return "${d}nd";
 451         } elsif ($d =~ /3$/) {
 452                 return "${d}rd";
 453         }
 454         return "${d}th";
 455 }
 456
 457
 458 package Geo::TAF::EN::HEAD;
 459 use vars qw(@ISA);
 460 @ISA = qw(Geo::TAF::EN);
 461
 462 sub as_string
 463 {
 464         my $self = shift;
 465         return "$self->[0] for $self->[1] issued at $self->[3] on " . $self->day($self->[2]);
 466 }
 467
 468 package Geo::TAF::EN::VALID;
 469 use vars qw(@ISA);
 470 @ISA = qw(Geo::TAF::EN);
 471
 472 sub as_string
 473 {
 474         my $self = shift;
 475         return "valid from $self->[1] to $self->[2] on " . $self->day($self->[0]);
 476 }
 477
 478
 479 package Geo::TAF::EN::WIND;
 480 use vars qw(@ISA);
 481 @ISA = qw(Geo::TAF::EN);
 482
 483 # direction, $speed, $gusts, $unit, $fromdir, $todir
 484 sub as_string
 485 {
 486         my $self = shift;
 487         my $out = "wind";
 488         $out .= $self->[0] eq 'VRB' ? " variable" : " $self->[0]";
 489     $out .= " varying between $self->[4] and $self->[5]" if defined $self->[4];
 490         $out .= ($self->[0] eq 'VRB' ? '' : " degrees") . " at $self->[1]";
 491         $out .= " gusting $self->[2]" if defined $self->[2];
 492         $out .= $self->[3];
 493         return $out;
 494 }
 495
 496 package Geo::TAF::EN::PRESS;
 497 use vars qw(@ISA);
 498 @ISA = qw(Geo::TAF::EN);
 499
 500 # $pressure, $unit
 501 sub as_string
 502 {
 503         my $self = shift;
 504         return "QNH $self->[0]$self->[1]";
 505 }
 506
 507 # temperature, dewpoint
 508 package Geo::TAF::EN::TEMP;
 509 use vars qw(@ISA);
 510 @ISA = qw(Geo::TAF::EN);
 511
 512 sub as_string
 513 {
 514         my $self = shift;
 515         my $out = "temperature $self->[0]C";
 516         $out .= " dewpoint $self->[1]C" if defined $self->[1];
 517
 518         return $out;
 519 }
 520
 521 package Geo::TAF::EN::CLOUD;
 522 use vars qw(@ISA);
 523 @ISA = qw(Geo::TAF::EN);
 524
 525 my %st = (
 526                   VV => 'vertical visibility',
 527                   SKC => "no cloud",
 528                   CLR => "no cloud no significant weather",
 529                   SCT => "3-4 oktas",
 530                   BKN => "5-7 oktas",
 531                   FEW => "0-2 oktas",
 532                   OVC => "8 oktas overcast",
 533                   CAVOK => "no cloud below 5000ft >10Km visibility no significant weather (CAVOK)",
 534                   CB => 'thunder clouds',
 535           TCU => 'towering cumulus',
 536                   NSC => 'no significant cloud',
 537                   BLU => '3 oktas at 2500ft 8Km visibility',
 538                   WHT => '3 oktas at 1500ft 5Km visibility',
 539                   GRN => '3 oktas at 700ft 3700m visibility',
 540                   YLO => '3 oktas at 300ft 1600m visibility',
 541                   AMB => '3 oktas at 200ft 800m visibility',
 542                   RED => '3 oktas at <200ft <800m visibility',
 543                   NIL => 'no weather',
 544                   '///' => 'some',
 545                  );
 546
 547 sub as_string
 548 {
 549         my $self = shift;
 550         return $st{$self->[0]} if @$self == 1;
 551         return $st{$self->[0]} . " $self->[1]ft" if $self->[0] eq 'VV';
 552         return $st{$self->[0]} . " cloud at $self->[1]ft" . ((defined $self->[2]) ? " with $st{$self->[2]}" : "");
 553 }
 554
 555 package Geo::TAF::EN::WEATHER;
 556 use vars qw(@ISA);
 557 @ISA = qw(Geo::TAF::EN);
 558
 559 my %wt = (
 560                   '+' => 'heavy',
 561           '-' => 'light',
 562           'VC' => 'in the vicinity',
 563
 564                   MI => 'shallow',
 565                   PI => 'partial',
 566                   BC => 'patches of',
 567                   DR => 'low drifting',
 568                   BL => 'blowing',
 569                   SH => 'showers',
 570                   TS => 'thunderstorms containing',
 571                   FZ => 'freezing',
 572                   RE => 'recent',
 573
 574                   DZ => 'drizzle',
 575                   RA => 'rain',
 576                   SN => 'snow',
 577                   SG => 'snow grains',
 578                   IC => 'ice crystals',
 579                   PE => 'ice pellets',
 580                   GR => 'hail',
 581                   GS => 'small hail/snow pellets',
 582                   UP => 'unknown precip',
 583
 584                   BR => 'mist',
 585                   FG => 'fog',
 586                   FU => 'smoke',
 587                   VA => 'volcanic ash',
 588                   DU => 'dust',
 589                   SA => 'sand',
 590                   HZ => 'haze',
 591                   PY => 'spray',
 592
 593                   PO => 'dust/sand whirls',
 594                   SQ => 'squalls',
 595                   FC => 'tornado',
 596                   SS => 'sand storm',
 597                   DS => 'dust storm',
 598                   '+FC' => 'water spouts',
 599                   WS => 'wind shear',
 600                   'BKN' => 'broken',
 601
 602                   'NOSIG' => 'no significant weather',
 603
 604                  );
 605
 606 sub as_string
 607 {
 608         my $self = shift;
 609         my @out;
 610
 611         my ($vic, $shower);
 612         my @in;
 613         push @in, @$self;
 614
 615         while (@in) {
 616                 my $t = shift @in;
 617
 618                 if (!defined $t) {
 619                         next;
 620                 } elsif ($t eq 'VC') {
 621                         $vic++;
 622                         next;
 623                 } elsif ($t eq 'SH') {
 624                         $shower++;
 625                         next;
 626                 } elsif ($t eq '+' && $self->[0] eq 'FC') {
 627                         push @out, $wt{'+FC'};
 628                         shift;
 629                         next;
 630                 }
 631
 632                 push @out, $wt{$t};
 633
 634                 if (@out && $shower) {
 635                         $shower = 0;
 636                         push @out, $wt{'SH'};
 637                 }
 638         }
 639         push @out, $wt{'VC'} if $vic;
 640
 641         return join ' ', @out;
 642 }
 643
 644 package Geo::TAF::EN::RVR;
 645 use vars qw(@ISA);
 646 @ISA = qw(Geo::TAF::EN);
 647
 648 sub as_string
 649 {
 650         my $self = shift;
 651         my $out = "visual range on runway $self->[0] is $self->[1]$self->[3]";
 652         $out .= " varying to $self->[2]$self->[3]" if defined $self->[2];
 653         if (defined $self->[4]) {
 654                 $out .= " decreasing" if $self->[4] eq 'D';
 655                 $out .= " increasing" if $self->[4] eq 'U';
 656         }
 657         return $out;
 658 }
 659
 660 package Geo::TAF::EN::RWY;
 661 use vars qw(@ISA);
 662 @ISA = qw(Geo::TAF::EN);
 663
 664 sub as_string
 665 {
 666         my $self = shift;
 667         my $out = $self->[0] eq 'LDG' ? "landing " : '';
 668         $out .= "runway $self->[1]";
 669         return $out;
 670 }
 671
 672 package Geo::TAF::EN::PROB;
 673 use vars qw(@ISA);
 674 @ISA = qw(Geo::TAF::EN);
 675
 676 sub as_string
 677 {
 678         my $self = shift;
 679
 680         my $out = "probability $self->[0]%";
 681         $out .= " $self->[1] to $self->[2]" if defined $self->[1];
 682         return $out;
 683 }
 684
 685 package Geo::TAF::EN::TEMPO;
 686 use vars qw(@ISA);
 687 @ISA = qw(Geo::TAF::EN);
 688
 689 sub as_string
 690 {
 691         my $self = shift;
 692         my $out = "temporarily";
 693         $out .= " $self->[0] to $self->[1]" if defined $self->[0];
 694
 695         return $out;
 696 }
 697
 698 package Geo::TAF::EN::BECMG;
 699 use vars qw(@ISA);
 700 @ISA = qw(Geo::TAF::EN);
 701
 702 sub as_string
 703 {
 704         my $self = shift;
 705         my $out = "becoming";
 706         $out .= " $self->[0] to $self->[1]" if defined $self->[0];
 707
 708         return $out;
 709 }
 710
 711 package Geo::TAF::EN::VIZ;
 712 use vars qw(@ISA);
 713 @ISA = qw(Geo::TAF::EN);
 714
 715 sub as_string
 716 {
 717     my $self = shift;
 718
 719     return "visibility $self->[0]$self->[1]";
 720 }
 721
 722 package Geo::TAF::EN::FROM;
 723 use vars qw(@ISA);
 724 @ISA = qw(Geo::TAF::EN);
 725
 726 sub as_string
 727 {
 728     my $self = shift;
 729
 730     return "from $self->[0]";
 731 }
 732
 733 package Geo::TAF::EN::TIL;
 734 use vars qw(@ISA);
 735 @ISA = qw(Geo::TAF::EN);
 736
 737 sub as_string
 738 {
 739     my $self = shift;
 740
 741     return "until $self->[0]";
 742 }
 743
 744 # Autoload methods go after =cut, and are processed by the autosplit program.
 745
 746 1;
 747 __END__
 748 # Below is stub documentation for your module. You'd better edit it!
 749
 750 =head1 NAME
 751
 752 Geo::TAF - Decode METAR and TAF strings
 753
 754 =head1 SYNOPSIS
 755
 756   use strict;
 757   use Geo::TAF;
 758
 759   my $t = new Geo::TAF;
 760
 761   $t->metar("EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
 762   or
 763   $t->taf("EGSH 311205Z 311322 04010KT 9999 SCT020
 764      TEMPO 1319 3000 SHSN BKN008 PROB30
 765      TEMPO 1318 0700 +SHSN VV///
 766      BECMG 1619 22005KT");
 767   or
 768   $t->decode("METAR EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
 769   or
 770   $t->decode("TAF EGSH 311205Z 311322 04010KT 9999 SCT020
 771      TEMPO 1319 3000 SHSN BKN008 PROB30
 772      TEMPO 1318 0700 +SHSN VV///
 773      BECMG 1619 22005KT");
 774
 775   foreach my $c ($t->chunks) {
 776           print $c->as_string, ' ';
 777   }
 778   or
 779   print $self->as_string;
 780
 781   foreach my $c ($t->chunks) {
 782           print $c->as_chunk, ' ';
 783   }
 784   or
 785   print $self->as_chunk_string;
 786
 787   my @out = $self->as_strings;
 788   my @out = $self->as_chunk_strings;
 789   my $line = $self->raw;
 790   print Geo::TAF::is_weather($line) ? 1 : 0;
 791
 792 =head1 ABSTRACT
 793
 794 Geo::TAF decodes aviation METAR and TAF weather forecast code
 795 strings into English or, if you sub-class, some other language.
 796
 797 =head1 DESCRIPTION
 798
 799 METAR (Routine Aviation weather Report) and TAF (Terminal Area
 800 weather Report) are ascii strings containing codes describing
 801 the weather at airports and weather bureaus around the world.
 802
 803 This module attempts to decode these reports into a form of
 804 English that is hopefully more understandable than the reports
 805 themselves.
 806
 807 It is possible to sub-class the translation routines to enable
 808 translation to other langauages.
 809
 810 =head1 METHODS
 811
 812 =over
 813
 814 =item new(%args)
 815
 816 Constructor for the class. Each weather announcement will need
 817 a new constructor.
 818
 819 If you sub-class the built-in English translation routines then
 820 you can pick this up by called the constructor thus:-
 821
 822   my $t = Geo::TAF->new(chunk_package => 'Geo::TAF::ES');
 823
 824 or whatever takes your fancy.
 825
 826 =item decode($line)
 827
 828 The main routine that decodes a weather string. It expects a
 829 string that begins with either the word C<METAR> or C<TAF>.
 830 It creates a decoded form of the weather string in the object.
 831
 832 There are a number of fixed fields created and also array
 833 of chunks L<chunks()> of (as default) C<Geo::TAF::EN>.
 834
 835 You can decode these manually or use one of the built-in routines.
 836
 837 This method returns undef if it is successful, a number otherwise.
 838 You can use L<errorp($r)> routine to get a stringified
 839 version.
 840
 841 =item metar($line)
 842
 843 This simply adds C<METAR> to the front of the string and calls
 844 L<decode()>.
 845
 846 =item taf($line)
 847
 848 This simply adds C<TAF> to the front of the string and calls
 849 L<decode()>.
 850
 851 It makes very little difference to the decoding process which
 852 of these routines you use. It does, however, affect the output
 853 in that it will mark it as the appropriate type of report.
 854
 855 =item as_string()
 856
 857 Returns the decoded weather report as a human readable string.
 858
 859 This is probably the simplest and most likely of the output
 860 options that you might want to use. See also L<as_strings()>.
 861
 862 =item as_strings()
 863
 864 Returns an array of strings without separators. This simply
 865 the decoded, human readable, normalised strings presented
 866 as an array.
 867
 868 =item as_chunk_string()
 869
 870 Returns a human readable version of the internal decoded,
 871 normalised form of the weather report.
 872
 873 This may be useful if you are doing something special, but
 874 see L<chunks()> or L<as_chunk_strings()> for a procedural
 875 approach to accessing the internals.
 876
 877 Although you can read the result, it is not, officially,
 878 human readable.
 879
 880 =item as_chunk_strings()
 881
 882 Returns an array of the stringified versions of the internal
 883 normalised form without separators.. This simply
 884 the decoded (English as default) normalised strings presented
 885 as an array.
 886
 887 =item chunks()
 888
 889 Returns a list of (as default) C<Geo::TAF::EN> objects. You
 890 can use C<$c-E<gt>as_string> or C<$c-E<gt>as_chunk> to
 891 translate the internal form into something readable. There
 892 is also a routine (C<$c-E<gt>day>)to turn a day number into
 893 things like "1st", "2nd" and "24th".
 894
 895 If you replace the English versions of these objects then you
 896 will need at an L<as_string()> method.
 897
 898 =item raw()
 899
 900 Returns the (cleaned up) weather report. It is cleaned up in the
 901 sense that all whitespace is reduced to exactly one space
 902 character.
 903
 904 =item errorp($r)
 905
 906 Returns a stringified version of any error returned by L<decode()>
 907
 908 =back
 909
 910 =head1 ACCESSORS
 911
 912 =over
 913
 914 =item taf()
 915
 916 Returns whether this object is a taf or not.
 917
 918 =item icao()
 919
 920 Returns the ICAO code contained in the weather report
 921
 922 =item day()
 923
 924 Returns the day of the month of this report
 925
 926 =item time()
 927
 928 Returns the issue time of this report
 929
 930 =item valid_day()
 931
 932 Returns the day this report is valid for (if there is one).
 933
 934 =item valid_from()
 935
 936 Returns the time from which this report is valid for (if there is one).
 937
 938 =item valid_to()
 939
 940 Returns the time to which this report is valid for (if there is one).
 941
 942 =item viz_dist()
 943
 944 Returns the minimum visibility, if present.
 945
 946 =item viz_units()
 947
 948 Returns the units of the visibility information.
 949
 950 =item wind_dir()
 951
 952 Returns the wind direction in degrees, if present.
 953
 954 =item wind_speed()
 955
 956 Returns the wind speed.
 957
 958 =item wind_units()
 959
 960 Returns the units of wind_speed.
 961
 962 =item wind_gusting()
 963
 964 Returns any wind gust speed. It is possible to have L<wind_speed()>
 965 without gust information.
 966
 967 =item pressure()
 968
 969 Returns the QNH (altimeter setting atmospheric pressure), if present.
 970
 971 =item pressure_units()
 972
 973 Returns the units in which L<pressure()> is messured.
 974
 975 =item temp()
 976
 977 Returns any temperature present.
 978
 979 =item dewpoint()
 980
 981 Returns any dewpoint present.
 982
 983 =back
 984
 985 =head1 ROUTINES
 986
 987 =over
 988
 989 =item is_weather($line)
 990
 991 This is a routine that determines, fairly losely, whether the
 992 passed string is likely to be a weather report;
 993
 994 This routine is not exported. You must call it explicitly.
 995
 996 =back
 997
 998 =head1 SEE ALSO
 999
1000 L<Geo::METAR>
1001
1002 For a example of a weather forecast from the Norwich Weather
1003 Centre (EGSH) see L<http://www.tobit.co.uk>
1004
1005 For data see L<ftp://weather.noaa.gov/data/observations/metar/>
1006 L<ftp://weather.noaa.gov/data/forecasts/taf/> and also
1007 L<ftp://weather.noaa.gov/data/forecasts/shorttaf/>
1008
1009 To find an ICAO code for your local airport see
1010 L<http://www.ar-group.com/icaoiata.htm>
1011
1012 =head1 AUTHOR
1013
1014 Dirk Koopman, L<mailto:djk@tobit.co.uk>
1015
1016 =head1 COPYRIGHT AND LICENSE
1017
1018 Copyright (c) 2003 by Dirk Koopman, G1TLH
1019
1020 This library is free software; you can redistribute it and/or modify
1021 it under the same terms as Perl itself.
1022
1023 =cut