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 # Preloaded methods go here.
51 my $self = bless {@_}, $pkg;
52 $self->{chunk_package} ||= "Geo::TAF::EN";
60 return 2 unless length $l > 10;
61 $l = 'METAR ' . $l unless $l =~ /^\s*(?:METAR|TAF)\s/i;
62 return $self->decode($l);
69 return 2 unless length $l > 10;
70 $l = 'TAF ' . $l unless $l =~ /^\s*(?:METAR|TAF)\s/i;
71 return $self->decode($l);
77 return join ' ', $self->as_strings;
84 for (@{$self->{chunks}}) {
85 push @out, $_->as_string;
93 return exists $self->{chunks} ? @{$self->{chunks}} : ();
101 for (@{$self->{chunks}}) {
102 push @out, $_->as_chunk;
110 return join ' ', $self->as_chunk_strings;
115 return shift->{line};
120 return $_[0] =~ /^\s*(?:(?:METAR|TAF)\s+)?[A-Z]{4}\s+\d{6}Z?\s+/;
127 return $err{"$code"};
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
139 my @tok = split /\s+/, $l;
141 $self->{line} = join ' ', @tok;
144 # do we explicitly have a METAR or a TAF
148 } elsif ($t eq 'METAR') {
154 # next token is the ICAO dseignator
156 if ($t =~ /^[A-Z]{4}$/) {
162 # next token is an issue time
164 if (my ($day, $time) = $t =~ /^(\d\d)(\d{4})Z?$/) {
166 $self->{time} = _time($time);
171 # if it is a TAF then expect a validity (may be missing)
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);
181 # we are now into the 'list' of things that can repeat over and over
184 $self->_chunk('HEAD', $self->{taf} ? 'TAF' : 'METAR',
185 $self->{icao}, $self->{day}, $self->{time})
188 push @chunk, $self->_chunk('VALID', $self->{valid_day}, $self->{valid_from},
189 $self->{valid_to}) if $self->{valid_day};
195 if ($t eq 'TEMPO' || $t eq 'BECMG') {
197 # next token may be a time if it is a taf
199 if (@tok && (($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/)) {
200 if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
202 $from = _time($from * 100);
203 $to = _time($to * 100);
209 push @chunk, $self->_chunk($t, $from, $to);
212 } elsif ($ignore{$t}) {
216 } elsif ($t eq 'NOSIG' || $t eq 'NSW') {
217 push @chunk, $self->_chunk('WEATHER', 'NOSIG');
219 # specific broken on its own
220 } elsif ($t eq 'BKN') {
221 push @chunk, $self->_chunk('WEATHER', $t);
223 # other 3 letter codes
225 push @chunk, $self->_chunk('CLOUD', $t);
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');
233 # RMK group (end for now)
234 } elsif ($t eq 'RMK') {
238 } elsif (my ($time) = $t =~ /^FM(\d\d\d\d)$/ ) {
239 push @chunk, $self->_chunk('FROM', _time($time));
242 } elsif (($time) = $t =~ /^TL(\d\d\d\d)$/ ) {
243 push @chunk, $self->_chunk('TIL', _time($time));
246 } elsif (my ($percent) = $t =~ /^PROB(\d\d)$/ ) {
248 # next token may be a time if it is a taf
250 if (@tok && (($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/)) {
251 if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
253 $from = _time($from * 100);
254 $to = _time($to * 100);
260 push @chunk, $self->_chunk('PROB', $percent, $from, $to);
263 } elsif (my ($sort, $dir) = $t =~ /^(RWY?|LDG)(\d\d[RLC]?)$/ ) {
264 push @chunk, $self->_chunk('RWY', $sort, $dir);
267 } elsif (my ($wdir, $spd, $gust, $unit) = $t =~ /^(\d\d\d|VRB)(\d\d)(?:G(\d\d))?(KT|MPH|MPS|KMH)$/) {
269 my ($fromdir, $todir);
271 if (@tok && (($fromdir, $todir) = $tok[0] =~ /^(\d\d\d)V(\d\d\d)$/)) {
275 # it could be variable so look at the next token
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);
288 } elsif (my ($u, $p, $punit) = $t =~ /^([QA])(?:NH)?(\d\d\d\d)(INS?)?$/) {
291 if ($u eq 'A' || $punit && $punit =~ /^I/) {
292 $p = sprintf "%.2f", $p / 100;
297 $self->{pressure} ||= $p;
298 $self->{pressure_units} ||= $u;
299 push @chunk, $self->_chunk('PRESS', $p, $u);
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;
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');
316 # viz group in miles and faction of a mile with space between
317 } elsif (my ($m) = $t =~ m!^(\d)$!) {
319 if (@tok && (($viz) = $tok[0] =~ m!^(\d/\d)SM$!)) {
322 $self->{viz_dist} ||= $viz;
323 $self->{viz_units} ||= 'miles';
324 push @chunk, $self->_chunk('VIZ', $viz, 'miles');
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');
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;
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);
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);
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 '///';
354 } elsif (my ($ms, $t, $n, $d) = $t =~ m!^(M)?(\d\d)/(M)?(\d\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);
365 $self->{chunks} = \@chunk;
374 $pkg = $self->{chunk_package} . '::' . $pkg;
375 return $pkg->new(@_);
380 return sprintf "%02d:%02d", unpack "a2a2", sprintf "%04d", shift;
387 my ($package, $name) = $AUTOLOAD =~ /^(.*)::(\w+)$/;
388 return if $name eq 'DESTROY';
390 *$AUTOLOAD = sub {return $_[0]->{$name}};
395 # these are the translation packages
397 # First the factory method
400 package Geo::TAF::EN;
405 return bless [@_], $pkg;
411 my ($n) = (ref $self) =~ /::(\w+)$/;
412 return '[' . join(' ', $n, map {defined $_ ? $_ : '?'} @$self) . ']';
418 my ($n) = (ref $self) =~ /::(\w+)$/;
419 return join ' ', ucfirst $n, map {defined $_ ? $_ : ()} @$self;
425 my $d = sprintf "%d", ref($pkg) ? shift : $pkg;
428 } elsif ($d =~ /2$/) {
430 } elsif ($d =~ /3$/) {
437 package Geo::TAF::EN::HEAD;
439 @ISA = qw(Geo::TAF::EN);
444 return "$self->[0] for $self->[1] issued at $self->[3] on " . $self->day($self->[2]);
447 package Geo::TAF::EN::VALID;
449 @ISA = qw(Geo::TAF::EN);
454 return "valid from $self->[1] to $self->[2] on " . $self->day($self->[0]);
458 package Geo::TAF::EN::WIND;
460 @ISA = qw(Geo::TAF::EN);
462 # direction, $speed, $gusts, $unit, $fromdir, $todir
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];
475 package Geo::TAF::EN::PRESS;
477 @ISA = qw(Geo::TAF::EN);
483 return "QNH $self->[0]$self->[1]";
486 # temperature, dewpoint
487 package Geo::TAF::EN::TEMP;
489 @ISA = qw(Geo::TAF::EN);
494 my $out = "temperature $self->[0]C";
495 $out .= " dewpoint $self->[1]C" if defined $self->[1];
500 package Geo::TAF::EN::CLOUD;
502 @ISA = qw(Geo::TAF::EN);
505 VV => 'vertical visibility',
507 CLR => "no cloud no significant weather",
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',
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]}" : "");
534 package Geo::TAF::EN::WEATHER;
536 @ISA = qw(Geo::TAF::EN);
541 'VC' => 'in the vicinity',
546 DR => 'low drifting',
549 TS => 'thunderstorms containing',
557 IC => 'ice crystals',
560 GS => 'small hail/snow pellets',
561 UP => 'unknown precip',
566 VA => 'volcanic ash',
572 PO => 'dust/sand whirls',
577 '+FC' => 'water spouts',
581 'NOSIG' => 'no significant weather',
599 } elsif ($t eq 'VC') {
602 } elsif ($t eq 'SH') {
605 } elsif ($t eq '+' && $self->[0] eq 'FC') {
606 push @out, $wt{'+FC'};
613 if (@out && $shower) {
615 push @out, $wt{'SH'};
618 push @out, $wt{'VC'} if $vic;
620 return join ' ', @out;
623 package Geo::TAF::EN::RVR;
625 @ISA = qw(Geo::TAF::EN);
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';
639 package Geo::TAF::EN::RWY;
641 @ISA = qw(Geo::TAF::EN);
646 my $out = $self->[0] eq 'LDG' ? "landing " : '';
647 $out .= "runway $self->[1]";
651 package Geo::TAF::EN::PROB;
653 @ISA = qw(Geo::TAF::EN);
659 my $out = "probability $self->[0]%";
660 $out .= " $self->[1] to $self->[2]" if defined $self->[1];
664 package Geo::TAF::EN::TEMPO;
666 @ISA = qw(Geo::TAF::EN);
671 my $out = "temporarily";
672 $out .= " $self->[0] to $self->[1]" if defined $self->[0];
677 package Geo::TAF::EN::BECMG;
679 @ISA = qw(Geo::TAF::EN);
684 my $out = "becoming";
685 $out .= " $self->[0] to $self->[1]" if defined $self->[0];
690 package Geo::TAF::EN::VIZ;
692 @ISA = qw(Geo::TAF::EN);
698 return "visibility $self->[0]$self->[1]";
701 package Geo::TAF::EN::FROM;
703 @ISA = qw(Geo::TAF::EN);
709 return "from $self->[0]";
712 package Geo::TAF::EN::TIL;
714 @ISA = qw(Geo::TAF::EN);
720 return "until $self->[0]";
724 # Autoload methods go after =cut, and are processed by the autosplit program.
728 # Below is stub documentation for your module. You'd better edit it!
732 Geo::TAF - Decode METAR and TAF strings
739 my $t = new Geo::TAF;
741 $t->metar("EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
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");
748 $t->decode("METAR EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
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");
755 foreach my $c ($t->chunks) {
756 print $c->as_string, ' ';
759 print $self->as_string;
761 foreach my $c ($t->chunks) {
762 print $c->as_chunk, ' ';
765 print $self->as_chunk_string;
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;
774 Geo::TAF decodes aviation METAR and TAF weather forecast code
775 strings into English or, if you sub-class, some other language.
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.
783 This module attempts to decode these reports into a form of
784 English that is hopefully more understandable than the reports
787 It is possible to sub-class the translation routines to enable
788 translation to other langauages.
796 Constructor for the class. Each weather announcement will need
799 If you sub-class the built-in English translation routines then
800 you can pick this up by called the constructor thus:-
802 my $t = Geo::TAF->new(chunk_package => 'Geo::TAF::ES');
804 or whatever takes your fancy.
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.
812 There are a number of fixed fields created and also array
813 of chunks L<chunks()> of (as default) C<Geo::TAF::EN>.
815 You can decode these manually or use one of the built-in routines.
817 This method returns undef if it is successful, a number otherwise.
818 You can use L<errorp($r)> routine to get a stringified
823 This simply adds C<METAR> to the front of the string and calls
828 This simply adds C<TAF> to the front of the string and calls
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.
837 Returns the decoded weather report as a human readable string.
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()>.
844 Returns an array of strings without separators. This simply
845 the decoded, human readable, normalised strings presented
848 =item as_chunk_string()
850 Returns a human readable version of the internal decoded,
851 normalised form of the weather report.
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.
857 Although you can read the result, it is not, officially,
860 =item as_chunk_strings()
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
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".
875 If you replace the English versions of these objects then you
876 will need at an L<as_string()> method.
880 Returns the (cleaned up) weather report. It is cleaned up in the
881 sense that all whitespace is reduced to exactly one space
886 Returns a stringified version of any error returned by L<decode()>
896 Returns whether this object is a taf or not.
900 Returns the ICAO code contained in the weather report
904 Returns the day of the month of this report
908 Returns the issue time of this report
912 Returns the day this report is valid for (if there is one).
916 Returns the time from which this report is valid for (if there is one).
920 Returns the time to which this report is valid for (if there is one).
924 Returns the minimum visibility, if present.
928 Returns the units of the visibility information.
932 Returns the wind direction in degrees, if present.
936 Returns the wind speed.
940 Returns the units of wind_speed.
944 Returns any wind gust speed. It is possible to have L<wind_speed()>
945 without gust information.
949 Returns the QNH (altimeter setting atmospheric pressure), if present.
951 =item pressure_units()
953 Returns the units in which L<pressure()> is messured.
957 Returns any temperature present.
961 Returns any dewpoint present.
969 =item is_weather($line)
971 This is a routine that determines, fairly losely, whether the
972 passed string is likely to be a weather report;
974 This routine is not exported. You must call it explicitly.
982 For a example of a weather forecast from the Norwich Weather
983 Centre (EGSH) see L<http://www.tobit.co.uk>
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/>
989 To find an ICAO code for your local airport see
990 L<http://www.ar-group.com/icaoiata.htm>
994 Dirk Koopman, L<mailto:djk@tobit.co.uk>
996 =head1 COPYRIGHT AND LICENSE
998 Copyright (c) 2003 by Dirk Koopman, G1TLH
1000 This library is free software; you can redistribute it and/or modify
1001 it under the same terms as Perl itself.