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