2 # A set of routine for decode TAF and METAR a bit better and more comprehensively
3 # than some other products I tried.
7 # Copyright (c) 2003 Dirk Koopman G1TLH
14 use vars qw($VERSION);
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",
46 'AUTO' => 1, # Automatic weather system in usage
47 'COR' => 1, # Correction issued (US)
48 'CCA' => 1, # Correction issued (EU)
51 # Preloaded methods go here.
56 my $self = bless {@_}, $pkg;
57 $self->{chunk_package} ||= "Geo::TAF::EN";
65 return 2 unless length $l > 10;
66 $l = 'METAR ' . $l unless $l =~ /^\s*(?:METAR|TAF|SPECI)\s/i;
67 return $self->decode($l);
74 return 2 unless length $l > 10;
75 $l = 'TAF ' . $l unless $l =~ /^\s*(?:METAR|TAF|SPECI)\s/i;
76 return $self->decode($l);
83 return 2 unless length $l > 10;
84 $l = 'SPECI ' . $l unless $l =~ /^\s*(?:METAR|TAF|SPECI)\s/i;
85 return $self->decode($l);
91 return join ' ', $self->as_strings;
98 for (@{$self->{chunks}}) {
99 next if $_->type =~ m/^Geo::TAF::[A-Z]+::IGNORE$/;
100 push @out, $_->as_string;
108 return exists $self->{chunks} ? @{$self->{chunks}} : ();
116 for (@{$self->{chunks}}) {
117 push @out, $_->as_chunk;
125 return join ' ', $self->as_chunk_strings;
130 return shift->{line};
135 return $_[0] =~ /^\s*(?:(?:METAR|TAF|SPECI)\s+)?[A-Z]{4}\s+\d{6}Z?\s+/;
142 return $err{"$code"};
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
154 my @tok = split /\s+/, $l;
156 $self->{line} = join ' ', @tok;
158 # Count how many problems we have
159 $self->{decode_failures} = 0;
161 # do we explicitly have a METAR, SPECI or TAF
163 if ($t =~ /^(TAF|METAR|SPECI)$/) {
164 $self->{report_type} = $t;
165 $self->{taf} = $t eq 'TAF';
170 # next token is the ICAO dseignator
172 if ($t =~ /^[A-Z]{4}$/) {
178 # next token is an issue time
180 if (my ($day, $time) = $t =~ /^(\d\d)(\d{4})Z?$/) {
182 $self->{time} = _time($time);
187 # if it is a TAF then expect a validity (may be missing)
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);
197 # we are now into the 'list' of things that can repeat over and over
200 $self->_chunk('HEAD', $self->{report_type},
201 $self->{icao}, $self->{day}, $self->{time}),
202 $self->_chunk('BLOCK'), # new block always now
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
211 my ($c0, $c1, $expect, @remark_buffer, $ignore_no_length_change);
212 my ($day, $time, $percent, $sort, $dir);
213 my ($wdir, $spd, $gust, $unit);
219 # Count number of items in chunk, and use to determine if we could not
222 # If this is NOT set, and the count doesn't change, we failed a decode
223 $ignore_no_length_change = 0;
225 # This is just so the rest patches easier
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);
237 } elsif ($expect eq 'PERIOD' || $t =~ /^(\d\d)(\d\d)\/(\d\d)(\d\d)$/) {
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)$/) {
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;
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);
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
265 push @chunk, $self->_chunk('PERIOD', $from_time, $to_time, $from_day, $to_day) if $got_time;
268 } elsif ($ignore{$t}) {
269 push @chunk, $self->_chunk('IGNORE', $t);
272 } elsif ($t eq 'NOSIG' || $t eq 'NSW') {
273 push @chunk, $self->_chunk('WEATHER', 'NOSIG');
275 # // means the automated system cannot determine the precipiation at all
276 } elsif ($t eq '//') {
277 push @chunk, $self->_chunk('WEATHER', $t);
279 # specific broken on its own
280 } elsif ($t eq 'BKN') {
281 push @chunk, $self->_chunk('WEATHER', $t);
283 # wind shear (is followed by a runway designation)
284 } elsif ($t eq 'WS') {
285 push @chunk, $self->_chunk('WEATHER', $t);
287 # other 3 letter codes
289 push @chunk, $self->_chunk('CLOUD', $t);
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');
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
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);
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);
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);
321 } elsif (($percent) = $t =~ /^PROB(\d\d)$/ ) {
322 push @chunk, $self->_chunk('BLOCK'); # new block always now
324 push @chunk, $self->_chunk('PROB', $percent);
327 } elsif (($sort, $dir) = $t =~ /^(RWY?|LDG|TKOF|R)(\d\d\d?[RLC]?)$/ ) {
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}/) {
336 push @chunk, $self->_chunk('RWY', $sort, $dir);
338 # runway, but as seen in wind shear
340 } elsif (($sort) = $t =~ /^(LDG|TKOF)$/ ) {
343 ($dir) = $t2 =~ /^RWY(\d\d[RLC]?)$/;
344 push @chunk, $self->_chunk('RWY', $sort, $dir);
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);
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;
355 # it could be variable so look at the next token
356 if (@tok && (($fromdir, $todir) = $tok[0] =~ /^([\dO]{3})V([\dO]{3})$/)) {
362 # Part of the hardware is bad
363 $wdir = 'NA' if $wdir eq '///';
364 $spd = 'NA' if $spd eq '//';
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);
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);
384 push @chunk, $self->_chunk('WIND', 'NR', undef, undef, undef, undef, undef);
388 } elsif (my ($u, $p, $punit) = $t =~ /^([QA])(?:NH)?(\d{4}|\/{4}|)(INS?)?$/) {
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';
399 $self->{pressure} ||= $p;
400 $self->{pressure_units} ||= $u;
401 push @chunk, $self->_chunk('PRESS', $p, $u);
403 # viz group in metres
404 # May be \d{4}NDV per http://www.caa.co.uk/docs/33/CAP746.PDF
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)?$/) {
411 $viz = $viz eq '9999' ? ">10000" : 0 + $viz;
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;
419 # viz group in integral KM, feet, M
420 } elsif (($viz, $vunit) = $t =~ m/^(\d+|\/{1,3})(KM|FT|M)$/) {
421 if($viz =~ /^\/+$/) {
424 $viz = $viz eq '9999' ? ">10000" : 0 + $viz;
427 $self->{viz_dist} ||= $viz;
428 $self->{viz_units} ||= $vunit;
429 push @chunk, $self->_chunk('VIZ', $viz, $vunit);
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$/)) {
436 $self->{viz_dist} ||= $viz;
437 $self->{viz_units} ||= 'miles';
438 push @chunk, $self->_chunk('VIZ', $viz, 'miles');
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 =~ /^\/+$/) {
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');
452 # Runway deposits state per ICAO
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)$/) {
461 } elsif($rwy == 88) {
463 } elsif($rwy >= 50) {
464 $rwy = ($rwy-50).'R';
476 if($depth eq 'RD' or $depth eq 'CL') {
477 # Previous contaminination cleared
481 $braking = undef if $braking eq 'RD';
482 } elsif($depth eq '//') {
484 } elsif($depth == 0) {
486 } elsif($depth <= 90) {
488 } elsif($depth == 91) {
490 } elsif($depth >= 92 && $depth <= 97) {
491 # 92 = 10cm ... 97 = 35cm
492 $depth = sprintf('%dcm', (($depth - 90) * 5));
493 } elsif($depth == 99) {
495 } elsif($depth == 99) {
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
505 push @chunk, $self->_chunk('DEP', $rwy, $type, $extent, $depth, $braking);
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;
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);
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);
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);
526 } elsif (my ($ms, $temp, $n, $d) = $t =~ m/^(M)?(\d\d)\/(M)?(\d\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);
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) {
542 next if(length($ct) == 0);
546 push @chunk, $self->_chunk('CLOUD', $t, $ct)
549 # pressure equivilent @ sea level
550 } elsif (($p) = $t =~ /^SLP(\d\d\d)$/) {
552 $p = sprintf '%.1f', 1000+$p/10.0;
553 push @chunk, $self->_chunk('SLP', $p, 'hPa');
556 } elsif (defined $self->{in_remark} && ($type) = $t =~ /^AO(1|2)$/) {
557 $type = ($type == '1' ? '-' : '+').'PRECIP';
558 push @chunk, $self->_chunk('STATION_TYPE', $type);
561 # Hourly Precipitation Amount (P)
562 # 3- and 6-Hour Precipitation Amount (3, 6)
563 # 24-Hour Precipitation Amount (7)
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
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);
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;
584 #X# print "Debug marker: $t\n";
585 #X# $ignore_no_length_change = 1;
594 if($c0 == $c1 && $ignore_no_length_change == 0) {
595 push @chunk, $self->_chunk('RMK','Failed to decode: '.$t);
596 $self->{decode_failures}++;
600 if (@remark_buffer) {
601 push @chunk, $self->_chunk('BLOCK') unless ($c0 == $c1);
602 push @chunk, $self->_chunk('RMK', join(' ', @remark_buffer));
604 $self->{chunks} = \@chunk;
613 $pkg = $self->{chunk_package} . '::' . $pkg;
621 $pkg = $self->_pkg($pkg);
622 return $pkg->new(@_);
627 return sprintf "%02d:%02d", unpack "a2a2", sprintf "%04d", shift;
634 my ($package, $name) = $AUTOLOAD =~ /^(.*)::(\w+)$/;
635 return if $name eq 'DESTROY';
637 *$AUTOLOAD = sub {return $_[0]->{$name}};
642 # these are the translation packages
644 # First the factory method
647 package Geo::TAF::EN;
648 sub type { return __PACKAGE__; }
653 return bless [@_], $pkg;
659 my ($n) = (ref $self) =~ /::(\w+)$/;
660 return '[' . join(' ', $n, map {defined $_ ? $_ : '?'} @$self) . ']';
666 my ($n) = (ref $self) =~ /::(\w+)$/;
667 return join ' ', ucfirst $n, map {defined $_ ? $_ : ()} @$self;
673 my $d = sprintf "%d", ref($pkg) ? shift : $pkg;
676 } elsif ($d =~ /2$/) {
678 } elsif ($d =~ /3$/) {
684 package Geo::TAF::EN::HEAD;
686 @ISA = qw(Geo::TAF::EN);
687 sub type { return __PACKAGE__; }
692 return sprintf "%s for %s issued at %s on %s", $self->[0], $self->[1], $self->[3], $self->day($self->[2]);
695 package Geo::TAF::EN::VALID;
697 @ISA = qw(Geo::TAF::EN);
703 # will be followed by a PERIOD block
707 package Geo::TAF::EN::WIND;
709 @ISA = qw(Geo::TAF::EN);
710 sub type { return __PACKAGE__; }
714 NR => 'not reported',
718 # $direction, $speed, $gusts, $unit, $fromdir, $todir
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];
731 package Geo::TAF::EN::PRESS;
733 @ISA = qw(Geo::TAF::EN);
734 sub type { return __PACKAGE__; }
740 return sprintf "QNH pressure not available" if $self->[0] eq 'NA';
741 return sprintf "QNH pressure %s%s", $self->[0], $self->[1];
744 package Geo::TAF::EN::SLP;
746 @ISA = qw(Geo::TAF::EN);
747 sub type { return __PACKAGE__; }
753 return sprintf "SLP pressure not available" if $self->[0] eq 'NA';
754 return sprintf "SLP pressure %s%s", $self->[0], $self->[1];
757 # temperature, dewpoint
758 package Geo::TAF::EN::TEMP;
760 @ISA = qw(Geo::TAF::EN);
761 sub type { return __PACKAGE__; }
767 $out = sprintf("temperature %sC", $self->[0]);
768 $out .= sprintf(" dewpoint %sC", $self->[1]) if defined $self->[1];
773 package Geo::TAF::EN::CLOUD;
775 @ISA = qw(Geo::TAF::EN);
776 sub type { return __PACKAGE__; }
779 VV => 'vertical visibility',
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",
790 # Cloud codes found in remarks, followed by an okta
791 # same order as the SCT/BWN/FEW/OVC codes.
793 CS => 'Cirrostratus',
794 CC => 'Cirrocumulus',
797 ACC => 'Altocumulus Castellanus',
799 NS => 'Nimbostratus',
800 SC => 'Stratoculumus',
801 SF => 'Stratus Fractus',
802 CF => 'Cumulus Fractus',
804 TCU => 'Towering Cumulus',
805 CB => 'Cumulonimbus', # aka thunder clouds
807 # not official, but seen often in Canada: METAR CYVR 262319Z 09011KT 1 1/2SM -SN FEW003 BKN006 OVC010 00/ RMK SN2SC1SC3SC2
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',
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',
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];
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];
853 package Geo::TAF::EN::WEATHER;
855 @ISA = qw(Geo::TAF::EN);
856 sub type { return __PACKAGE__; }
861 'VC' => 'in the vicinity',
865 'BC' => 'patches of',
866 'DR' => 'low drifting',
869 'TS' => 'thunderstorms containing',
876 'SG' => 'snow grains',
877 'IC' => 'ice crystals',
878 'PE' => 'ice pellets',
880 'GS' => 'small hail/snow pellets',
881 'UP' => 'unknown precip',
882 '//' => 'unknown weather',
887 'VA' => 'volcanic ash',
893 'PO' => 'dust/sand whirls',
896 'SS' => 'sand storm',
897 'DS' => 'dust storm',
898 '+FC' => 'water spouts',
899 'WS' => 'wind shear',
902 'NOSIG' => 'no significant weather',
903 'PRFG' => 'fog banks', # officially PR is a modifier of FG
920 } elsif ($t eq 'VC') {
923 } elsif ($t eq 'SH') {
926 } elsif ($t eq '+' && $self->[0] eq 'FC') {
927 push @out, $wt{'+FC'};
934 if (@out && $shower) {
936 push @out, $wt{'SH'};
939 push @out, $wt{'VC'} if $vic;
941 return join ' ', @out;
944 package Geo::TAF::EN::STATION_TYPE;
946 @ISA = qw(Geo::TAF::EN);
947 sub type { return __PACKAGE__; }
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';
962 package Geo::TAF::EN::PRECIP;
964 @ISA = qw(Geo::TAF::EN);
965 sub type { return __PACKAGE__; }
971 my $precip = $self->[0];
972 my $period = $self->[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;
978 return sprintf '%d-hour precipitation %.2f', $period, $precip;
982 package Geo::TAF::EN::RVR;
984 @ISA = qw(Geo::TAF::EN);
985 sub type { return __PACKAGE__; }
987 # $rw, $range, $var, $runit, $tend;
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';
1002 package Geo::TAF::EN::RWY;
1004 @ISA = qw(Geo::TAF::EN);
1005 sub type { return __PACKAGE__; }
1015 if($rwy{$self->[0]}) {
1016 $out .= $rwy{$self->[0]} . ' ';
1018 $out .= sprintf("runway %s", $self->[1]);
1022 package Geo::TAF::EN::PROB;
1024 @ISA = qw(Geo::TAF::EN);
1025 sub type { return __PACKAGE__; }
1027 # $percent, $from, $to;
1032 return sprintf("probability %s%%", $self->[0]);
1033 # will be followed by a PERIOD block
1036 package Geo::TAF::EN::TEMPO;
1038 @ISA = qw(Geo::TAF::EN);
1039 sub type { return __PACKAGE__; }
1044 return "temporarily";
1045 # will be followed by a PERIOD block
1048 package Geo::TAF::EN::BECMG;
1050 @ISA = qw(Geo::TAF::EN);
1051 sub type { return __PACKAGE__; }
1057 # will be followed by a PERIOD block
1060 package Geo::TAF::EN::PERIOD;
1062 @ISA = qw(Geo::TAF::EN);
1063 sub type { return __PACKAGE__; }
1068 # obj, from_time, to_time, from_day, to_day
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]) {
1077 $format-- if not defined $self->[3] or $self->[2] == $self->[3];
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]);
1086 $out .= 'BAD PERIOD';
1092 package Geo::TAF::EN::VIZ;
1094 @ISA = qw(Geo::TAF::EN);
1095 sub type { return __PACKAGE__; }
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]);
1106 package Geo::TAF::EN::DEP;
1108 @ISA = qw(Geo::TAF::EN);
1109 sub type { return __PACKAGE__; }
1114 2 => 'wet/water patches',
1115 3 => 'frost-covered',
1120 8 => 'compacted snow',
1123 'CLRD' => 'cleared',
1131 '/' => 'not reported',
1132 'CVRD' => 'non-operational',
1136 'NR' => 'not reported',
1137 '//' => 'not significent',
1142 94 => 'medium/good',
1144 92 => 'medium/poor',
1147 '//' => 'not reported',
1150 # $rwy, $cover_type, $extent, $depth, $braking
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]});
1160 if(defined($self->[3])) {
1161 $_ = $depth{$self->[3]};
1162 $_ = $self->[3] unless $_;
1163 $out .= sprintf(', depth %s', $_);
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 $_;
1175 package Geo::TAF::EN::FROM;
1177 @ISA = qw(Geo::TAF::EN);
1178 sub type { return __PACKAGE__; }
1185 return sprintf("from %s on the %s", $self->[0],$self->day($self->[1]));
1187 return sprintf("from %s", $self->[0]);
1191 package Geo::TAF::EN::TIL;
1193 @ISA = qw(Geo::TAF::EN);
1194 sub type { return __PACKAGE__; }
1201 return sprintf("until %s on the %s", $self->[0],$self->day($self->[1]));
1203 return sprintf("until %s", $self->[0]);
1207 package Geo::TAF::EN::AT;
1209 @ISA = qw(Geo::TAF::EN);
1210 sub type { return __PACKAGE__; }
1217 return sprintf("at %s on the %s", $self->[0],$self->day($self->[1]));
1219 return sprintf("at %s", $self->[0]);
1223 package Geo::TAF::EN::RMK;
1225 @ISA = qw(Geo::TAF::EN);
1226 sub type { return __PACKAGE__; }
1232 return sprintf("remark %s", $self->[0]);
1235 package Geo::TAF::EN::IGNORE;
1237 @ISA = qw(Geo::TAF::EN);
1238 sub type { return __PACKAGE__; }
1246 package Geo::TAF::EN::BLOCK;
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.
1258 @ISA = qw(Geo::TAF::EN);
1259 sub type { return __PACKAGE__; }
1267 # Autoload methods go after =cut, and are processed by the autosplit program.
1271 # Below is stub documentation for your module. You'd better edit it!
1275 Geo::TAF - Decode METAR and TAF strings
1282 my $t = new Geo::TAF;
1284 $t->metar("EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
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");
1291 $t->decode("METAR EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
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");
1298 foreach my $c ($t->chunks) {
1299 print $c->as_string, ' ';
1302 print $self->as_string;
1304 foreach my $c ($t->chunks) {
1305 print $c->as_chunk, ' ';
1308 print $self->as_chunk_string;
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;
1317 Geo::TAF decodes aviation METAR and TAF weather forecast code
1318 strings into English or, if you sub-class, some other language.
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.
1326 This module attempts to decode these reports into a form of
1327 English that is hopefully more understandable than the reports
1330 It is possible to sub-class the translation routines to enable
1331 translation to other langauages.
1339 Constructor for the class. Each weather announcement will need
1342 If you sub-class the built-in English translation routines then
1343 you can pick this up by called the constructor thus:-
1345 my $t = Geo::TAF->new(chunk_package => 'Geo::TAF::ES');
1347 or whatever takes your fancy.
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.
1355 There are a number of fixed fields created and also array
1356 of chunks L<chunks()> of (as default) C<Geo::TAF::EN>.
1358 You can decode these manually or use one of the built-in routines.
1360 This method returns undef if it is successful, a number otherwise.
1361 You can use L<errorp($r)> routine to get a stringified
1366 This simply adds C<METAR> to the front of the string and calls
1371 This simply adds C<TAF> to the front of the string and calls
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.
1380 Returns the decoded weather report as a human readable string.
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()>.
1387 Returns an array of strings without separators. This simply
1388 the decoded, human readable, normalised strings presented
1391 =item as_chunk_string()
1393 Returns a human readable version of the internal decoded,
1394 normalised form of the weather report.
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.
1400 Although you can read the result, it is not, officially,
1403 =item as_chunk_strings()
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
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".
1418 If you replace the English versions of these objects then you
1419 will need at an L<as_string()> method.
1423 Returns the (cleaned up) weather report. It is cleaned up in the
1424 sense that all whitespace is reduced to exactly one space
1429 Returns a stringified version of any error returned by L<decode()>
1439 Returns whether this object is a TAF or not.
1443 Returns the ICAO code contained in the weather report
1447 Returns the day of the month of this report
1451 Returns the issue time of this report
1455 Returns the day this report is valid for (if there is one).
1459 Returns the time from which this report is valid for (if there is one).
1463 Returns the time to which this report is valid for (if there is one).
1467 Returns the minimum visibility, if present.
1471 Returns the units of the visibility information.
1475 Returns the wind direction in degrees, if present.
1479 Returns the wind speed.
1483 Returns the units of wind_speed.
1485 =item wind_gusting()
1487 Returns any wind gust speed. It is possible to have L<wind_speed()>
1488 without gust information.
1492 Returns the QNH (altimeter setting atmospheric pressure), if present.
1494 =item pressure_units()
1496 Returns the units in which L<pressure()> is messured.
1500 Returns any temperature present.
1504 Returns any dewpoint present.
1512 =item is_weather($line)
1514 This is a routine that determines, fairly losely, whether the
1515 passed string is likely to be a weather report;
1517 This routine is not exported. You must call it explicitly.
1525 For a example of a weather forecast from the Norwich Weather
1526 Centre (EGSH) see L<http://www.tobit.co.uk>
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/>
1532 To find an ICAO code for your local airport see
1533 L<http://www.ar-group.com/icaoiata.htm>
1537 Dirk Koopman, L<mailto:djk@tobit.co.uk>
1538 With additions/corrections by Robin H. Johnson, L<mailto:robbat2@gentoo.org>
1540 =head1 COPYRIGHT AND LICENSE
1542 Copyright (c) 2003 by Dirk Koopman, G1TLH
1543 Portions Copyright (C) 2009 Robin H. Johnson
1545 This library is free software; you can redistribute it and/or modify
1546 it under the same terms as Perl itself.