File Coverage

blib/lib/Aviation/Report.pm
Criterion Covered Total %
statement 101 167 60.4
branch 107 176 60.8
condition 14 21 66.6
subroutine 3 4 75.0
pod 0 2 0.0
total 225 370 60.8


line stmt bran cond sub pod time code
1             package Aviation::Report;
2              
3 1     1   785 use strict;
  1         2  
  1         51  
4              
5 1     1   7 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  1         3  
  1         3820  
6              
7             require Exporter;
8              
9             @ISA = qw(Exporter AutoLoader);
10             # Items to export into callers namespace by default. Note: do not export
11             # names by default without a very good reason. Use EXPORT_OK instead.
12             # Do not simply export all your public functions/methods/constants.
13             @EXPORT = qw(
14             decode_METAR_TAF decode_PIREP
15             );
16             $VERSION = '1.02';
17              
18             my %abb = ();
19              
20             while () {
21             chomp;
22             next if /^#?$/;
23             my ($abbrev, $desc) = split /:/;
24             $abb{$abbrev} = $desc;
25             }
26              
27             my @low = ('None', 'Cumulus (fair wx)', ' Cumulus (towering)', 'Cumulonimbus (no anvil)', 'Stratocumulus', 'Stratocumulus', 'Stratus', 'Fractocumulus/Fractostratus', 'Cumulus and Stratocumulus', 'Cumulonimbus');
28              
29             my @middle = ('None', 'Altostratus (thin)', 'Altostratus (thick)', 'Altocumulus (thin)', 'Altocumulus (patchy)', 'Altocumulus (thickening)', 'Altocumulus (from Cumulonimbus)', 'Altocumulus (w/Ac,As,Ns)', 'Altocumulus (w/turrets)', 'Altocumulus (chaotic)');
30              
31             my @high = ('None', 'Cirrus (filaments)', 'Cirrus (dense)', 'Cirrus (often w/Cb)', 'Cirrus (thickening)', 'Cirrus/Cirrostratus (low in sky)', 'Cirrus/Cirrostratus (high in sky)', 'Cirrostratus (entire sky)', 'Cirrostratus (partial)', 'Cirrocumulus or Cirrocumulus/Cirrus/Cirrostratus');
32              
33             my %abb_pirep = ( UA => 'routine pilot report',
34             UUA => 'urgent pilot report',
35             OV => 'location',
36             TM => 'time',
37             FL => 'altitude',
38             TP => 'type of aircraft',
39             SK => 'sky cover',
40             WX => 'weather',
41             TA => 'temperature',
42             WV => 'wind',
43             TB => 'turbulence',
44             IC => 'icing',
45             RM => 'remarks',
46             CLR => 'clear',
47             LGT => 'light',
48             MDT => 'moderate',
49             HVY => 'heavy',
50             );
51             1;
52              
53             sub decode_PIREP {
54 0     0 0 0 my ($s, $style) = @_;
55 0         0 my $s = uc $s;
56 0 0       0 my ($out) = $s . "\n" if $style;
57              
58 0         0 my $token;
59              
60 0         0 my @tokens = split m:/:, $s;
61              
62 0         0 while ($token = shift @tokens) {
63 0         0 my ($element, $value) = ('', '');
64 0 0       0 if (($element, $value) = split / /, $token, 2) {
65 0 0       0 if (exists $abb_pirep{$element}) {
66 0         0 $out .= $abb_pirep{$element} . ' ';
67             }
68             else {
69 0 0       0 if ($element =~ /^(\d{3})$/) {
70 0         0 $out .= int($1)."00 feet ";
71 0         0 foreach (split / /, $value) {
72 0 0       0 if (/^(\d{3})$/) {
    0          
73 0         0 $out .= int($1)."00 feet ";
74             }
75             elsif (/^([A-Z]+)$/) {
76 0 0       0 if (exists $abb{$1}) {
77 0         0 $out .= $abb{$1} . ' ';
78             }
79             else {
80 0         0 $out .= $1 . ' ';
81             }
82             }
83             else {
84 0         0 $out .= $_;
85             }
86             }
87             }
88             else {
89 0         0 $out .= $element;
90             }
91 0         0 $out .= "\n";
92 0         0 next;
93             }
94 0 0 0     0 if ($element eq 'IC' or $element eq 'TB') {
    0 0        
    0          
    0          
    0          
    0          
95 0 0       0 if (exists $abb_pirep{$value}) {
96 0         0 $out .= $abb_pirep{$value};
97             }
98             else {
99 0         0 $out .= $value;
100             }
101             }
102             elsif ($element eq 'OV' and $value =~ /^(.*?) (\d{3})(\d{3})$/) {
103 0         0 $out .= int($2) ." nautical miles on the $3 degree radial from $1";
104             }
105             elsif ($element eq 'SK') {
106 0         0 foreach (split / /, $value) {
107 0 0       0 if (/^(\d{3})$/) {
    0          
108 0         0 $out .= int($1)."00 feet msl ";
109             }
110             elsif (/^([A-Z]+)$/) {
111 0 0       0 if (exists $abb{$1}) {
112 0         0 $out .= $abb{$1};
113             }
114             else {
115 0         0 $out .= $1;
116             }
117             }
118             else {
119 0         0 $out .= $_;
120             }
121             }
122             }
123             elsif ($value =~ /^(\d{3})(\d{3})$/) {
124 0         0 $out .= "from $1 degrees magnetic at @{[int $2]} knots";
  0         0  
125             }
126             elsif ($value =~ /^(\d{2})(\d{2})$/) {
127 0         0 $out .= "$1:$2 zulu";
128             }
129             elsif ($value =~ /^(\d{3})$/) {
130 0         0 $out .= int($1)."00 feet msl ";
131             }
132             else {
133 0         0 $out .= $value;
134             }
135 0 0       0 $out .= " degrees Celsius" if $element eq 'TA';
136 0 0       0 $out .= " (MSL)" if $element eq 'SK';
137             }
138              
139 0         0 $out .= "\n";
140             }
141              
142 0         0 $out;
143             }
144            
145             sub decode_METAR_TAF {
146 7     7 0 487 my ($s, $style) = @_;
147 7 50       23 $s = uc $s if $style;
148              
149 7         35 $s =~ s/=//g;
150              
151 7         17 my ($out) = '';
152              
153 7         10 $out = $s . "\n";
154              
155 7         10 my $id = '';
156 7         7 my $token;
157              
158 7         103 my @tokens = split /\s+/, $s;
159              
160 7         24 while ($token = shift @tokens) {
161 153 50       267 $out .= $token . "\t" if $style;
162              
163 153         192 my $intensity = substr($token, 0, 1);
164 153 100       363 if ($intensity eq '-') {
    100          
165 6         9 $intensity = 'light';
166             }
167             elsif ($intensity eq '+') {
168 1         2 $intensity = 'heavy';
169             }
170              
171 153 100 100     563 if ($intensity eq 'light' or $intensity eq 'heavy') {
172 7         14 $out .= $intensity . ' ';# off for -TSRA
173 7         8 $token = substr($token,1);
174             }
175              
176             # Part 1: Identification Section
177 153 100 100     2726 if ($id eq '' and $token =~ /^[A-Z]{4}$/) {
    100          
    100          
    100          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    100          
    50          
    100          
    50          
    50          
    100          
    100          
    100          
    100          
    50          
    100          
    100          
    100          
    50          
    100          
    100          
178 7         9 $id = $token;
179 7         12 $out .= "for airport " . $token;
180             }
181             elsif ($token =~ /^(\d{2})(\d{2})(\d{2})Z$/) {
182 7         26 $out .= "issued day $1 at $2:$3 zulu";
183             }
184             elsif ($token =~ /^(\d{2})(\d{2})(\d{2})$/) {
185 2         10 $out .= "valid from day $1 at $2:00 to $3:00 zulu";
186             }
187             # Part 2: Observations Section
188             elsif ($token =~ /^00000KT$/) {
189 1         3 $out .= "wind light and variable";
190             }
191             elsif ($token =~ /^VRB(\d{2})KT$/) {
192 1         3 $out .= "variable wind direction at @{[int $1]} knots";
  1         6  
193             }
194             elsif ($token =~ /^(\d{3})V(\d{3})$/) {
195 0         0 $out .= "wind varies from $1 to $2";
196             }
197             elsif ($token =~ /^(\d{3})(\d{2})(G?)(\d+)?KT$/) {
198 11         27 $out .= "wind from $1 true at @{[int $2]} knots";
  11         40  
199 11 100       39 $out .= " gusts to $4" if $3 eq 'G';
200             }
201             elsif ($token =~ /^(\d{1,2})$/) {
202 3         15 $out .= "ground visibility $1";
203 3 50       8 if ($token = shift @tokens) {
204 3 50       12 if ($token =~ /^(\d+\/\d+)$/) {
205 0         0 $out .= " and $1 statute miles";
206             }
207             }
208             }
209             elsif ($token =~ /^(P?)(\d+)SM$/) {
210 11 100       16 $out .= "ground visibility @{[$1 eq 'P'?'more than ':'']}$2 statute miles";
  11         50  
211             }
212             elsif ($token =~ /^(\d+)\/(\d+)SM$/) {
213 2         7 $out .= "ground visibility $1/$2 statute miles ";
214             }
215             elsif ($token =~ /^R(\d{2})(L|C|R)\/(M|P)?(\d+)FT$/) {
216 1 50       4 $out .= "runway visibility for Rwy $1$2 is @{[$3 eq 'M'?'less than minimum of ':'']}@{[$3 eq 'M'?'more than maximum of ':'']}$4 feet";
  1 50       6  
  1         5  
217             }
218             elsif ($token =~ /^HZ$/) {
219 1         3 $out .= "weather hazard (or maybe just haze)";
220             }
221             # Part 3: Gauge Readings
222             elsif ($token =~ /^(M?)(\d{2,3})\/(M?)(\d{2,3})$/) {
223 5 100       9 $out .= "temperature @{[$1?'-':'']}@{[int($2)]} Celsius, dew point @{[$3?'-':'']}@{[int($4)]} Celsius.";
  5 100       24  
  5         17  
  5         17  
  5         16  
224             }
225             elsif ($token =~ /^A(\d{2})(\d{2})$/) {
226 5         18 $out .= "altimeter setting $1.$2 inches mercury";
227             }
228             elsif ($token =~ /^Q(\d{3})(\d)$/) {
229 0         0 $out .= "altimeter setting $1.$2 hectopascals";
230             }
231             # Part 4: Remarks and Coded Data
232             elsif ($token =~ /^AO(1|2)$/) {
233 3 50       8 $out .= "automated station type $1: @{[$1 eq '01'?'cannot detect precipitation':'has precipitation discriminator']}";
  3         15  
234             }
235             elsif ($token =~ /^P(\d{4})$/) {
236 2         4 $out .= "precipitation @{[$1/100]} inches in last hour";
  2         10  
237             }
238             elsif ($token =~ /^(\d{3})(\d{2})\/(\d{2})$/) {
239 1         31 $out .= "wind from $1 at $2 knots starting at $3 after the hour";
240             }
241             elsif ($token =~ /^1(0|1)(\d{3})$/) {
242 2 50       4 $out .= "max temp in last 6 hours @{[$1?'-':'']}@{[$2/10]} Celsius";
  2         14  
  2         13  
243             }
244             elsif ($token =~ /^2(0|1)(\d{3})$/) {
245 2 50       3 $out .= "min temp in last 6 hours @{[$1?'-':'']}@{[$2/10]} Celsius";
  2         10  
  2         15  
246             }
247             elsif ($token =~ /^4\/(\d{3})$/) {
248 0         0 $out .= "snow depth on ground is @{[$1]} inches";
  0         0  
249             }
250             elsif ($token =~ /^5(\d)(\d{3})$/) {
251 2         4 $out .= "3 hour pressure tendency ";
252 2 50       9 if ($1 eq '4') {
    50          
253 0         0 $out .= "stationary ";
254             }
255             elsif ($1 gt '4') {
256 0         0 $out .= "decreased ";
257             }
258             else {
259 2         3 $out .= "increased ";
260             }
261 2         9 $out .= $2/10 . " millibars";
262             }
263             elsif ($token =~ /^6(\d{4})$/) {
264 2         3 $out .= "3 and 6 hour precipitation @{[$1/100]} inches";
  2         11  
265             }
266             elsif ($token =~ /^7(\d{4})$/) {
267 0         0 $out .= "24 hour total precipitation @{[$1/100]} inches";
  0         0  
268             }
269             elsif ($token =~ /^8\/(\d)(\d)(\d)$/) {
270 2         12 $out .= "WMO cloud types $low[$1], $middle[$2], $high[$3]";
271             }
272             elsif ($token =~ /^98(\d{3})$/) {
273 0         0 $out .= "$1 minutes of sunshine during day";
274             }
275             elsif ($token =~ /^933(\d{3})$/) {
276 0         0 $out .= "standing water equivalent of @{[$1/10]} inches";
  0         0  
277             }
278             elsif ($token =~ /^SLP(\d{3})$/) {
279 3 50       5 $out .= "sea level Pressure @{[($1/10) + (($1<700)?1000:900)]} millibars";
  3         57  
280             }
281             elsif ($token =~ /^FM(\d{2})(\d{2})$/) {
282 6         15 $out .= "from $1:$2 zulu";
283             }
284             elsif ($token =~ /^PROB(\d{2})$/) {
285 1         4 $out .= "probability $1%";
286             }
287             elsif ($token =~ /^WS(\d{3})\/(\d{3})(\d{2,3})KT$/) { # TAF WS
288 1         5 $out .= "wind shear at $1 feet from $2 degrees at $3 knots";
289             }
290             elsif ($token =~ /^4(\d)(\d{3})(\d)(\d{3})$/) {
291 0 0       0 $out .= "max 6 hour temperature @{[$1?'-':'']}@{[$2/10]} Celsius, min 6 hour temp @{[$3?'-':'']}@{[$4/10]} Celsius";
  0 0       0  
  0         0  
  0         0  
  0         0  
292             }
293             elsif ($token =~ /^T(\d)(\d{3})(\d)(\d{3})$/) {
294 3 100       6 $out .= "temperature @{[$1?'-':'']}@{[$2/10]} Celsius, dew point @{[$3?'-':'']}@{[$4/10]} Celsius";
  3 50       14  
  3         25  
  3         14  
  3         17  
295             }
296             elsif ($token =~ /^([A-Z]{2})B(\d{2})$/) {
297 1 50       6 if (exists $abb{$1}) {
298 0         0 $out .= $abb{$1} . " began at $2 minutes after the hour";
299             }
300             else {
301 1         3 $out .= $token . "?";
302             }
303             }
304             elsif ($token =~ /^(\d{2})(\d{2})$/) {
305 3         10 $out .= "from $1:00 to $2:00";
306             }
307             # Miscellaneous Tokens
308             elsif (exists $abb{$token}) {
309 0         0 $out .= $abb{$token};
310             }
311             elsif ($token =~ /^([A-Z]{3})([0-9]+)(CB|TCU)?(VV)?(\d{3})?$/) {
312 18 50 100     161 if ($1 eq 'FEW' or $1 eq 'SCT' or $1 eq 'BKN' or $1 eq 'OVC') {
    0 100        
      66        
313 18         27 $out .= $abb{$1} . " clouds start at @{[$2 * 100]} feet AGL";
  18         82  
314             }
315             elsif (exists $abb{$1}) {
316 0         0 $out .= $abb{$1} . $2;
317             }
318             else {
319 0         0 $out .= $token . "?";
320             }
321              
322 18 100       62 if ($3 eq 'CB') {
    50          
323 1         2 $out .= " with cumulonimbus (rain)";
324             }
325             elsif ($3 eq 'TCU') {
326 0         0 $out .= " with towering cumulus";
327             }
328              
329 18 100       37 if ($4 eq 'VV') {
330 1         3 $out .= " vertical visibility (indefinite ceiling) $5 feet";
331             }
332             }
333             # supposed to be max 3 groups, BR should always be by itself
334             elsif ($token =~ /^([A-Z]{2,})$/) {
335 43         52 my $i = 0;
336 43         47 my $x = '';
337              
338 43         138 foreach (split //, $1) {
339 153         147 $i++;
340 153         158 $x .= $_;
341              
342 153 100       312 if ($i == 2) {
343 64 50       129 if (exists $abb{$x}) {
344 0         0 $out .= $abb{$x} . ' ';
345             }
346             else {
347 64         94 $out .= $x . "?";
348             }
349              
350 64         62 $i = 0;
351 64         110 $x = '';
352             }
353             }
354             }
355             else {
356 1         2 $out .= $token . "?";
357             }
358              
359 153         420 $out .= "\n";
360             }
361              
362 7         60 $out;
363             }
364              
365             =head1 NAME
366              
367             Aviation::Report - Perl extension for translating U.S. METAR, TAF and PIREP textual reports into plain English.
368              
369             =head1 SYNOPSIS
370              
371             use strict;
372             use Aviation::Report;
373              
374             print decode_METAR_TAF(report, style);
375             print decode_PIREP(report, style);
376              
377             =head1 DESCRIPTION
378              
379             Translates U.S. METAR, TAF and PIREP text reports into plain English.
380             Although the syntax of these reports is standardized, it is not as
381             obvious as it first appears to make correct translations.
382              
383             The style option controls the final appearance. A style of 0 emits
384             only plain English, while 1 includes the original tokens for
385             reference purposes.
386              
387             =head1 AUTHOR
388              
389             James Briggs <71022.3700@compuserve.com>
390              
391             =head1 SEE ALSO
392              
393             METAR.pm by Jeremy Zawodny
394              
395             =cut
396              
397             __END__