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