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
140 # TAFs like this are non-standard, but I have seen these examples in
141 # real life, and that is, after all, what this code needs to cope with. [DW]
142 $l =~ s/\b(BECMG)(\d{4})\b/$1 $2/g; # Some people can't use a space bar
143 $l =~ s/\bTEMP0\b/TEMPO/g; # Some people use zero instead of a letter O
144 $l =~ s/\bBEC\b/BECMG/g; # And some people can't spell BECMG
146 my @tok = split /\s+/, $l;
148 $self->{line} = join ' ', @tok;
150 # do we explicitly have a METAR or a TAF
154 } elsif ($t eq 'METAR') {
160 # next token is the ICAO dseignator
162 # ignore AMD (amendment) token if present.
163 $t = shift @tok if $t eq 'AMD';
165 if ($t =~ /^[A-Z]{4}$/) {
171 # next token is an issue time
173 # ignore AMD (amendment) token if present.
174 $t = shift @tok if $t eq 'AMD';
176 if (my ($day, $time) = $t =~ /^(\d\d)(\d{4})Z?$/) {
178 $self->{time} = _time($time);
183 # if it is a TAF then expect a validity (may be missing)
185 if (my ($vd, $vfrom, $vto) = $tok[0] =~ /^(\d\d)(\d\d)(\d\d)$/) {
186 $self->{valid_day} = $vd;
187 $self->{valid_from} = _time($vfrom * 100);
188 $self->{valid_to} = _time($vto * 100);
193 # we are now into the 'list' of things that can repeat over and over
196 $self->_chunk('HEAD', $self->{taf} ? 'TAF' : 'METAR',
197 $self->{icao}, $self->{day}, $self->{time})
200 push @chunk, $self->_chunk('VALID', $self->{valid_day}, $self->{valid_from},
201 $self->{valid_to}) if $self->{valid_day};
207 if ($t eq 'TEMPO' || $t eq 'BECMG') {
209 # next token may be a time if it is a taf
211 if (@tok && (($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/)) {
212 if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
214 $from = _time($from * 100);
215 $to = _time($to * 100);
221 push @chunk, $self->_chunk($t, $from, $to);
224 } elsif ($ignore{$t}) {
228 } elsif ($t eq 'NOSIG' || $t eq 'NSW') {
229 push @chunk, $self->_chunk('WEATHER', 'NOSIG');
231 # specific broken on its own
232 } elsif ($t eq 'BKN') {
233 push @chunk, $self->_chunk('WEATHER', $t);
235 # other 3 letter codes
237 push @chunk, $self->_chunk('CLOUD', $t);
239 # EU CAVOK viz > 10000m, no cloud, no significant weather
240 } elsif ($t eq 'CAVOK') {
241 $self->{viz_dist} ||= ">10000";
242 $self->{viz_units} ||= 'm';
243 push @chunk, $self->_chunk('CLOUD', 'CAVOK');
245 # AMD group (end for now)
246 } elsif ($t eq 'AMD') {
249 # RMK group (end for now)
250 } elsif ($t eq 'RMK') {
254 } elsif (my ($time) = $t =~ /^FM(\d\d\d?\d?)Z?$/ ) {
255 $time .= '0' while length($time) < 4;
256 push @chunk, $self->_chunk('FROM', _time($time));
259 } elsif (($time) = $t =~ /^TI?LL?(\d\d\d?\d?)Z?$/ ) {
260 $time .= '0' while length($time) < 4;
261 push @chunk, $self->_chunk('TIL', _time($time));
264 } elsif (my ($percent) = $t =~ /^PROB(\d\d)$/ ) {
266 # next token may be a time if it is a taf
268 if (@tok && (($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/)) {
269 if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
271 $from = _time($from * 100);
272 $to = _time($to * 100);
278 push @chunk, $self->_chunk('PROB', $percent, $from, $to);
281 } elsif (my ($sort, $dir) = $t =~ /^(RWY?|LDG)(\d\d[RLC]?)$/ ) {
282 push @chunk, $self->_chunk('RWY', $sort, $dir);
285 } elsif (my ($wdir, $spd, $gust, $unit) = $t =~ /^(\d\d\d|VRB)(\d\d)(?:G(\d\d))?(KT|MPH|MPS|KMH)$/) {
287 my ($fromdir, $todir);
289 if (@tok && (($fromdir, $todir) = $tok[0] =~ /^(\d\d\d)V(\d\d\d)$/)) {
293 # it could be variable so look at the next token
296 $gust = 0 + $gust if defined $gust;
297 $unit = ucfirst lc $unit;
298 $unit = 'm/sec' if $unit eq 'Mps';
299 $self->{wind_dir} ||= $wdir;
300 $self->{wind_speed} ||= $spd;
301 $self->{wind_gusting} ||= $gust;
302 $self->{wind_units} ||= $unit;
303 push @chunk, $self->_chunk('WIND', $wdir, $spd, $gust, $unit, $fromdir, $todir);
306 } elsif (my ($u, $p, $punit) = $t =~ /^([QA])(?:NH)?(\d\d\d\d)(INS?)?$/) {
309 if ($u eq 'A' || $punit && $punit =~ /^I/) {
310 $p = sprintf "%.2f", $p / 100;
315 $self->{pressure} ||= $p;
316 $self->{pressure_units} ||= $u;
317 push @chunk, $self->_chunk('PRESS', $p, $u);
319 # viz group in metres
320 } elsif (my ($viz, $mist) = $t =~ m!^(\d\d\d\d[NSEW]{0,2})([A-Z][A-Z])?$!) {
321 $viz = $viz eq '9999' ? ">10000" : 0 + $viz;
322 $self->{viz_dist} ||= $viz;
323 $self->{viz_units} ||= 'm';
324 push @chunk, $self->_chunk('VIZ', $viz, 'm');
325 push @chunk, $self->_chunk('WEATHER', $mist) if $mist;
328 } elsif (($viz) = $t =~ m!^(\d+)KM$!) {
329 $viz = $viz eq '9999' ? ">10000" : 0 + $viz;
330 $self->{viz_dist} ||= $viz;
331 $self->{viz_units} ||= 'Km';
332 push @chunk, $self->_chunk('VIZ', $viz, 'Km');
334 # viz group in miles and fraction of a mile with space between
335 } elsif (my ($m) = $t =~ m!^(\d)$!) {
337 if (@tok && (($viz, $denom) = $tok[0] =~ m!^(\d)/(\d)SM$!)) {
340 $viz = $m + $viz / $denom;
341 $self->{viz_dist} ||= $viz;
342 $self->{viz_units} ||= 'Miles';
343 push @chunk, $self->_chunk('VIZ', $viz, 'Miles');
346 # viz group in miles (either in miles or under a mile)
347 } elsif (my ($lt, $mviz, $denom) = $t =~ m!^([MP])?(\d+)(?:/(\d))?SM$!) {
350 $mviz = '<' . $mviz if $lt and $lt eq 'M';
351 $mviz = '>' . $mviz if $lt and $lt eq 'P';
352 $self->{viz_dist} ||= $mviz;
353 $self->{viz_units} ||= 'Miles';
354 push @chunk, $self->_chunk('VIZ', $mviz, 'Miles');
356 # runway visual range
357 } 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])?$!) {
358 $runit = 'm' unless $runit;
360 $range = "<$range" if $rlt && $rlt eq 'M';
361 $range = ">$range" if $rlt && $rlt eq 'P';
362 $var = "<$var" if $vlt && $vlt eq 'M';
363 $var = ">$var" if $vlt && $vlt eq 'P';
364 push @chunk, $self->_chunk('RVR', $rw, $range, $var, $runit, $tend);
367 } elsif (my ($deg, $w) = $t =~ /^(\+|\-|VC)?([A-Z][A-Z]{1,4})$/) {
368 push @chunk, $self->_chunk('WEATHER', $deg, $w =~ /([A-Z][A-Z])/g);
371 } elsif (my ($amt, $height, $cb) = $t =~ m!^(FEW|SCT|BKN|OVC|SKC|CLR|VV|///)(\d\d\d|///)(CB|TCU)?$!) {
372 push @chunk, $self->_chunk('CLOUD', $amt, $height eq '///' ? 0 : $height * 100, $cb) unless $amt eq '///' && $height eq '///';
375 } elsif (my ($ms, $t, $n, $d) = $t =~ m!^T?(M)?(\d\d)/(M)?(\d\dZ?)?$!) {
378 $t = -$t if defined $ms;
379 $d = -$d if defined $d && defined $n;
380 $self->{temp} ||= $t;
381 $self->{dewpoint} ||= $d;
382 push @chunk, $self->_chunk('TEMP', $t, $d);
386 $self->{chunks} = \@chunk;
395 $pkg = $self->{chunk_package} . '::' . $pkg;
396 return $pkg->new(@_);
401 return sprintf "%02d:%02d", unpack "a2a2", sprintf "%04d", shift;
408 my ($package, $name) = $AUTOLOAD =~ /^(.*)::(\w+)$/;
409 return if $name eq 'DESTROY';
411 *$AUTOLOAD = sub {return $_[0]->{$name}};
416 # these are the translation packages
418 # First the factory method
421 package Geo::TAF::EN;
426 return bless [@_], $pkg;
432 my ($n) = (ref $self) =~ /::(\w+)$/;
433 return '[' . join(' ', $n, map {defined $_ ? $_ : '?'} @$self) . ']';
439 my ($n) = (ref $self) =~ /::(\w+)$/;
440 return join ' ', ucfirst $n, map {defined $_ ? $_ : ()} @$self;
446 my $d = sprintf "%d", ref($pkg) ? shift : $pkg;
449 } elsif ($d =~ /2$/) {
451 } elsif ($d =~ /3$/) {
458 package Geo::TAF::EN::HEAD;
460 @ISA = qw(Geo::TAF::EN);
465 return "$self->[0] for $self->[1] issued at $self->[3] on " . $self->day($self->[2]);
468 package Geo::TAF::EN::VALID;
470 @ISA = qw(Geo::TAF::EN);
475 return "valid from $self->[1] to $self->[2] on " . $self->day($self->[0]);
479 package Geo::TAF::EN::WIND;
481 @ISA = qw(Geo::TAF::EN);
483 # direction, $speed, $gusts, $unit, $fromdir, $todir
488 $out .= $self->[0] eq 'VRB' ? " variable" : " $self->[0]";
489 $out .= " varying between $self->[4] and $self->[5]" if defined $self->[4];
490 $out .= ($self->[0] eq 'VRB' ? '' : " degrees") . " at $self->[1]";
491 $out .= " gusting $self->[2]" if defined $self->[2];
496 package Geo::TAF::EN::PRESS;
498 @ISA = qw(Geo::TAF::EN);
504 return "QNH $self->[0]$self->[1]";
507 # temperature, dewpoint
508 package Geo::TAF::EN::TEMP;
510 @ISA = qw(Geo::TAF::EN);
515 my $out = "temperature $self->[0]C";
516 $out .= " dewpoint $self->[1]C" if defined $self->[1];
521 package Geo::TAF::EN::CLOUD;
523 @ISA = qw(Geo::TAF::EN);
526 VV => 'vertical visibility',
528 CLR => "no cloud no significant weather",
532 OVC => "8 oktas overcast",
533 CAVOK => "no cloud below 5000ft >10Km visibility no significant weather (CAVOK)",
534 CB => 'thunder clouds',
535 TCU => 'towering cumulus',
536 NSC => 'no significant cloud',
537 BLU => '3 oktas at 2500ft 8Km visibility',
538 WHT => '3 oktas at 1500ft 5Km visibility',
539 GRN => '3 oktas at 700ft 3700m visibility',
540 YLO => '3 oktas at 300ft 1600m visibility',
541 AMB => '3 oktas at 200ft 800m visibility',
542 RED => '3 oktas at <200ft <800m visibility',
550 return $st{$self->[0]} if @$self == 1;
551 return $st{$self->[0]} . " $self->[1]ft" if $self->[0] eq 'VV';
552 return $st{$self->[0]} . " cloud at $self->[1]ft" . ((defined $self->[2]) ? " with $st{$self->[2]}" : "");
555 package Geo::TAF::EN::WEATHER;
557 @ISA = qw(Geo::TAF::EN);
562 'VC' => 'in the vicinity',
567 DR => 'low drifting',
570 TS => 'thunderstorms containing',
578 IC => 'ice crystals',
581 GS => 'small hail/snow pellets',
582 UP => 'unknown precip',
587 VA => 'volcanic ash',
593 PO => 'dust/sand whirls',
598 '+FC' => 'water spouts',
602 'NOSIG' => 'no significant weather',
620 } elsif ($t eq 'VC') {
623 } elsif ($t eq 'SH') {
626 } elsif ($t eq '+' && $self->[0] eq 'FC') {
627 push @out, $wt{'+FC'};
634 if (@out && $shower) {
636 push @out, $wt{'SH'};
639 push @out, $wt{'VC'} if $vic;
641 return join ' ', @out;
644 package Geo::TAF::EN::RVR;
646 @ISA = qw(Geo::TAF::EN);
651 my $out = "visual range on runway $self->[0] is $self->[1]$self->[3]";
652 $out .= " varying to $self->[2]$self->[3]" if defined $self->[2];
653 if (defined $self->[4]) {
654 $out .= " decreasing" if $self->[4] eq 'D';
655 $out .= " increasing" if $self->[4] eq 'U';
660 package Geo::TAF::EN::RWY;
662 @ISA = qw(Geo::TAF::EN);
667 my $out = $self->[0] eq 'LDG' ? "landing " : '';
668 $out .= "runway $self->[1]";
672 package Geo::TAF::EN::PROB;
674 @ISA = qw(Geo::TAF::EN);
680 my $out = "probability $self->[0]%";
681 $out .= " $self->[1] to $self->[2]" if defined $self->[1];
685 package Geo::TAF::EN::TEMPO;
687 @ISA = qw(Geo::TAF::EN);
692 my $out = "temporarily";
693 $out .= " $self->[0] to $self->[1]" if defined $self->[0];
698 package Geo::TAF::EN::BECMG;
700 @ISA = qw(Geo::TAF::EN);
705 my $out = "becoming";
706 $out .= " $self->[0] to $self->[1]" if defined $self->[0];
711 package Geo::TAF::EN::VIZ;
713 @ISA = qw(Geo::TAF::EN);
719 return "visibility $self->[0]$self->[1]";
722 package Geo::TAF::EN::FROM;
724 @ISA = qw(Geo::TAF::EN);
730 return "from $self->[0]";
733 package Geo::TAF::EN::TIL;
735 @ISA = qw(Geo::TAF::EN);
741 return "until $self->[0]";
744 # Autoload methods go after =cut, and are processed by the autosplit program.
748 # Below is stub documentation for your module. You'd better edit it!
752 Geo::TAF - Decode METAR and TAF strings
759 my $t = new Geo::TAF;
761 $t->metar("EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
763 $t->taf("EGSH 311205Z 311322 04010KT 9999 SCT020
764 TEMPO 1319 3000 SHSN BKN008 PROB30
765 TEMPO 1318 0700 +SHSN VV///
766 BECMG 1619 22005KT");
768 $t->decode("METAR EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
770 $t->decode("TAF EGSH 311205Z 311322 04010KT 9999 SCT020
771 TEMPO 1319 3000 SHSN BKN008 PROB30
772 TEMPO 1318 0700 +SHSN VV///
773 BECMG 1619 22005KT");
775 foreach my $c ($t->chunks) {
776 print $c->as_string, ' ';
779 print $self->as_string;
781 foreach my $c ($t->chunks) {
782 print $c->as_chunk, ' ';
785 print $self->as_chunk_string;
787 my @out = $self->as_strings;
788 my @out = $self->as_chunk_strings;
789 my $line = $self->raw;
790 print Geo::TAF::is_weather($line) ? 1 : 0;
794 Geo::TAF decodes aviation METAR and TAF weather forecast code
795 strings into English or, if you sub-class, some other language.
799 METAR (Routine Aviation weather Report) and TAF (Terminal Area
800 weather Report) are ascii strings containing codes describing
801 the weather at airports and weather bureaus around the world.
803 This module attempts to decode these reports into a form of
804 English that is hopefully more understandable than the reports
807 It is possible to sub-class the translation routines to enable
808 translation to other langauages.
816 Constructor for the class. Each weather announcement will need
819 If you sub-class the built-in English translation routines then
820 you can pick this up by called the constructor thus:-
822 my $t = Geo::TAF->new(chunk_package => 'Geo::TAF::ES');
824 or whatever takes your fancy.
828 The main routine that decodes a weather string. It expects a
829 string that begins with either the word C<METAR> or C<TAF>.
830 It creates a decoded form of the weather string in the object.
832 There are a number of fixed fields created and also array
833 of chunks L<chunks()> of (as default) C<Geo::TAF::EN>.
835 You can decode these manually or use one of the built-in routines.
837 This method returns undef if it is successful, a number otherwise.
838 You can use L<errorp($r)> routine to get a stringified
843 This simply adds C<METAR> to the front of the string and calls
848 This simply adds C<TAF> to the front of the string and calls
851 It makes very little difference to the decoding process which
852 of these routines you use. It does, however, affect the output
853 in that it will mark it as the appropriate type of report.
857 Returns the decoded weather report as a human readable string.
859 This is probably the simplest and most likely of the output
860 options that you might want to use. See also L<as_strings()>.
864 Returns an array of strings without separators. This simply
865 the decoded, human readable, normalised strings presented
868 =item as_chunk_string()
870 Returns a human readable version of the internal decoded,
871 normalised form of the weather report.
873 This may be useful if you are doing something special, but
874 see L<chunks()> or L<as_chunk_strings()> for a procedural
875 approach to accessing the internals.
877 Although you can read the result, it is not, officially,
880 =item as_chunk_strings()
882 Returns an array of the stringified versions of the internal
883 normalised form without separators.. This simply
884 the decoded (English as default) normalised strings presented
889 Returns a list of (as default) C<Geo::TAF::EN> objects. You
890 can use C<$c-E<gt>as_string> or C<$c-E<gt>as_chunk> to
891 translate the internal form into something readable. There
892 is also a routine (C<$c-E<gt>day>)to turn a day number into
893 things like "1st", "2nd" and "24th".
895 If you replace the English versions of these objects then you
896 will need at an L<as_string()> method.
900 Returns the (cleaned up) weather report. It is cleaned up in the
901 sense that all whitespace is reduced to exactly one space
906 Returns a stringified version of any error returned by L<decode()>
916 Returns whether this object is a taf or not.
920 Returns the ICAO code contained in the weather report
924 Returns the day of the month of this report
928 Returns the issue time of this report
932 Returns the day this report is valid for (if there is one).
936 Returns the time from which this report is valid for (if there is one).
940 Returns the time to which this report is valid for (if there is one).
944 Returns the minimum visibility, if present.
948 Returns the units of the visibility information.
952 Returns the wind direction in degrees, if present.
956 Returns the wind speed.
960 Returns the units of wind_speed.
964 Returns any wind gust speed. It is possible to have L<wind_speed()>
965 without gust information.
969 Returns the QNH (altimeter setting atmospheric pressure), if present.
971 =item pressure_units()
973 Returns the units in which L<pressure()> is messured.
977 Returns any temperature present.
981 Returns any dewpoint present.
989 =item is_weather($line)
991 This is a routine that determines, fairly losely, whether the
992 passed string is likely to be a weather report;
994 This routine is not exported. You must call it explicitly.
1002 For a example of a weather forecast from the Norwich Weather
1003 Centre (EGSH) see L<http://www.tobit.co.uk>
1005 For data see L<ftp://weather.noaa.gov/data/observations/metar/>
1006 L<ftp://weather.noaa.gov/data/forecasts/taf/> and also
1007 L<ftp://weather.noaa.gov/data/forecasts/shorttaf/>
1009 To find an ICAO code for your local airport see
1010 L<http://www.ar-group.com/icaoiata.htm>
1014 Dirk Koopman, L<mailto:djk@tobit.co.uk>
1016 =head1 COPYRIGHT AND LICENSE
1018 Copyright (c) 2003 by Dirk Koopman, G1TLH
1020 This library is free software; you can redistribute it and/or modify
1021 it under the same terms as Perl itself.