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);
79 for (@{$self->{chunks}}) {
80 $out .= $_->as_string . ' ' if $_->can('as_string');
91 for (@{$self->{chunks}}) {
92 push @out, $_->as_string;
100 return exists $self->{chunks} ? @{$self->{chunks}} : ();
108 for (@{$self->{chunks}}) {
109 push @out, $_->as_chunk;
117 return join ' ', $self->as_chunk_strings;
122 return shift->{line};
127 return $_[0] =~ /^\s*(?:(?:METAR|TAF)\s+)?[A-Z]{4}\s+\d{6}Z?\s+/;
134 return $err{"$code"};
137 # basically all metars and tafs are the same, except that a metar is short
138 # and a taf can have many repeated sections for different times of the day
146 my @tok = split /\s+/, $l;
148 $self->{line} = join ' ', @tok;
151 # do we explicitly have a METAR or a TAF
155 } elsif ($t eq 'METAR') {
161 # next token is the ICAO dseignator
163 if ($t =~ /^[A-Z]{4}$/) {
169 # next token is an issue time
171 if (my ($day, $time) = $t =~ /^(\d\d)(\d{4})Z?$/) {
173 $self->{time} = _time($time);
178 # if it is a TAF then expect a validity (may be missing)
180 if (my ($vd, $vfrom, $vto) = $tok[0] =~ /^(\d\d)(\d\d)(\d\d)$/) {
181 $self->{valid_day} = $vd;
182 $self->{valid_from} = _time($vfrom * 100);
183 $self->{valid_to} = _time($vto * 100);
188 # we are now into the 'list' of things that can repeat over and over
191 $self->_chunk('HEAD', $self->{taf} ? 'TAF' : 'METAR',
192 $self->{icao}, $self->{day}, $self->{time})
195 push @chunk, $self->_chunk('VALID', $self->{valid_day}, $self->{valid_from},
196 $self->{valid_to}) if $self->{valid_day};
202 if ($t eq 'TEMPO' || $t eq 'BECMG') {
204 # next token may be a time if it is a taf
206 if (($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/) {
207 if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
209 $from = _time($from * 100);
210 $to = _time($to * 100);
216 push @chunk, $self->_chunk($t, $from, $to);
219 } elsif ($ignore{$t}) {
223 } elsif ($t eq 'NOSIG' || $t eq 'NSW') {
224 push @chunk, $self->_chunk('WEATHER', 'NOSIG');
226 # specific broken on its own
227 } elsif ($t eq 'BKN') {
228 push @chunk, $self->_chunk('WEATHER', $t);
230 # other 3 letter codes
232 push @chunk, $self->_chunk('CLOUD', $t);
234 # EU CAVOK viz > 10000m, no cloud, no significant weather
235 } elsif ($t eq 'CAVOK') {
236 $self->{viz_dist} ||= ">10000";
237 $self->{viz_units} ||= 'm';
238 push @chunk, $self->_chunk('CLOUD', 'CAVOK');
240 # RMK group (end for now)
241 } elsif ($t eq 'RMK') {
245 } elsif (my ($time) = $t =~ /^FM(\d\d\d\d)$/ ) {
246 push @chunk, $self->_chunk('FROM', _time($time));
249 } elsif (($time) = $t =~ /^TL(\d\d\d\d)$/ ) {
250 push @chunk, $self->_chunk('TIL', _time($time));
253 } elsif (my ($percent) = $t =~ /^PROB(\d\d)$/ ) {
255 # next token may be a time if it is a taf
257 if (($from, $to) = $tok[0] =~ /^(\d\d)(\d\d)$/) {
258 if ($self->{taf} && $from >= 0 && $from <= 24 && $to >= 0 && $to <= 24) {
260 $from = _time($from * 100);
261 $to = _time($to * 100);
267 push @chunk, $self->_chunk('PROB', $percent, $from, $to);
270 } elsif (my ($sort, $dir) = $t =~ /^(RWY?|LDG)(\d\d[RLC]?)$/ ) {
271 push @chunk, $self->_chunk('RWY', $sort, $dir);
274 } elsif (my ($wdir, $spd, $gust, $unit) = $t =~ /^(\d\d\d|VRB)(\d\d)(?:G(\d\d))?(KT|MPH|MPS|KMH)$/) {
276 # the next word might be 'AUTO'
277 if ($tok[0] eq 'AUTO') {
281 # it could be variable so look at the next token
283 my ($fromdir, $todir) = $tok[0] =~ /^(\d\d\d)V(\d\d\d)$/;
284 shift @tok if defined $fromdir;
286 $gust = 0 + $gust if defined $gust;
287 $unit = ucfirst lc $unit;
288 $unit = 'm/sec' if $unit eq 'Mps';
289 $self->{wind_dir} ||= $wdir;
290 $self->{wind_speed} ||= $spd;
291 $self->{wind_gusting} ||= $gust;
292 $self->{wind_units} ||= $unit;
293 push @chunk, $self->_chunk('WIND', $wdir, $spd, $gust, $unit, $fromdir, $todir);
296 } elsif (my ($u, $p, $punit) = $t =~ /^([QA])(?:NH)?(\d\d\d\d)(INS?)?$/) {
298 if ($u eq 'A' || $punit && $punit =~ /^I/) {
299 $p = sprintf "%.2f", $p / 100;
304 $self->{pressure} ||= $p;
305 $self->{pressure_units} ||= $u;
306 push @chunk, $self->_chunk('PRESS', $p, $u);
308 # viz group in metres
309 } elsif (my ($viz, $mist) = $t =~ m!^(\d\d\d\d[NSEW]{0,2})([A-Z][A-Z])?$!) {
310 $viz = $viz eq '9999' ? ">10000" : 0 + $viz;
311 $self->{viz_dist} ||= $viz;
312 $self->{viz_units} ||= 'm';
313 push @chunk, $self->_chunk('VIZ', $viz, 'm');
314 push @chunk, $self->_chunk('WEATHER', $mist) if $mist;
317 } elsif (($viz) = $t =~ m!^(\d+)KM$!) {
318 $viz = $viz eq '9999' ? ">10000" : 0 + $viz;
319 $self->{viz_dist} ||= $viz;
320 $self->{viz_units} ||= 'Km';
321 push @chunk, $self->_chunk('VIZ', $viz, 'Km');
323 # viz group in miles and faction of a mile with space between
324 } elsif (my ($m) = $t =~ m!^(\d)$!) {
325 if (my ($viz) = $tok[0] =~ m!^(\d/\d)SM$!) {
328 $self->{viz_dist} ||= $viz;
329 $self->{viz_units} ||= 'miles';
330 push @chunk, $self->_chunk('VIZ', $viz, 'miles');
333 # viz group in miles (either in miles or under a mile)
334 } elsif (my ($lt, $mviz) = $t =~ m!^(M)?(\d+(:?/\d)?)SM$!) {
335 $mviz = '<' . $mviz if $lt;
336 $self->{viz_dist} ||= $mviz;
337 $self->{viz_units} ||= 'Stat. Miles';
338 push @chunk, $self->_chunk('VIZ', $mviz, 'Miles');
341 # runway visual range
342 } 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])?$!) {
343 $runit = 'm' unless $runit;
345 $range = "<$range" if $rlt && $rlt eq 'M';
346 $range = ">$range" if $rlt && $rlt eq 'P';
347 $var = "<$var" if $vlt && $vlt eq 'M';
348 $var = ">$var" if $vlt && $vlt eq 'P';
349 push @chunk, $self->_chunk('RVR', $rw, $range, $var, $runit, $tend);
352 } elsif (my ($deg, $w) = $t =~ /^(\+|\-|VC)?([A-Z][A-Z]{1,4})$/) {
353 push @chunk, $self->_chunk('WEATHER', $deg, $w =~ /([A-Z][A-Z])/g);
356 } elsif (my ($amt, $height, $cb) = $t =~ m!^(FEW|SCT|BKN|OVC|SKC|CLR|VV|///)(\d\d\d|///)(CB|TCU)?$!) {
357 push @chunk, $self->_chunk('CLOUD', $amt, $height eq '///' ? 0 : $height * 100, $cb) unless $amt eq '///' && $height eq '///';
360 } elsif (my ($ms, $t, $n, $d) = $t =~ m!^(M)?(\d\d)/(M)?(\d\d)?$!) {
363 $t = -$t if defined $ms;
364 $d = -$d if defined $d && defined $n;
365 $self->{temp} ||= $t;
366 $self->{dewpoint} ||= $d;
367 push @chunk, $self->_chunk('TEMP', $t, $d);
371 $self->{chunks} = \@chunk;
380 $pkg = $self->{chunk_package} . '::' . $pkg;
381 return $pkg->new(@_);
386 return sprintf "%02d:%02d", unpack "a2a2", sprintf "%04d", shift;
393 my $name = $AUTOLOAD;
394 return if $name =~ /::DESTROY$/;
397 *$AUTOLOAD = sub { $_[0]->{$name}};
402 # these are the translation packages
404 # First the factory method
407 package Geo::TAF::EN;
412 return bless [@_], $pkg;
418 my ($n) = (ref $self) =~ /::(\w+)$/;
419 return '[' . join(' ', $n, map {defined $_ ? $_ : '?'} @$self) . ']';
425 my ($n) = (ref $self) =~ /::(\w+)$/;
426 return join ' ', ucfirst $n, map {defined $_ ? $_ : ()} @$self;
433 my $name = $AUTOLOAD;
434 return if $name =~ /::DESTROY$/;
437 *$AUTOLOAD = sub { $_[0]->{$name}};
441 package Geo::TAF::EN::HEAD;
443 @ISA = qw(Geo::TAF::EN);
448 return "$self->[0] for $self->[1] issued day $self->[2] at $self->[3]";
451 package Geo::TAF::EN::VALID;
453 @ISA = qw(Geo::TAF::EN);
458 return "valid day $self->[0] from $self->[1] till $self->[2]";
462 package Geo::TAF::EN::WIND;
464 @ISA = qw(Geo::TAF::EN);
466 # direction, $speed, $gusts, $unit, $fromdir, $todir
471 $out .= $self->[0] eq 'VRB' ? " variable" : " $self->[0]";
472 $out .= " varying between $self->[4] and $self->[5]" if defined $self->[4];
473 $out .= ($self->[0] eq 'VRB' ? '' : " degrees") . " at $self->[1]";
474 $out .= " gusting $self->[2]" if defined $self->[2];
479 package Geo::TAF::EN::PRESS;
481 @ISA = qw(Geo::TAF::EN);
487 return "QNH $self->[0]$self->[1]";
490 # temperature, dewpoint
491 package Geo::TAF::EN::TEMP;
493 @ISA = qw(Geo::TAF::EN);
498 my $out = "temperature $self->[0]C";
499 $out .= ", dewpoint $self->[1]C" if defined $self->[1];
504 package Geo::TAF::EN::CLOUD;
506 @ISA = qw(Geo::TAF::EN);
509 VV => 'vertical visibility',
511 CLR => "no cloud, no significant weather",
515 OVC => "8 oktas, overcast",
516 CAVOK => "no cloud below 5000ft, >10Km visibility, no significant weather (CAVOK)",
517 CB => 'thunderstorms',
518 TCU => 'towering cumulus',
519 NSC => 'no significant cloud',
520 BLU => '3 oktas at 2500ft, 8Km visibility',
521 WHT => '3 oktas at 1500ft, 5Km visibility',
522 GRN => '3 oktas at 700ft, 3700m visibility',
523 YLO => '3 oktas at 300ft, 1600m visibility',
524 AMB => '3 oktas at 200ft, 800m visibility',
525 RED => '3 oktas at <200ft, <800m visibility',
533 return $st{$self->[0]} if @$self == 1;
534 return $st{$self->[0]} . " $self->[1]ft" if $self->[0] eq 'VV';
535 return $st{$self->[0]} . " cloud at $self->[1]ft" . ((defined $self->[2]) ? " with $st{$self->[2]}" : "");
538 package Geo::TAF::EN::WEATHER;
540 @ISA = qw(Geo::TAF::EN);
545 'VC' => 'in the vicinity',
550 DR => 'low drifting',
553 TS => 'thunderstorms containing',
561 IC => 'ice crystals',
564 GS => 'small hail/snow pellets',
565 UP => 'unknown precip',
570 VA => 'volcanic ash',
576 PO => 'dust/sand whirls',
581 '+FC' => 'water spouts',
585 'NOSIG' => 'no significant weather',
603 } elsif ($t eq 'VC') {
606 } elsif ($t eq 'SH') {
609 } elsif ($t eq '+' && $self->[0] eq 'FC') {
610 push @out, $wt{'+FC'};
617 if (@out && $shower) {
619 push @out, $wt{'SH'};
622 push @out, $wt{'VC'} if $vic;
624 return join ' ', @out;
627 package Geo::TAF::EN::RVR;
629 @ISA = qw(Geo::TAF::EN);
634 my $out = "visual range on runway $self->[0] is $self->[1]$self->[3]";
635 $out .= " varying to $self->[2]$self->[3]" if defined $self->[2];
636 if (defined $self->[4]) {
637 $out .= " decreasing" if $self->[4] eq 'D';
638 $out .= " increasing" if $self->[4] eq 'U';
643 package Geo::TAF::EN::RWY;
645 @ISA = qw(Geo::TAF::EN);
650 my $out = $self->[0] eq 'LDG' ? "landing " : '';
651 $out .= "runway $self->[1]";
655 package Geo::TAF::EN::PROB;
657 @ISA = qw(Geo::TAF::EN);
663 my $out = "probability $self->[0]%";
664 $out .= " $self->[1] till $self->[2]" if defined $self->[1];
668 package Geo::TAF::EN::TEMPO;
670 @ISA = qw(Geo::TAF::EN);
675 my $out = "temporarily";
676 $out .= " $self->[0] till $self->[1]" if defined $self->[0];
681 package Geo::TAF::EN::BECMG;
683 @ISA = qw(Geo::TAF::EN);
688 my $out = "becoming";
689 $out .= " $self->[0] till $self->[1]" if defined $self->[0];
694 package Geo::TAF::EN::VIZ;
696 @ISA = qw(Geo::TAF::EN);
702 return "visibility $self->[0]$self->[1]";
705 package Geo::TAF::EN::FROM;
707 @ISA = qw(Geo::TAF::EN);
713 return "from $self->[0]";
716 package Geo::TAF::EN::TIL;
718 @ISA = qw(Geo::TAF::EN);
724 return "until $self->[0]";
728 # Autoload methods go after =cut, and are processed by the autosplit program.
732 # Below is stub documentation for your module. You'd better edit it!
736 Geo::TAF - Decode METAR and TAF strings
743 my $t = new Geo::TAF;
745 $t->metar("EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
747 $t->taf("EGSH 311205Z 311322 04010KT 9999 SCT020
748 TEMPO 1319 3000 SHSN BKN008 PROB30
749 TEMPO 1318 0700 +SHSN VV///
750 BECMG 1619 22005KT");
752 $t->decode("METAR EGSH 311420Z 29010KT 1600 SHSN SCT004 BKN006 01/M00 Q1021");
754 $t->decode("TAF EGSH 311205Z 311322 04010KT 9999 SCT020
755 TEMPO 1319 3000 SHSN BKN008 PROB30
756 TEMPO 1318 0700 +SHSN VV///
757 BECMG 1619 22005KT");
759 foreach my $c ($t->chunks) {
760 print $c->as_string, ' ';
763 print $self->as_string;
765 foreach my $c ($t->chunks) {
766 print $c->as_chunk, ' ';
769 print $self->as_chunk_string;
771 my @out = $self->as_strings;
772 my @out = $self->as_chunk_strings;
773 my $line = $self->raw;
774 print Geo::TAF::is_weather($line) ? 1 : 0;
778 Geo::TAF decodes aviation METAR and TAF weather forecast code
779 strings into English or, if you sub-class, some other language.
783 METAR (Routine Aviation weather Report) and TAF (Terminal Area
784 weather Report) are ascii strings containing codes describing
785 the weather at airports and weather bureaus around the world.
787 This module attempts to decode these reports into a form of
788 English that is hopefully more understandable than the reports
791 It is possible to sub-class the translation routines to enable
792 translation to other langauages.
800 Constructor for the class. Each weather announcement will need
803 If you sub-class the built-in English translation routines then
804 you can pick this up by called the constructor thus:-
806 C<my $t = Geo::TAF-E<gt>new(chunk_package =E<gt> 'Geo::TAF::ES');>
808 or whatever takes your fancy.
812 The main routine that decodes a weather string. It expects a
813 string that begins with either the word C<METAR> or C<TAF>.
814 It creates a decoded form of the weather string in the object.
816 There are a number of fixed fields created and also array
817 of chunks L<chunks()> of (as default) C<Geo::TAF::EN>.
819 You can decode these manually or use one of the built-in routines.
821 This method returns undef if it is successful, a number otherwise.
822 You can use L<errorp($r)> routine to get a stringified
827 This simply adds C<METAR> to the front of the string and calls
832 This simply adds C<TAF> to the front of the string and calls
835 It makes very little difference to the decoding process which
836 of these routines you use. It does, however, affect the output
837 in that it will mark it as the appropriate type of report.
841 Returns the decoded weather report as a human readable string.
843 This is probably the simplest and most likely of the output
844 options that you might want to use. See also L<as_strings()>.
848 Returns an array of strings without separators. This simply
849 the decoded, human readable, normalised strings presented
852 =item as_chunk_string()
854 Returns a human readable version of the internal decoded,
855 normalised form of the weather report.
857 This may be useful if you are doing something special, but
858 see L<chunks()> or L<as_chunk_strings()> for a procedural
859 approach to accessing the internals.
861 Although you can read the result, it is not, officially,
864 =item as_chunk_strings()
866 Returns an array of the stringified versions of the internal
867 normalised form without separators.. This simply
868 the decoded (English as default) normalised strings presented
873 Returns a list of (as default) C<Geo::TAF::EN> objects. You
874 can use C<$c-E<gt>as_string> or C<$c-E<gt>as_chunk> to
875 translate the internal form into something readable.
877 If you replace the English versions of these objects then you
878 will need at an L<as_string()> method.
882 Returns the (cleaned up) weather report. It is cleaned up in the
883 sense that all whitespace is reduced to exactly one space
888 Returns a stringified version of any error returned by L<decode()>
898 Returns whether this object is a taf or not.
902 Returns the ICAO code contained in the weather report
906 Returns the day of the month of this report
910 Returns the issue time of this report
914 Returns the day this report is valid for (if there is one).
918 Returns the time from which this report is valid for (if there is one).
922 Returns the time to which this report is valid for (if there is one).
926 Returns the minimum visibility, if present.
930 Returns the units of the visibility information.
934 Returns the wind direction in degrees, if present.
938 Returns the wind speed.
942 Returns the units of wind_speed.
946 Returns any wind gust speed. It is possible to have L<wind_speed()>
947 without gust information.
951 Returns the QNH (altimeter setting atmospheric pressure), if present.
953 =item pressure_units()
955 Returns the units in which L<pressure()> is messured.
959 Returns any temperature present.
963 Returns any dewpoint present.
971 =item is_weather($line)
973 This is a routine that determines, fairly losely, whether the
974 passed string is likely to be a weather report;
976 This routine is not exported. You must call it explicitly.
984 For a example of a weather forecast from the Norwich Weather
985 Centre (EGSH) see L<http://www.tobit.co.uk>
987 For data see <ftp://weather.noaa.gov/data/observations/metar/>
988 L<ftp://weather.noaa.gov/data/forecasts/taf/> and also
989 L<ftp://weather.noaa.gov/data/forecasts/shorttaf/>
991 To find an ICAO code for your local airport see
992 L<http://www.ar-group.com/icaoiata.htm>
996 Dirk Koopman, L<mailto:djk@tobit.co.uk>
998 =head1 COPYRIGHT AND LICENSE
1000 Copyright (c) 2003 by Dirk Koopman, G1TLH
1002 This library is free software; you can redistribute it and/or modify
1003 it under the same terms as Perl itself.