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.05';
  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                 NSD     => 1,
  31                 'BLU+'  => 1,
  32                 BLU             => 1,
  33                 WHT     => 1,
  34                 GRN     => 1,
  35                 YLO     => 1,
  36                 YLO1    => 1,
  37                 YLO2    => 1,
  38                 AMB     => 1,
  39                 RED     => 1,
  40                 BKN     => 1,
  41                 NIL     => 1,
  42                 '///'   => 1,
  43                 );
  44
  45 my %ignore = (
  46                 'AUTO' => 1, # Automatic weather system in usage
  47                 'COR'  => 1, # Correction issued (US)
  48                 'CCA'  => 1, # Correction issued (EU)
  49                 );
  50
  51 # Preloaded methods go here.
  52
  53 sub new
  54 {
  55         my $pkg = shift;
  56         my $self = bless {@_}, $pkg;
  57         $self->{chunk_package} ||= "Geo::TAF::EN";
  58         return $self;
  59 }
  60
  61 sub metar
  62 {
  63         my $self = shift;
  64         my $l = shift;
  65         return 2 unless length $l > 10;
  66         $l = 'METAR ' . $l unless $l =~ /^\s*(?:METAR|TAF|SPECI)\s/i;
  67         return $self->decode($l);
  68 }
  69
  70 sub taf
  71 {
  72         my $self = shift;
  73         my $l = shift;
  74         return 2 unless length $l > 10;
  75         $l = 'TAF ' . $l unless $l =~ /^\s*(?:METAR|TAF|SPECI)\s/i;
  76         return $self->decode($l);
  77 }
  78
  79 sub speci
  80 {
  81         my $self = shift;
  82         my $l = shift;
  83         return 2 unless length $l > 10;
  84         $l = 'SPECI ' . $l unless $l =~ /^\s*(?:METAR|TAF|SPECI)\s/i;
  85         return $self->decode($l);
  86 }
  87
  88 sub as_string
  89 {
  90         my $self = shift;
  91         return join ' ', $self->as_strings;
  92 }
  93
  94 sub as_strings
  95 {
  96         my $self = shift;
  97         my @out;
  98         for (@{$self->{chunks}}) {
  99                 next if $_->type =~ m/^Geo::TAF::[A-Z]+::IGNORE$/;
 100                 push @out, $_->as_string;
 101         }
 102         return @out;
 103 }
 104
 105 sub chunks
 106 {
 107         my $self = shift;
 108         return exists $self->{chunks} ? @{$self->{chunks}} : ();
 109 }
 110
 111 sub as_chunk_strings
 112 {
 113         my $self = shift;
 114         my @out;
 115
 116         for (@{$self->{chunks}}) {
 117                 push @out, $_->as_chunk;
 118         }
 119         return @out;
 120 }
 121
 122 sub as_chunk_string
 123 {
 124         my $self = shift;
 125         return join ' ', $self->as_chunk_strings;
 126 }
 127
 128 sub raw
 129 {
 130         return shift->{line};
 131 }
 132
 133 sub is_weather
 134 {
 135         return $_[0] =~ /^\s*(?:(?:METAR|TAF|SPECI)\s+)?[A-Z]{4}\s+\d{6}Z?\s+/;
 136 }
 137
 138 sub errorp
 139 {
 140         my $self = shift;
 141         my $code = shift;
 142         return $err{"$code"};
 143 }
 144
 145 # basically all metars and tafs are the same, except that a metar is short
 146 # and a taf can have many repeated sections for different times of the day
 147 sub decode
 148 {
 149         my $self = shift;
 150         my $l = uc shift;
 151
 152         $l =~ s/=$//;
 153
 154         my @tok = split /\s+/, $l;
 155
 156         $self->{line} = join ' ', @tok;
 157
 158         # Count how many problems we have
 159         $self->{decode_failures} = 0;
 160
 161         # do we explicitly have a METAR, SPECI or TAF
 162         my $t = shift @tok;
 163         if ($t =~ /^(TAF|METAR|SPECI)$/) {
 164                 $self->{report_type} = $t;
 165                 $self->{taf} = $t eq 'TAF';
 166         } else {
 167             return 4;
 168         }
 169
 170         # next token is the ICAO dseignator
 171         $t = shift @tok;
 172         if ($t =~ /^[A-Z]{4}$/) {
 173                 $self->{icao} = $t;
 174         } else {
 175                 return 1;
 176         }
 177
 178         # next token is an issue time
 179         $t = shift @tok;
 180         if (my ($day, $time) = $t =~ /^(\d\d)(\d{4})Z?$/) {
 181                 $self->{day} = $day;
 182                 $self->{time} = _time($time);
 183         } else {
 184                 return 3;
 185         }
 186
 187         # if it is a TAF then expect a validity (may be missing)
 188         if ($self->{taf}) {
 189                 if (my ($vd, $vfrom, $vto) = $tok[0] =~ /^(\d\d)(\d\d)(\d\d)$/) {
 190                         $self->{valid_day} = $vd;
 191                         $self->{valid_from} = _time($vfrom * 100);
 192                         $self->{valid_to} = _time($vto * 100);
 193                         shift @tok;
 194                 }
 195         }
 196
 197         # we are now into the 'list' of things that can repeat over and over
 198
 199         my @chunk = (
 200                                  $self->_chunk('HEAD', $self->{report_type},
 201                                                            $self->{icao}, $self->{day}, $self->{time}),
 202                                  $self->_chunk('BLOCK'), # new block always now
 203                                 );
 204
 205         if($self->{valid_day}) {
 206                 push @chunk, $self->_chunk('VALID');
 207                 push @chunk, $self->_chunk('PERIOD', $self->{valid_from}, $self->{valid_to}, $self->{valid_day}, );
 208                 push @chunk, $self->_chunk('BLOCK'); # new block always now
 209         }
 210
 211         my ($c0, $c1, $expect, @remark_buffer, $ignore_no_length_change);
 212         my ($day, $time, $percent, $sort, $dir);
 213         my ($wdir, $spd, $gust, $unit);
 214         my ($viz, $vunit);
 215         my ($m, $p);
 216
 217         while (@tok) {
 218                 $t = shift @tok;
 219                 # Count number of items in chunk, and use to determine if we could not
 220                 # decode.
 221                 $c0 = $#chunk;
 222                 # If this is NOT set, and the count doesn't change, we failed a decode
 223                 $ignore_no_length_change = 0;
 224
 225                 # This is just so the rest patches easier
 226                 if(!defined($t)) {
 227
 228                 # temporary
 229                 } elsif ($t eq 'TEMPO' || $t eq 'TEMP0' || $t eq 'BECMG') {
 230                         # TEMPO occurs with both a oh and a zero, in some bad automated hardware
 231                         $t = 'TEMPO' if $t eq 'TEMP0';
 232                         push @chunk, $self->_chunk('BLOCK'); # new block always now
 233                         push @chunk, $self->_chunk($t);
 234                         $expect = 'PERIOD';
 235
 236                 # time range
 237                 } elsif ($expect eq 'PERIOD' || $t =~ /^(\d\d)(\d\d)\/(\d\d)(\d\d)$/) {
 238                         undef $expect;
 239                         # next token may be a period if it is a taf
 240                         # Two possible formats:
 241                         # XXYY = hour XX to hour YY (but only valid after TEMPO/BECMG)
 242                         # AABB/CCDD = day aa hour bb TO day cc hour dd (after TEMPO/BECMG, but ALSO valid after HEAD)
 243                         my ($from_time, $to_time, $from_day, $to_day);
 244                         my ($got_time, $got_day);
 245                         if (($from_time, $to_time) = $t =~ /^(\d\d)(\d\d)$/) {
 246                                 $got_time = 1;
 247                         } elsif (($from_day, $from_time, $to_day, $to_time) = $t =~ /^(\d\d)(\d\d)\/(\d\d)(\d\d)$/) {
 248                                 $got_time = $got_day = 1;
 249                         }
 250                         if ($got_time && $self->{taf} && $from_time >= 0 && $from_time <= 24 && $to_time >= 0 && $to_time <= 24) {
 251                                 $from_time = _time($from_time * 100);
 252                                 $to_time = _time($to_time * 100);
 253                         } else {
 254                                 undef $from_time;
 255                                 undef $to_time;
 256                                 undef $got_time;
 257                         }
 258                         if($got_time && $got_day && $from_day >= 1 && $from_day <= 31 && $to_day >= 1 && $to_day <= 31) {
 259                                 # do not shift tok, we did it already
 260                         } else {
 261                                 undef $from_day;
 262                                 undef $to_day;
 263                                 undef $got_day;
 264                         }
 265                         push @chunk, $self->_chunk('PERIOD', $from_time, $to_time, $from_day, $to_day) if $got_time;
 266
 267                 # ignore
 268                 } elsif ($ignore{$t}) {
 269                         push @chunk, $self->_chunk('IGNORE', $t);
 270
 271                 # no sig weather
 272                 } elsif ($t eq 'NOSIG' || $t eq 'NSW') {
 273                         push @chunk, $self->_chunk('WEATHER', 'NOSIG');
 274
 275                 # // means the automated system cannot determine the precipiation at all
 276                 } elsif ($t eq '//') {
 277                         push @chunk, $self->_chunk('WEATHER', $t);
 278
 279                 # specific broken on its own
 280                 } elsif ($t eq 'BKN') {
 281                         push @chunk, $self->_chunk('WEATHER', $t);
 282
 283                 # wind shear (is followed by a runway designation)
 284                 } elsif ($t eq 'WS') {
 285                         push @chunk, $self->_chunk('WEATHER', $t);
 286
 287                 # other 3 letter codes
 288                 } elsif ($clt{$t}) {
 289                         push @chunk, $self->_chunk('CLOUD', $t);
 290
 291                 # EU CAVOK viz > 10000m, no cloud, no significant weather
 292                 } elsif ($t eq 'CAVOK') {
 293                         $self->{viz_dist} ||= ">10000";
 294                         $self->{viz_units} ||= 'm';
 295                         push @chunk, $self->_chunk('CLOUD', 'CAVOK');
 296
 297                 # RMK group (end for now)
 298                 } elsif ($t eq 'RMK' or $t eq 'RKM') {
 299                         #push @chunk, $self->_chunk('RMK', join(' ',@tok));
 300                         $self->{in_remark} = $c0;
 301                         push @chunk, $self->_chunk('BLOCK'); # new block always now
 302                         #last;
 303
 304                 # from
 305                 } elsif (($day,$time) = $t =~ /^FM(\d\d)?(\d\d\d\d)Z?$/ ) {
 306                         push @chunk, $self->_chunk('BLOCK'); # new block always now
 307                         push @chunk, $self->_chunk('FROM', _time($time), $day);
 308
 309                 # Until
 310                 } elsif (($day,$time) = $t =~ /^TL(\d\d)?(\d\d\d\d)Z?$/ ) {
 311                         push @chunk, $self->_chunk('BLOCK'); # new block always now
 312                         push @chunk, $self->_chunk('TIL', _time($time), $day);
 313
 314                 # At
 315                 # Seen at http://stoivane.iki.fi/metar/
 316                 } elsif (($day,$time) = $t =~ /^AT(\d\d)?(\d\d\d\d)Z?$/ ) {
 317                         push @chunk, $self->_chunk('BLOCK'); # new block always now
 318                         push @chunk, $self->_chunk('AT', _time($time), $day);
 319
 320                 # probability
 321                 } elsif (($percent) = $t =~ /^PROB(\d\d)$/ ) {
 322                         push @chunk, $self->_chunk('BLOCK'); # new block always now
 323                         $expect = 'PERIOD';
 324                         push @chunk, $self->_chunk('PROB', $percent);
 325
 326                 # runway
 327                 } elsif (($sort, $dir) = $t =~ /^(RWY?|LDG|TKOF|R)(\d\d\d?[RLC]?)$/ ) {
 328                         # Special case,
 329                         # there is a some broken METAR hardware out there that codes:
 330                         # 'RWY01 /0100VP2000N'
 331                         # TODO: include the full regex here
 332                         if($tok[0] =~ /^\/[MP]?\d{4}/) {
 333                                 $t .= shift @tok;
 334                                 unshift @tok, $t
 335                         }
 336                         push @chunk, $self->_chunk('RWY', $sort, $dir);
 337
 338                 # runway, but as seen in wind shear
 339                 # eg: LDG RWY25L
 340                 } elsif (($sort) = $t =~ /^(LDG|TKOF)$/ ) {
 341                         my $t2;
 342                         $t2 = shift @tok;
 343                         ($dir) = $t2 =~ /^RWY(\d\d[RLC]?)$/;
 344                         push @chunk, $self->_chunk('RWY', $sort, $dir);
 345
 346                 # a wind group
 347                 } elsif (($wdir, $spd, $gust, $unit) = $t =~ /^([\dO]{3}|VRB|\/{3})([\dO]{2}|\/{2})(?:G([\dO]{2,3}))?(KTS?|MPH|MPS|KMH)$/) {
 348                         my ($fromdir, $todir);
 349
 350                         # More hardware suck, oh vs. zero
 351                         $wdir =~ s/O/0/g if $wdir;
 352                         $spd  =~ s/O/0/g if $spd;
 353                         $gust =~ s/O/0/g if $gust;
 354
 355                         # it could be variable so look at the next token
 356                         if      (@tok && (($fromdir, $todir) = $tok[0] =~ /^([\dO]{3})V([\dO]{3})$/)) {
 357                                 shift @tok;
 358                                 $fromdir =~ s/O/0/g;
 359                                 $todir =~ s/O/0/g;
 360                         }
 361
 362                         # Part of the hardware is bad
 363                         $wdir = 'NA' if $wdir eq '///';
 364                         $spd = 'NA' if $spd eq '//';
 365
 366                         $spd = 0 + $spd unless $spd eq 'NA';
 367                         $gust = 0 + $gust if defined $gust;
 368                         $unit = 'kt' if $unit eq 'KTS';
 369                         $unit = ucfirst lc $unit;
 370                         $unit = 'm/sec' if $unit eq 'Mps';
 371                         $self->{wind_dir} ||= $wdir;
 372                         $self->{wind_speed} ||= $spd;
 373                         $self->{wind_gusting} ||= $gust;
 374                         $self->{wind_units} ||= $unit;
 375                         push @chunk, $self->_chunk('WIND', $wdir, $spd, $gust, $unit, $fromdir, $todir);
 376
 377                 # wind not reported
 378                 # MHRO does not seem to follow this rule.
 379                 } elsif ($t =~ /^\/{5}$/) {
 380                         if($self->{icao} eq 'MHRO') {
 381                                 ; # TODO: We will do something here once we figure what MHRO uses this field for
 382                                 push @chunk, $self->_chunk('IGNORE', $t);
 383                         } else {
 384                                 push @chunk, $self->_chunk('WIND', 'NR', undef, undef, undef, undef, undef);
 385                         }
 386
 387                 # pressure
 388                 } elsif (my ($u, $p, $punit) = $t =~ /^([QA])(?:NH)?(\d{4}|\/{4}|)(INS?)?$/) {
 389
 390                         $p = 'NA' if $p eq '////';
 391                         $p = 'NA' if $p eq '' or !defined($p);
 392                         $p = 0.0 + $p unless $p eq 'NA';
 393                         if ($u eq 'A' || $punit && $punit =~ /^I/) {
 394                                 $p = sprintf("%.2f", $p / 100.0) unless $p eq 'NA';
 395                                 $u = 'in';
 396                         } else {
 397                                 $u = 'hPa';
 398                         }
 399                         $self->{pressure} ||= $p;
 400                         $self->{pressure_units} ||= $u;
 401                         push @chunk, $self->_chunk('PRESS', $p, $u);
 402
 403                 # viz group in metres
 404                 # May be \d{4}NDV per http://www.caa.co.uk/docs/33/CAP746.PDF
 405                 # //// = unknown
 406                 # strictly before the remark section. After RMK plain numbers mean other things.
 407                 } elsif (!defined $self->{in_remark} and ($viz, $dir) = $t =~ m/^(\d\d\d\d|\/{4})([NSEW]{1,2}|NDV)?$/) {
 408                         if($viz eq '////') {
 409                                 $viz = 'NA';
 410                         } else {
 411                                 $viz = $viz eq '9999' ? ">10000" : 0 + $viz;
 412                         }
 413                         $self->{viz_dist} ||= $viz;
 414                         $self->{viz_units} ||= 'm';
 415                         $dir = undef if $dir && $dir eq 'NDV';
 416                         push @chunk, $self->_chunk('VIZ', $viz, 'm', $dir);
 417                         #push @chunk, $self->_chunk('WEATHER', $mist) if $mist;
 418
 419                 # viz group in integral KM, feet, M
 420                 } elsif (($viz, $vunit) = $t =~ m/^(\d+|\/{1,3})(KM|FT|M)$/) {
 421                         if($viz =~ /^\/+$/) {
 422                                 $viz = 'NA';
 423                         } else {
 424                                 $viz = $viz eq '9999' ? ">10000" : 0 + $viz;
 425                         }
 426                         $vunit = lc $vunit;
 427                         $self->{viz_dist} ||= $viz;
 428                         $self->{viz_units} ||= $vunit;
 429                         push @chunk, $self->_chunk('VIZ', $viz, $vunit);
 430
 431                 # viz group in miles and faction of a mile with space between
 432                 } elsif (my ($m) = $t =~ m/^(\d)$/) {
 433                         if (@tok && (($viz) = $tok[0] =~ m/^(\d\/\d)SM$/)) {
 434                                 shift @tok;
 435                                 $viz = "$m $viz";
 436                                 $self->{viz_dist} ||= $viz;
 437                                 $self->{viz_units} ||= 'miles';
 438                                 push @chunk, $self->_chunk('VIZ', $viz, 'miles');
 439                         }
 440
 441                 # viz group in miles (either in miles or under a mile)
 442                 } elsif (my ($lt, $viz) = $t =~ m/^(M|P)?(\d+(:?\/\d)?|\/{1,3})SM$/) {
 443                         if($viz =~ /^\/+$/) {
 444                                 $viz = 'NA';
 445                         }
 446                         $viz = '<' . $viz if $lt eq 'M';
 447                         $viz = '>' . $viz if $lt eq 'P';
 448                         $self->{viz_dist} ||= $viz;
 449                         $self->{viz_units} ||= 'Stat. Miles';
 450                         push @chunk, $self->_chunk('VIZ', $viz, 'miles');
 451
 452                 # Runway deposits state per ICAO
 453                 # 8 digits
 454                 # (DR,DR),ER,CR,(eR,eR),(BR,BR)
 455                 # "ER,CR,eR,eR" == CLRD when previous deposits are removed
 456                 # Also an alternate form, xxyzCLRD.
 457                 } elsif (my ($rwy, $type, $extent, $depth, $braking) = $t =~ m/^(\d\d)(\d|\/|C)(\d|\/|L)(\d\d|\/\/|RD|CL)(\d\d|\/\/|RD)$/) {
 458                         # Runway desginator
 459                         if($rwy == 99) {
 460                                 $rwy = 'LAST';
 461                         } elsif($rwy == 88) {
 462                                 $rwy = 'ALL';
 463                         } elsif($rwy >= 50) {
 464                                 $rwy = ($rwy-50).'R';
 465                         } else {
 466                                 $rwy = $rwy.'L';
 467                         }
 468
 469                         # Type
 470                         # Not processed here
 471
 472                         # Extent
 473                         # Not processed here
 474
 475                         # Depth
 476                         if($depth eq 'RD' or $depth eq 'CL') {
 477                                 # Previous contaminination cleared
 478                                 $type = 'CLRD';
 479                                 $extent = undef;
 480                                 $depth = undef;
 481                                 $braking = undef if $braking eq 'RD';
 482                         } elsif($depth eq '//') {
 483                                 ; # pass-thru
 484                         } elsif($depth == 0) {
 485                                 $depth = '<1mm';
 486                         } elsif($depth <= 90) {
 487                                 $depth .= 'mm';
 488                         } elsif($depth == 91) {
 489                                 # BAD!
 490                         } elsif($depth >= 92 && $depth <= 97) {
 491                                 # 92 = 10cm ... 97 = 35cm
 492                                 $depth = sprintf('%dcm', (($depth - 90) * 5));
 493                         } elsif($depth == 99) {
 494                                 $depth = '>40cm';
 495                         } elsif($depth == 99) {
 496                                 $extent = 'CVRD';
 497                                 $depth = 'NR';
 498                         }
 499
 500                         # Friction / Breaking action
 501                         if(defined($braking) && $braking < 91) {
 502                                 $braking = sprintf('%.2f', $braking/100.0);
 503                         } # Other codes are handling in the print
 504
 505                         push @chunk, $self->_chunk('DEP', $rwy, $type, $extent, $depth, $braking);
 506
 507                 # runway visual range
 508                 } elsif (my ($rw, $rlt, $range, $vlt, $var, $runit, $tend) = $t =~ m/^R(\d\d\d?[LRC]?)\/([MP])?(\d\d\d\d?)(?:V([MP])?(\d\d\d\d?))?((?:FT)\/?)?([UND])?$/) {
 509                         $runit = 'm' unless defined($runit) && length($runit) > 0;
 510                         $runit = lc $runit;
 511                         $range = "<$range" if $rlt && $rlt eq 'M';
 512                         $range = ">$range" if $rlt && $rlt eq 'P';
 513                         $var = "<$var" if $vlt && $vlt eq 'M';
 514                         $var = ">$var" if $vlt && $vlt eq 'P';
 515                         push @chunk, $self->_chunk('RVR', $rw, $range, $var, $runit, $tend);
 516
 517                 # weather
 518                 } elsif (not defined $self->{in_remark} && my ($deg, $w) = $t =~ /^(\+|\-)?([A-Z][A-Z]{1,6})$/) {
 519                         push @chunk, $self->_chunk('WEATHER', $deg, $w =~ /([A-Z][A-Z])/g);
 520                 # cloud and stuff
 521                 # /// is the TCU column means that the automated system is unable to detect it
 522                 } elsif (my ($amt, $height, $cb) = $t =~ m/^(FEW|SCT|BKN|OVC|SKC|CLR|VV|\/{3})(\d\d\d|\/{3})(CB|TCU|CBMAM|ACC|CLD|\/\/\/)?$/) {
 523                         push @chunk, $self->_chunk('CLOUD', $amt, $height eq '///' ? 0 : $height * 100, $cb);
 524
 525                 # temp / dew point
 526                 } elsif (my ($ms, $temp, $n, $d) = $t =~ m/^(M)?(\d\d)\/(M)?(\d\d)?$/) {
 527                         $temp = 0 + $temp;
 528                         $d = 0 + $d;
 529                         $temp = -$temp if defined $ms;
 530                         $d = -$d if defined $d && defined $n;
 531                         $self->{temp} ||= $temp;
 532                         $self->{dewpoint} ||= $d;
 533                         push @chunk, $self->_chunk('TEMP', $temp, $d);
 534
 535                 # Remark section containing exact cloud type + okta number
 536                 # cloud type codes in Geo::TAF::EN::CLOUD
 537                 # example: CI1AC1TCU4 = Cirrus 1/8, Altocumulus 1/8, Towering Cumulus 4/8
 538                 # example: SN2SC1SC3SC2
 539                 } elsif (my $ct = $t =~ m/^((?:CI|CS|CC|AS|AC|ACC|ST|NS|SC|SF|SN|CF|CU|TCU|CB)\d)+$/) {
 540                         foreach my $ct (split m/((?:CI|CS|CC|AS|AC|ACC|ST|NS|SC|SF|SN|CF|CU|TCU|CB)\d)/, $t) {
 541                                 chomp $ct;
 542                                 next if(length($ct) == 0);
 543                                 $t = $ct;
 544                                 $ct =~ s/\d+$//;
 545                                 $t =~ s/^$ct//;
 546                                 push @chunk, $self->_chunk('CLOUD', $t, $ct)
 547                         }
 548
 549                 # pressure equivilent @ sea level
 550                 } elsif (($p) = $t =~ /^SLP(\d\d\d)$/) {
 551                         $p = 0+$p;
 552                         $p = sprintf '%.1f', 1000+$p/10.0;
 553                         push @chunk, $self->_chunk('SLP', $p, 'hPa');
 554
 555                 # station type
 556                 } elsif (defined $self->{in_remark} && ($type) = $t =~ /^AO(1|2)$/) {
 557                         $type = ($type == '1' ? '-' : '+').'PRECIP';
 558                         push @chunk, $self->_chunk('STATION_TYPE', $type);
 559
 560                 # US NWS:
 561                 # Hourly Precipitation Amount (P)
 562                 # 3- and 6-Hour Precipitation Amount (3, 6)
 563                 # 24-Hour Precipitation Amount (7)
 564                 #
 565                 # The specification says 4 digits after the type code, but some stations only have 3:
 566                 # CXKA 011100Z AUTO 35002KT M28/M31 RMK AO1 3010 SLP219 T12761306 50023
 567                 # ^^^ 0.1 inches in the 3 hour period
 568                 #
 569                 # KW22 011135Z AUTO 23016G23KT 10SM BKN029 OVC036 02/M02 A2988 RMK A02 P000
 570                 # ^^^ 0.0 inches in the last hour
 571                 } elsif (defined $self->{in_remark} && my ($precip_period, $precip) = $t =~ /^(3|6|7|P)(\d{3,4})$/) {
 572                         $precip_period = 24 if $precip_period eq '7';
 573                         $precip_period = 1 if $precip_period eq 'P';
 574                         push @chunk, $self->_chunk('PRECIP', $precip, $precip_period);
 575
 576                 # other remarks go to a text buffer for now
 577                 #} elsif (defined $self->{in_remark} && length($t) > 0) {
 578                 } elsif (defined $self->{in_remark}) {
 579                         print "Adding to remark buffer: $t\n";
 580                         push @remark_buffer, $t;
 581                         $ignore_no_length_change = 1;
 582
 583                 #X#} elsif (1) {
 584                 #X#     print "Debug marker: $t\n";
 585                 #X#     $ignore_no_length_change = 1;
 586
 587                 } elsif(0) {
 588
 589
 590                 # End of processing
 591                 }
 592
 593                 $c1 = $#chunk;
 594                 if($c0 == $c1 && $ignore_no_length_change == 0) {
 595                         push @chunk, $self->_chunk('RMK','Failed to decode: '.$t);
 596                         $self->{decode_failures}++;
 597                 }
 598         }
 599
 600         if (@remark_buffer) {
 601                 push @chunk, $self->_chunk('BLOCK') unless ($c0 == $c1);
 602                 push @chunk, $self->_chunk('RMK', join(' ', @remark_buffer));
 603         }
 604         $self->{chunks} = \@chunk;
 605         return undef;
 606 }
 607
 608 sub _pkg
 609 {
 610         my $self = shift;
 611         my $pkg = shift;
 612         no strict 'refs';
 613         $pkg = $self->{chunk_package} . '::' . $pkg;
 614         return $pkg;
 615 }
 616 sub _chunk
 617 {
 618         my $self = shift;
 619         my $pkg = shift;
 620         no strict 'refs';
 621         $pkg = $self->_pkg($pkg);
 622         return $pkg->new(@_);
 623 }
 624
 625 sub _time
 626 {
 627         return sprintf "%02d:%02d", unpack "a2a2", sprintf "%04d", shift;
 628 }
 629
 630 # accessors
 631 sub AUTOLOAD
 632 {
 633         no strict;
 634         my ($package, $name) = $AUTOLOAD =~ /^(.*)::(\w+)$/;
 635         return if $name eq 'DESTROY';
 636
 637         *$AUTOLOAD = sub {return $_[0]->{$name}};
 638         goto &$AUTOLOAD;
 639 }
 640
 641 #
 642 # these are the translation packages
 643 #
 644 # First the factory method
 645 #
 646
 647 package Geo::TAF::EN;
 648 sub type { return __PACKAGE__; }
 649
 650 sub new
 651 {
 652         my $pkg = shift;
 653         return bless [@_], $pkg;
 654 }
 655
 656 sub as_chunk
 657 {
 658         my $self = shift;
 659         my ($n) = (ref $self) =~ /::(\w+)$/;
 660         return '[' . join(' ', $n, map {defined $_ ? $_ : '?'} @$self) . ']';
 661 }
 662
 663 sub as_string
 664 {
 665         my $self = shift;
 666         my ($n) = (ref $self) =~ /::(\w+)$/;
 667         return join ' ', ucfirst $n, map {defined $_ ? $_ : ()} @$self;
 668 }
 669
 670 sub day
 671 {
 672         my $pkg = shift;
 673         my $d = sprintf "%d", ref($pkg) ? shift : $pkg;
 674         if ($d =~ /1$/) {
 675                 return "${d}st";
 676         } elsif ($d =~ /2$/) {
 677                 return "${d}nd";
 678         } elsif ($d =~ /3$/) {
 679                 return "${d}rd";
 680         }
 681         return "${d}th";
 682 }
 683
 684 package Geo::TAF::EN::HEAD;
 685 use vars qw(@ISA);
 686 @ISA = qw(Geo::TAF::EN);
 687 sub type { return __PACKAGE__; }
 688
 689 sub as_string
 690 {
 691         my $self = shift;
 692         return sprintf "%s for %s issued at %s on %s", $self->[0], $self->[1], $self->[3], $self->day($self->[2]);
 693 }
 694
 695 package Geo::TAF::EN::VALID;
 696 use vars qw(@ISA);
 697 @ISA = qw(Geo::TAF::EN);
 698
 699 sub as_string
 700 {
 701         my $self = shift;
 702         return "valid";
 703         # will be followed by a PERIOD block
 704 }
 705
 706
 707 package Geo::TAF::EN::WIND;
 708 use vars qw(@ISA);
 709 @ISA = qw(Geo::TAF::EN);
 710 sub type { return __PACKAGE__; }
 711
 712 my %wst = (
 713         NA      => 'unknown',
 714         NR      => 'not reported',
 715         VRB     => 'variable',
 716 );
 717
 718 # $direction, $speed, $gusts, $unit, $fromdir, $todir
 719 sub as_string
 720 {
 721         my $self = shift;
 722         my $out;
 723         $out  = sprintf("wind %s", ($wst{$self->[0]} ? $wst{$self->[0]}: $self->[0]));
 724         $out .= sprintf(" varying between %s && %s", $self->[4], $self->[5]) if defined $self->[4];
 725         $out .= sprintf("%s at %s", ($self->[0] eq 'VRB' ? '' : " degrees"), $wst{$self->[1]} ? $wst{$self->[1]} : $self->[1]) if defined $self->[1];
 726         $out .= sprintf(" gusting %s", $self->[2]) if defined $self->[2] && $self->[1] ne 'NA';
 727         $out .= $self->[1] eq 'NA' ? ' speed' : $self->[3] if defined $self->[3];
 728         return $out;
 729 }
 730
 731 package Geo::TAF::EN::PRESS;
 732 use vars qw(@ISA);
 733 @ISA = qw(Geo::TAF::EN);
 734 sub type { return __PACKAGE__; }
 735
 736 # $pressure, $unit
 737 sub as_string
 738 {
 739         my $self = shift;
 740         return sprintf "QNH pressure not available" if $self->[0] eq 'NA';
 741         return sprintf "QNH pressure %s%s", $self->[0], $self->[1];
 742 }
 743
 744 package Geo::TAF::EN::SLP;
 745 use vars qw(@ISA);
 746 @ISA = qw(Geo::TAF::EN);
 747 sub type { return __PACKAGE__; }
 748
 749 # $pressure, $unit
 750 sub as_string
 751 {
 752         my $self = shift;
 753         return sprintf "SLP pressure not available" if $self->[0] eq 'NA';
 754         return sprintf "SLP pressure %s%s", $self->[0], $self->[1];
 755 }
 756
 757 # temperature, dewpoint
 758 package Geo::TAF::EN::TEMP;
 759 use vars qw(@ISA);
 760 @ISA = qw(Geo::TAF::EN);
 761 sub type { return __PACKAGE__; }
 762
 763 sub as_string
 764 {
 765         my $self = shift;
 766         my $out;
 767         $out  = sprintf("temperature %sC", $self->[0]);
 768         $out .= sprintf(" dewpoint %sC", $self->[1]) if defined $self->[1];
 769
 770         return $out;
 771 }
 772
 773 package Geo::TAF::EN::CLOUD;
 774 use vars qw(@ISA);
 775 @ISA = qw(Geo::TAF::EN);
 776 sub type { return __PACKAGE__; }
 777
 778 my %st = (
 779                 VV    => 'vertical visibility',
 780                 SKC   => "no cloud",
 781                 CLR   => "no cloud no significant weather",
 782                 SCT   => "3-4 oktas/scattered",
 783                 BKN   => "5-7 oktas/broken",
 784                 FEW   => "0-2 oktas/few",
 785                 OVC   => "8 oktas/overcast",
 786                 '///' => 'some',
 787 );
 788
 789 my %cloud_code = (
 790                 # Cloud codes found in remarks, followed by an okta
 791                 # same order as the SCT/BWN/FEW/OVC codes.
 792                 CI   => 'Cirrus',
 793                 CS   => 'Cirrostratus',
 794                 CC   => 'Cirrocumulus',
 795                 AS   => 'Altostratus',
 796                 AC   => 'Altocumulus',
 797                 ACC  => 'Altocumulus Castellanus',
 798                 ST   => 'Stratus',
 799                 NS   => 'Nimbostratus',
 800                 SC   => 'Stratoculumus',
 801                 SF   => 'Stratus Fractus',
 802                 CF   => 'Cumulus Fractus',
 803                 CU   => 'Cumulus',
 804                 TCU  => 'Towering Cumulus',
 805                 CB   => 'Cumulonimbus', # aka thunder clouds
 806
 807                 # not official, but seen often in Canada: METAR CYVR 262319Z 09011KT 1 1/2SM -SN FEW003 BKN006 OVC010 00/ RMK SN2SC1SC3SC2
 808                 SN   => 'Snow clouds',
 809 );
 810
 811 my %col = (
 812                 'CAVOK' => "no cloud below 5000ft >10km visibility no significant weather (CAVOK)",
 813                 'NSC'   => 'no significant cloud',
 814                 'NCD'   => "no cloud detected",
 815                 'BLU+'  => '3 oktas at >2500ft >8km visibility',
 816                 'BLU'   => '3 oktas at 2500ft 8km visibility',
 817                 'WHT'   => '3 oktas at 1500ft 5km visibility',
 818                 'GRN'   => '3 oktas at 700ft 3700m visibility',
 819                 'YLO1'  => '3 oktas at 500ft 2500m visibility',
 820                 'YLO2'  => '3 oktas at 300ft 1600m visibility',
 821                 'YLO'   => '3 oktas at 300ft 1600m visibility', # YLO2 and YLO are meant to be identical
 822                 'AMB'   => '3 oktas at 200ft 800m visibility',
 823                 'RED'   => '3 oktas at <200ft <800m visibility',
 824                 'NIL'   => 'no weather',
 825 );
 826
 827 my %st_storm = (
 828                 CB    => 'cumulonimbus',
 829                 TCU   => 'towering cumulus',
 830                 CBMAM => 'cumulonimbus mammatus',
 831                 ACC   => 'altocumulus castellatus',
 832                 CLD   => 'standing lenticular',
 833                 # if you get this, the automated sensors are unable to decide
 834                 '///' => 'unknown cumulus',
 835 );
 836
 837 # $amt, $height, $cb
 838 sub as_string
 839 {
 840         my $self = shift;
 841         return $col{$self->[0]} if @$self == 1 && $col{$self->[0]};
 842         if(@$self == 2 && (int($self->[0]) eq "$self->[0]") and defined $cloud_code{$self->[1]}) {
 843                 return sprintf "%s %d/8 cover", $cloud_code{$self->[1]}, $self->[0];
 844         }
 845         return sprintf("%s %sft", $st{$self->[0]}, $self->[1]) if $self->[0] eq 'VV';
 846         my $out = sprintf("%s cloud", $st{$self->[0]});
 847         $out .= sprintf(' at %sft', $self->[1]) if $self->[1];
 848         $out = 'unknown cloud cover' if $self->[1] == 0 && $self->[0] eq '///';
 849         $out .= sprintf(" with %s", $st_storm{$self->[2]}) if $self->[2];
 850         return $out;
 851 }
 852
 853 package Geo::TAF::EN::WEATHER;
 854 use vars qw(@ISA);
 855 @ISA = qw(Geo::TAF::EN);
 856 sub type { return __PACKAGE__; }
 857
 858 my %wt = (
 859                 '+'   => 'heavy',
 860                 '-'   => 'light',
 861                 'VC'  => 'in the vicinity',
 862
 863                 'MI'  => 'shallow',
 864                 'PI'  => 'partial',
 865                 'BC'  => 'patches of',
 866                 'DR'  => 'low drifting',
 867                 'BL'  => 'blowing',
 868                 'SH'  => 'showers',
 869                 'TS'  => 'thunderstorms containing',
 870                 'FZ'  => 'freezing',
 871                 'RE'  => 'recent',
 872
 873                 'DZ'  => 'drizzle',
 874                 'RA'  => 'rain',
 875                 'SN'  => 'snow',
 876                 'SG'  => 'snow grains',
 877                 'IC'  => 'ice crystals',
 878                 'PE'  => 'ice pellets',
 879                 'GR'  => 'hail',
 880                 'GS'  => 'small hail/snow pellets',
 881                 'UP'  => 'unknown precip',
 882                 '//'  => 'unknown weather',
 883
 884                 'BR'  => 'mist',
 885                 'FG'  => 'fog',
 886                 'FU'  => 'smoke',
 887                 'VA'  => 'volcanic ash',
 888                 'DU'  => 'dust',
 889                 'SA'  => 'sand',
 890                 'HZ'  => 'haze',
 891                 'PY'  => 'spray',
 892
 893                 'PO'  => 'dust/sand whirls',
 894                 'SQ'  => 'squalls',
 895                 'FC'  => 'tornado',
 896                 'SS'  => 'sand storm',
 897                 'DS'  => 'dust storm',
 898                 '+FC' => 'water spouts',
 899                 'WS'  => 'wind shear',
 900                 'BKN' => 'broken',
 901
 902                 'NOSIG' => 'no significant weather',
 903                 'PRFG'  => 'fog banks', # officially PR is a modifier of FG
 904                 );
 905
 906 sub as_string
 907 {
 908         my $self = shift;
 909         my @out;
 910
 911         my ($vic, $shower);
 912         my @in;
 913         push @in, @$self;
 914
 915         while (@in) {
 916                 my $t = shift @in;
 917
 918                 if (!defined $t) {
 919                         next;
 920                 } elsif ($t eq 'VC') {
 921                         $vic++;
 922                         next;
 923                 } elsif ($t eq 'SH') {
 924                         $shower++;
 925                         next;
 926                 } elsif ($t eq '+' && $self->[0] eq 'FC') {
 927                         push @out, $wt{'+FC'};
 928                         shift;
 929                         next;
 930                 }
 931
 932                 push @out, $wt{$t};
 933
 934                 if (@out && $shower) {
 935                         $shower = 0;
 936                         push @out, $wt{'SH'};
 937                 }
 938         }
 939         push @out, $wt{'VC'} if $vic;
 940
 941         return join ' ', @out;
 942 }
 943
 944 package Geo::TAF::EN::STATION_TYPE;
 945 use vars qw(@ISA);
 946 @ISA = qw(Geo::TAF::EN);
 947 sub type { return __PACKAGE__; }
 948
 949 # $code
 950 sub as_string
 951 {
 952         my $self = shift;
 953         my $code = shift;
 954         my $out = 'Automated station';
 955         if($code eq '+PRECIP') {
 956                 $out .= ' cannot detect precipitation';
 957         } elsif($code eq '-PRECIP') {
 958                 $out .= ' has precipitation discriminator';
 959         }
 960 }
 961
 962 package Geo::TAF::EN::PRECIP;
 963 use vars qw(@ISA);
 964 @ISA = qw(Geo::TAF::EN);
 965 sub type { return __PACKAGE__; }
 966
 967 # $precip, $period
 968 sub as_string
 969 {
 970         my $self = shift;
 971         my $precip = $self->[0];
 972         my $period = $self->[1];
 973         if($period == 1) {
 974                 return sprintf 'precipitation %.2f inches in last hour', $precip;
 975         } elsif($period == 24) {
 976                 return sprintf '24 hour total precipitation %.2f inches', $precip;
 977         } else {
 978                 return sprintf '%d-hour precipitation %.2f', $period, $precip;
 979         }
 980 }
 981
 982 package Geo::TAF::EN::RVR;
 983 use vars qw(@ISA);
 984 @ISA = qw(Geo::TAF::EN);
 985 sub type { return __PACKAGE__; }
 986
 987 # $rw, $range, $var, $runit, $tend;
 988 sub as_string
 989 {
 990         my $self = shift;
 991         my $out;
 992         $out  = sprintf("visual range on runway %s is %s%s", $self->[0], $self->[1], $self->[3]);
 993         $out .= sprintf(" varying to %s%s", $self->[2], $self->[3]) if defined $self->[2];
 994         if (defined $self->[4]) {
 995                 $out .= " decreasing" if $self->[4] eq 'D';
 996                 $out .= " increasing" if $self->[4] eq 'U';
 997                 $out .= " unchanged"  if $self->[4] eq 'N';
 998         }
 999         return $out;
1000 }
1001
1002 package Geo::TAF::EN::RWY;
1003 use vars qw(@ISA);
1004 @ISA = qw(Geo::TAF::EN);
1005 sub type { return __PACKAGE__; }
1006
1007 my %rwy = (
1008                   LDG => 'landing',
1009                   SKC => 'take-off',
1010                 );
1011 sub as_string
1012 {
1013         my $self = shift;
1014         my $out;
1015         if($rwy{$self->[0]}) {
1016                 $out .= $rwy{$self->[0]} . ' ';
1017         }
1018         $out .= sprintf("runway %s", $self->[1]);
1019         return $out;
1020 }
1021
1022 package Geo::TAF::EN::PROB;
1023 use vars qw(@ISA);
1024 @ISA = qw(Geo::TAF::EN);
1025 sub type { return __PACKAGE__; }
1026
1027 # $percent, $from, $to;
1028 sub as_string
1029 {
1030         my $self = shift;
1031
1032         return sprintf("probability %s%%", $self->[0]);
1033         # will be followed by a PERIOD block
1034 }
1035
1036 package Geo::TAF::EN::TEMPO;
1037 use vars qw(@ISA);
1038 @ISA = qw(Geo::TAF::EN);
1039 sub type { return __PACKAGE__; }
1040
1041 sub as_string
1042 {
1043         my $self = shift;
1044         return "temporarily";
1045         # will be followed by a PERIOD block
1046 }
1047
1048 package Geo::TAF::EN::BECMG;
1049 use vars qw(@ISA);
1050 @ISA = qw(Geo::TAF::EN);
1051 sub type { return __PACKAGE__; }
1052
1053 sub as_string
1054 {
1055         my $self = shift;
1056         return "becoming";
1057         # will be followed by a PERIOD block
1058 }
1059
1060 package Geo::TAF::EN::PERIOD;
1061 use vars qw(@ISA);
1062 @ISA = qw(Geo::TAF::EN);
1063 sub type { return __PACKAGE__; }
1064
1065 sub as_string
1066 {
1067         my $self = shift;
1068         # obj, from_time, to_time, from_day, to_day
1069         my ($out, $format);
1070         $out = 'period from ';
1071         # format 1 = time only, no date
1072         # format 2 = time, one day (or two days that are the same value)
1073         # format 3 = time and two different day
1074         $format = 1 if defined $self->[0] && defined $self->[1];
1075         if(defined $self->[2]) {
1076                 $format = 3;
1077                 $format-- if not defined $self->[3] or $self->[2] == $self->[3];
1078         }
1079         if($format == 2) {
1080                 $out .= sprintf("%s to %s on %s", $self->[0], $self->[1], $self->day($self->[2]));
1081         } elsif($format == 3) {
1082                 $out .= sprintf("%s %s to %s %s", $self->day($self->[2]), $self->[0], $self->day($self->[3]), $self->[1]);
1083         } elsif($format == 1) {
1084                 $out .= sprintf("%s to %s", $self->[0], $self->[1]);
1085         } else {
1086                 $out .= 'BAD PERIOD';
1087         }
1088
1089         return $out;
1090 }
1091
1092 package Geo::TAF::EN::VIZ;
1093 use vars qw(@ISA);
1094 @ISA = qw(Geo::TAF::EN);
1095 sub type { return __PACKAGE__; }
1096
1097 sub as_string
1098 {
1099         my $self = shift;
1100
1101         my $out = 'visibility ';
1102         return $out.'not available' if $self->[0] eq 'NA';
1103         return $out.sprintf("%s%s%s", ($self->[2] ? $self->[2].' ' : ''), $self->[0], $self->[1]);
1104 }
1105
1106 package Geo::TAF::EN::DEP;
1107 use vars qw(@ISA);
1108 @ISA = qw(Geo::TAF::EN);
1109 sub type { return __PACKAGE__; }
1110
1111 my %cover_type = (
1112                 0               => 'clear & dry',
1113                 1               => 'damp',
1114                 2               => 'wet/water patches',
1115                 3               => 'frost-covered',
1116                 4               => 'dry snow',
1117                 5               => 'wet snow',
1118                 6               => 'slush',
1119                 7               => 'ice',
1120                 8               => 'compacted snow',
1121                 9               => 'frozen ruts',
1122                 '/'             => 'unknown',
1123                 'CLRD'  => 'cleared',
1124                 );
1125
1126 my %extent = (
1127                 1               => '<10%',
1128                 2               => '11-25%',
1129                 5               => '26-50%',
1130                 9               => '51-100%',
1131                 '/'             => 'not reported',
1132                 'CVRD'  => 'non-operational',
1133                 );
1134
1135 my %depth = (
1136                 'NR' => 'not reported',
1137                 '//' => 'not significent',
1138                 );
1139
1140 my %breaking = (
1141                 95              => 'good',
1142                 94              => 'medium/good',
1143                 93              => 'medium',
1144                 92              => 'medium/poor',
1145                 91              => 'poor',
1146                 99              => 'unreliable',
1147                 '//'    => 'not reported',
1148                 );
1149
1150 # $rwy, $cover_type, $extent, $depth, $braking
1151 sub as_string
1152 {
1153         my $self = shift;
1154
1155         my $out;
1156         $out  = sprintf 'Runway %s conditions: %s', $self->[0], $cover_type{$self->[1]};
1157         if(defined($self->[2])) {
1158                 $out .= sprintf(', extent %s',$extent{$self->[2]});
1159         }
1160         if(defined($self->[3])) {
1161                 $_ = $depth{$self->[3]};
1162                 $_ = $self->[3] unless $_;
1163                 $out .= sprintf(', depth %s', $_);
1164         }
1165         if(defined($self->[4])) {
1166                 $_ = $depth{$self->[4]};
1167                 $out .= sprintf(', braking action %s', $_) if $_;
1168                 $out .= sprintf(', friction coefficient %s', $self->[4]) unless $_;
1169         }
1170         $out .= ';';
1171
1172         return $out;
1173 }
1174
1175 package Geo::TAF::EN::FROM;
1176 use vars qw(@ISA);
1177 @ISA = qw(Geo::TAF::EN);
1178 sub type { return __PACKAGE__; }
1179
1180 sub as_string
1181 {
1182         my $self = shift;
1183
1184         if($self->[1]) {
1185                 return sprintf("from %s on the %s", $self->[0],$self->day($self->[1]));
1186         } else {
1187                 return sprintf("from %s", $self->[0]);
1188         }
1189 }
1190
1191 package Geo::TAF::EN::TIL;
1192 use vars qw(@ISA);
1193 @ISA = qw(Geo::TAF::EN);
1194 sub type { return __PACKAGE__; }
1195
1196 sub as_string
1197 {
1198         my $self = shift;
1199
1200         if($self->[1]) {
1201                 return sprintf("until %s on the %s", $self->[0],$self->day($self->[1]));
1202         } else {
1203                 return sprintf("until %s", $self->[0]);
1204         }
1205 }
1206
1207 package Geo::TAF::EN::AT;
1208 use vars qw(@ISA);
1209 @ISA = qw(Geo::TAF::EN);
1210 sub type { return __PACKAGE__; }
1211
1212 sub as_string
1213 {
1214         my $self = shift;
1215
1216         if($self->[1]) {
1217                 return sprintf("at %s on the %s", $self->[0],$self->day($self->[1]));
1218         } else {
1219                 return sprintf("at %s", $self->[0]);
1220         }
1221 }
1222
1223 package Geo::TAF::EN::RMK;
1224 use vars qw(@ISA);
1225 @ISA = qw(Geo::TAF::EN);
1226 sub type { return __PACKAGE__; }
1227
1228 sub as_string
1229 {
1230         my $self = shift;
1231
1232         return sprintf("remark %s", $self->[0]);
1233 }
1234
1235 package Geo::TAF::EN::IGNORE;
1236 use vars qw(@ISA);
1237 @ISA = qw(Geo::TAF::EN);
1238 sub type { return __PACKAGE__; }
1239
1240 sub as_string
1241 {
1242         my $self = shift;
1243         return '';
1244 }
1245
1246 package Geo::TAF::EN::BLOCK;
1247 =pod
1248 =begin classdoc
1249
1250 The 'BLOCK' marker is used to explicitly indicate a new block. If producing
1251 human-readable output, this signifies that new line should be started.
1252
1253 @return nothing
1254
1255 =end classdoc
1256 =cut
1257 use vars qw(@ISA);
1258 @ISA = qw(Geo::TAF::EN);
1259 sub type { return __PACKAGE__; }
1260
1261 sub as_string
1262 {
1263         my $self = shift;
1264         return '';
1265 }
1266
1267 # Autoload methods go after =cut, and are processed by the autosplit program.
1268
1269 1;
1270 __END__
1271 # Below is stub documentation for your module. You'd better edit it!
1272
1273 =head1 NAME
1274
1275 Geo::TAF - Decode METAR and TAF strings
1276
1277 =head1 SYNOPSIS
1278
1279   use strict;
1280   use Geo::TAF;
1281
1282   my $t = new Geo::TAF;
1283
1284   $t->metar("EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
1285   or
1286   $t->taf("EGSH 311205Z 311322 04010KT 9999 SCT020
1287      TEMPO 1319 3000 SHSN BKN008 PROB30
1288      TEMPO 1318 0700 +SHSN VV///
1289      BECMG 1619 22005KT");
1290   or
1291   $t->decode("METAR EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
1292   or
1293   $t->decode("TAF EGSH 311205Z 311322 04010KT 9999 SCT020
1294      TEMPO 1319 3000 SHSN BKN008 PROB30
1295      TEMPO 1318 0700 +SHSN VV///
1296      BECMG 1619 22005KT");
1297
1298   foreach my $c ($t->chunks) {
1299           print $c->as_string, ' ';
1300   }
1301   or
1302   print $self->as_string;
1303
1304   foreach my $c ($t->chunks) {
1305           print $c->as_chunk, ' ';
1306   }
1307   or
1308   print $self->as_chunk_string;
1309
1310   my @out = $self->as_strings;
1311   my @out = $self->as_chunk_strings;
1312   my $line = $self->raw;
1313   print Geo::TAF::is_weather($line) ? 1 : 0;
1314
1315 =head1 ABSTRACT
1316
1317 Geo::TAF decodes aviation METAR and TAF weather forecast code
1318 strings into English or, if you sub-class, some other language.
1319
1320 =head1 DESCRIPTION
1321
1322 METAR (Routine Aviation weather Report) and TAF (Terminal Area
1323 weather Report) are ascii strings containing codes describing
1324 the weather at airports and weather bureaus around the world.
1325
1326 This module attempts to decode these reports into a form of
1327 English that is hopefully more understandable than the reports
1328 themselves.
1329
1330 It is possible to sub-class the translation routines to enable
1331 translation to other langauages.
1332
1333 =head1 METHODS
1334
1335 =over
1336
1337 =item new(%args)
1338
1339 Constructor for the class. Each weather announcement will need
1340 a new constructor.
1341
1342 If you sub-class the built-in English translation routines then
1343 you can pick this up by called the constructor thus:-
1344
1345   my $t = Geo::TAF->new(chunk_package => 'Geo::TAF::ES');
1346
1347 or whatever takes your fancy.
1348
1349 =item decode($line)
1350
1351 The main routine that decodes a weather string. It expects a
1352 string that begins with either the word C<METAR> or C<TAF>.
1353 It creates a decoded form of the weather string in the object.
1354
1355 There are a number of fixed fields created and also array
1356 of chunks L<chunks()> of (as default) C<Geo::TAF::EN>.
1357
1358 You can decode these manually or use one of the built-in routines.
1359
1360 This method returns undef if it is successful, a number otherwise.
1361 You can use L<errorp($r)> routine to get a stringified
1362 version.
1363
1364 =item metar($line)
1365
1366 This simply adds C<METAR> to the front of the string and calls
1367 L<decode()>.
1368
1369 =item taf($line)
1370
1371 This simply adds C<TAF> to the front of the string and calls
1372 L<decode()>.
1373
1374 It makes very little difference to the decoding process which
1375 of these routines you use. It does, however, affect the output
1376 in that it will mark it as the appropriate type of report.
1377
1378 =item as_string()
1379
1380 Returns the decoded weather report as a human readable string.
1381
1382 This is probably the simplest and most likely of the output
1383 options that you might want to use. See also L<as_strings()>.
1384
1385 =item as_strings()
1386
1387 Returns an array of strings without separators. This simply
1388 the decoded, human readable, normalised strings presented
1389 as an array.
1390
1391 =item as_chunk_string()
1392
1393 Returns a human readable version of the internal decoded,
1394 normalised form of the weather report.
1395
1396 This may be useful if you are doing something special, but
1397 see L<chunks()> or L<as_chunk_strings()> for a procedural
1398 approach to accessing the internals.
1399
1400 Although you can read the result, it is not, officially,
1401 human readable.
1402
1403 =item as_chunk_strings()
1404
1405 Returns an array of the stringified versions of the internal
1406 normalised form without separators.. This simply
1407 the decoded (English as default) normalised strings presented
1408 as an array.
1409
1410 =item chunks()
1411
1412 Returns a list of (as default) C<Geo::TAF::EN> objects. You
1413 can use C<$c-E<gt>as_string> or C<$c-E<gt>as_chunk> to
1414 translate the internal form into something readable. There
1415 is also a routine (C<$c-E<gt>day>)to turn a day number into
1416 things like "1st", "2nd" and "24th".
1417
1418 If you replace the English versions of these objects then you
1419 will need at an L<as_string()> method.
1420
1421 =item raw()
1422
1423 Returns the (cleaned up) weather report. It is cleaned up in the
1424 sense that all whitespace is reduced to exactly one space
1425 character.
1426
1427 =item errorp($r)
1428
1429 Returns a stringified version of any error returned by L<decode()>
1430
1431 =back
1432
1433 =head1 ACCESSORS
1434
1435 =over
1436
1437 =item taf()
1438
1439 Returns whether this object is a TAF or not.
1440
1441 =item icao()
1442
1443 Returns the ICAO code contained in the weather report
1444
1445 =item day()
1446
1447 Returns the day of the month of this report
1448
1449 =item time()
1450
1451 Returns the issue time of this report
1452
1453 =item valid_day()
1454
1455 Returns the day this report is valid for (if there is one).
1456
1457 =item valid_from()
1458
1459 Returns the time from which this report is valid for (if there is one).
1460
1461 =item valid_to()
1462
1463 Returns the time to which this report is valid for (if there is one).
1464
1465 =item viz_dist()
1466
1467 Returns the minimum visibility, if present.
1468
1469 =item viz_units()
1470
1471 Returns the units of the visibility information.
1472
1473 =item wind_dir()
1474
1475 Returns the wind direction in degrees, if present.
1476
1477 =item wind_speed()
1478
1479 Returns the wind speed.
1480
1481 =item wind_units()
1482
1483 Returns the units of wind_speed.
1484
1485 =item wind_gusting()
1486
1487 Returns any wind gust speed. It is possible to have L<wind_speed()>
1488 without gust information.
1489
1490 =item pressure()
1491
1492 Returns the QNH (altimeter setting atmospheric pressure), if present.
1493
1494 =item pressure_units()
1495
1496 Returns the units in which L<pressure()> is messured.
1497
1498 =item temp()
1499
1500 Returns any temperature present.
1501
1502 =item dewpoint()
1503
1504 Returns any dewpoint present.
1505
1506 =back
1507
1508 =head1 ROUTINES
1509
1510 =over
1511
1512 =item is_weather($line)
1513
1514 This is a routine that determines, fairly losely, whether the
1515 passed string is likely to be a weather report;
1516
1517 This routine is not exported. You must call it explicitly.
1518
1519 =back
1520
1521 =head1 SEE ALSO
1522
1523 L<Geo::METAR>
1524
1525 For a example of a weather forecast from the Norwich Weather
1526 Centre (EGSH) see L<http://www.tobit.co.uk>
1527
1528 For data see L<ftp://weather.noaa.gov/data/observations/metar/>
1529 L<ftp://weather.noaa.gov/data/forecasts/taf/> and also
1530 L<ftp://weather.noaa.gov/data/forecasts/shorttaf/>
1531
1532 To find an ICAO code for your local airport see
1533 L<http://www.ar-group.com/icaoiata.htm>
1534
1535 =head1 AUTHOR
1536
1537 Dirk Koopman, L<mailto:djk@tobit.co.uk>
1538 With additions/corrections by Robin H. Johnson, L<mailto:robbat2@gentoo.org>
1539
1540 =head1 COPYRIGHT AND LICENSE
1541
1542 Copyright (c) 2003 by Dirk Koopman, G1TLH
1543 Portions Copyright (C) 2009 Robin H. Johnson
1544
1545 This library is free software; you can redistribute it and/or modify
1546 it under the same terms as Perl itself.
1547
1548 =cut