« back to all changes in this revision
Viewing changes to METAR.pm
- browse files at revision 2
- compare with another revision
- download diff
- download tarball
- view history from revision 2
- Committer: Bazaar Package Importer
- Author(s): Jay Bonci
- Date: 2004-10-27 14:39:56 UTC
- mfrom: (0.1.1 upstream) (1.1.1 warty)
- Revision ID: james.westby@ubuntu.com-20041027143956-67r5v7ahjmxqr36r
Tags: 1.14-5
* Change to POD formatting so URL doesn't break oddly (Closes: #272910)
* Make examples executable (Closes: #273082)
* Make examples executable (Closes: #273082)
added
removed
METAR.pm
1
# $Id: METAR.pm,v 1.4 1999/11/19 00:41:09 jzawodn Exp $
1
# $Id: METAR.pm,v 1.8 2000/11/25 00:07:38 jzawodn Exp $
2
2
3
3
# This module is used for decoding NWS METAR code.
4
4
95
95
96
96
# PRESSURE
97
97
#
98
# The pressure, or altimeter setting, at the reporting site recorded in
99
# inches of mercury (Hg) minus the decimal point. It should always look
100
# like (A\d\d\d\d).
98
# The pressure, or altimeter setting, at the reporting site recorded in inches
99
# of mercury (Hg) minus the decimal point. It should always look like
100
# (A\d\d\d\d).
101
#
102
# Note: The WMO standard is to report the altimeter in whole hectopascals. In
103
# this case, the altimeter setting group will be begin with a Q instead of an
104
# A.
101
105
102
106
# REMARKS
103
107
#
105
109
# informative of special conditions.
106
110
#
107
111
# Remarks begin with the "RMK" keyword and continue to the end of the line.
108
#
109
# This module currently doesn't attempt to decode remarks but may in the
110
# future.
111
112
112
113
### Package Definition
113
114
114
115
package Geo::METAR;
115
116
116
### Required Modules
117
118
require 5.004;
119
use Carp;
120
121
### Globals/Constants
122
123
my $revision = 'Revision: 1.13';
124
$revision =~ m/(\d+\.\d+)/;
125
$revision = $1;
126
$VERSION = $revision;
127
my $debug = 0;
128
129
130
### Begin Object Methods
131
132
# Constructor.
133
134
sub new {
117
## Required Modules
118
119
use 5.005;
120
use strict;
121
use vars qw($AUTOLOAD $VERSION);
122
use Carp 'cluck';
123
124
$VERSION = '1.14';
125
126
##
127
## Lookup tables
128
##
129
130
my %_weather_types = (
131
MI => 'shallow',
132
PI => 'partial',
133
BC => 'patches',
134
DR => 'drizzle',
135
BL => 'blowing',
136
SH => 'shower(s)',
137
TS => 'thunderstorm',
138
FZ => 'freezing',
139
140
DZ => 'drizzle',
141
RA => 'rain',
142
SN => 'snow',
143
SG => 'snow grains',
144
IC => 'ice crystals',
145
PE => 'ice pellets',
146
GR => 'hail',
147
GS => 'small hail/snow pellets',
148
UP => 'unknown precip',
149
150
BR => 'mist',
151
FG => 'fog',
152
FU => 'smoke',
153
VA => 'volcanic ash',
154
DU => 'dust',
155
SA => 'sand',
156
HZ => 'haze',
157
PY => 'spray',
158
159
PO => 'dust/sand whirls',
160
SQ => 'squalls',
161
FC => 'funnel cloud(tornado/waterspout)',
162
SS => 'sand storm',
163
DS => 'dust storm'
164
);
165
166
my $_weather_types_pat = join("|", keys(%_weather_types));
167
168
my %_sky_types = (
169
SKC => "Sky Clear",
170
CLR => "Sky Clear",
171
SCT => "Scattered",
172
BKN => "Broken",
173
FEW => "Few",
174
OVC => "Solid Overcast",
175
);
176
177
##
178
## Constructor.
179
##
180
181
sub new
182
{
135
183
my $this = shift;
136
184
my $class = ref($this) || $this;
137
185
my $self = {};
138
186
139
### Instance Variables
140
141
# UPPERCASE items have accssor functions (methods), while
142
# lowercase items are reserved for internal use.
187
##
188
## UPPERCASE items have documented accssor functions (methods) or
189
## use AUTOLOAD, while lowercase items are reserved for internal
190
## use.
191
##
143
192
144
193
$self->{VERSION} = $VERSION; # version number
145
194
$self->{METAR} = undef; # the actual, raw METAR
151
200
$self->{WIND_DIR_DEG} = undef; # wind dir in degrees
152
201
$self->{WIND_DIR_ENG} = undef; # wind dir in english (NW/SE)
153
202
$self->{WIND_KTS} = undef; # wind speed (knots)
154
$self->{WIND_KTS_GUST} = undef; # wind gusts (knots)
203
$self->{WIND_GUST_KTS} = undef; # wind gusts (knots)
155
204
$self->{WIND_MPH} = undef; # wind speed (MPH)
156
$self->{WIND_MPH_GUST} = undef; # wind gusts (MPH)
205
$self->{WIND_GUST_MPH} = undef; # wind gusts (MPH)
206
$self->{WIND_VAR_DEG} = undef; # wind variation in degrees
207
$self->{WIND_VAR_ENG} = undef; # wind variation in english
157
208
$self->{VISIBILITY} = undef; # visibility info
158
209
$self->{RUNWAY} = undef; # runyway vis.
159
210
$self->{WEATHER} = [ ]; # current weather
211
$self->{WEATHER_LOG} = [ ]; # weather log
160
212
$self->{SKY} = [ ]; # curent sky
161
$self->{C_TEMP} = undef; # current temp, celcius
162
$self->{F_TEMP} = undef; # converted to farenheit
163
$self->{C_DEW} = undef; # dew point, celcius
164
$self->{F_DEW} = undef; # dew point, farenheit
165
$self->{ALT} = undef; # altimeter setting [pressure]
213
$self->{TEMP_F} = undef; # current temp, celcius
214
$self->{TEMP_C} = undef; # converted to farenheit
215
$self->{DEW_F} = undef; # dew point, celcius
216
$self->{DEW_C} = undef; # dew point, farenheit
217
$self->{HOURLY_TEMP_F} = undef; # hourly current temp, celcius
218
$self->{HOURLY_TEMP_C} = undef; # hourly converted to farenheit
219
$self->{HOURLY_DEW_F} = undef; # hourly dew point, celcius
220
$self->{HOURLY_DEW_C} = undef; # hourly dew point, farenheit
221
$self->{HOURLY_PRECIP} = undef; # hourly precipitation
222
$self->{ALT} = undef; # altimeter setting (Hg)
223
$self->{ALT_HP} = undef; # altimeter setting (hPa)
224
$self->{SLP} = undef; # sea level pressure
166
225
$self->{REMARKS} = undef; # remarks and such
167
226
168
227
$self->{tokens} = [ ]; # the "token" list
170
229
# default=METAR
171
230
$self->{site} = undef; # the site code (4 chars)
172
231
$self->{date_time} = undef; # date/time
173
$self->{modifier} = "AUTO"; # the AUTO/COR modifier (if
174
# any) default=AUTO
232
$self->{modifier} = undef; # the AUTO/COR modifier
175
233
$self->{wind} = undef; # the wind information
234
$self->{vrbwind} = undef; # variable wind information
176
235
$self->{visibility} = undef; # visibility information
177
236
$self->{runway} = undef; # runway visibility
178
237
$self->{weather} = [ ]; # current weather conditions
179
238
$self->{sky} = [ ]; # sky conditions (cloud cover)
180
239
$self->{temp_dew} = undef; # temp and dew pt.
181
$self->{alt} = undef; # altimeter setting
240
$self->{alt} = undef; # altimeter setting (Hg)
241
$self->{alt_hp} = undef; # altimeter setting (hPa)
242
$self->{slp} = undef; # sea level pressure
182
243
$self->{remarks} = [ ]; # remarks
183
244
245
$self->{debug} = undef; # enable debug trace
184
246
185
247
bless $self, $class;
186
248
return $self;
187
249
}
188
250
189
# ----------------------------------------------- #
190
191
# Autoload for access methods to stuff in %fields hash
192
193
sub AUTOLOAD {
194
my $self = shift;
195
my $type = ref($self) || croak "$self is not an object";
196
my $name = $AUTOLOAD;
197
$name =~ s/.*:://; # strip fully-qualified portion of name
198
return if ($name eq 'DESTROY');
199
unless (exists $self->{$name}) {
200
croak "You suck. You tried to access something that is not here.";
201
}
202
return $self->{$name};
203
} # end AUTOLOAD
204
205
# ----------------------------------------------- #
206
207
# Get current version number.
208
209
sub version {
210
my $self = shift;
211
print "version() called.\n" if $debug;
251
##
252
## Autoload for access methods to stuff in %fields hash. We should
253
## probably disallow access to the lower-case items as stated above,
254
## but I don't feel like being a Nazi about it. Besides, I haven't
255
## checked to see what that might break.
256
##
257
258
sub AUTOLOAD
259
{
260
my $self = shift;
261
262
if (not ref $self)
263
{
264
cluck "bad AUTOLOAD for obj [$self]";
265
}
266
267
if ($AUTOLOAD =~ /.*::(.*)/)
268
{
269
my $key = $1;
270
271
272
## Backward compatible temps...
273
274
my %compat = (
275
F_TEMP => 'TEMP_F',
276
C_TEMP => 'TEMP_C',
277
F_DEW => 'DEW_F',
278
C_DEW => 'DEW_C',
279
);
280
281
if ($compat{$key})
282
{
283
$key = $compat{$key};
284
}
285
286
## Check for the items...
287
288
if (exists $self->{$key})
289
{
290
return $self->{$key};
291
}
292
else
293
{
294
return undef;
295
}
296
}
297
else
298
{
299
warn "strange AUTOLOAD problem!";
300
return undef;
301
}
302
}
303
304
##
305
## Get current version number.
306
##
307
308
sub version
309
{
310
my $self = shift;
311
print "version() called.\n" if $self->{debug};
212
312
return $self->{VERSION};
213
313
}
214
314
215
# ----------------------------------------------- #
315
##
316
## Take a METAR, tokenize, and process it.
317
##
216
318
217
sub metar {
319
sub metar
320
{
218
321
my $self = shift;
219
if (@_) {
220
$self->{METAR} = shift;
221
$self->{METAR} =~ s/\n//goi; # nuke any newlines
322
323
if (@_)
324
{
325
$self->{METAR} = shift;
326
$self->{METAR} =~ s/\n//g; ## nuke any newlines
222
327
_tokenize($self);
223
328
_process($self);
224
329
}
225
330
return $self->{METAR};
226
331
}
227
332
228
# ----------------------------------------------- #
229
230
# Break {METAR} into parts. Stuff into @tokens.
231
232
sub _tokenize {
333
##
334
## Break {METAR} into parts. Stuff into @tokens.
335
##
336
337
sub _tokenize
338
{
233
339
my $self = shift;
234
340
my $tok;
235
341
my @toks;
237
343
# Split tokens on whitespace.
238
344
@toks = split(/\s+/, $self->{METAR});
239
345
$self->{tokens} = \@toks;
240
241
346
}
242
347
243
# ----------------------------------------------- #
244
245
# Process @tokens to populate METAR values.
246
#
247
# This is a long and involved subroutine. It basically
248
# copies the @tokens array and treats it as a stack, popping
249
# off items, examining them, and see what they look like.
250
# Based on their "apppearance" it takes care populating the
251
# proper fields internally.
252
253
sub _process {
254
348
## Process @tokens to populate METAR values.
349
##
350
## This is a long and involved subroutine. It basically copies the
351
## @tokens array and treats it as a stack, popping off items,
352
## examining them, and see what they look like. Based on their
353
## "apppearance" it takes care populating the proper fields
354
## internally.
355
356
sub _process
357
{
255
358
my $self = shift;
256
359
257
360
my @toks = @{$self->{tokens}}; # copy tokens array...
258
361
259
362
my $tok;
260
261
# This is a semi-brute-force way of doing things, but the
262
# amount of data is relatively small, so it shouldn't be
263
# a big deal.
264
#
265
# Ideally, I'd have it skip checks for items which have
266
# been found, but that would make this more "linear" and
267
# I'd remove the pretty while loop.
268
269
while($tok = shift(@toks)) { # as long as there are tokens
270
271
print "trying to match [$tok]\n" if $debug;
272
273
# is it a report type?
274
275
if (($tok =~ /METAR/i) or ($tok =~ /SPECI/i)) {
363
my $in_remarks = 0; # started processing remarks
364
365
## This is a semi-brute-force way of doing things, but the amount
366
## of data is relatively small, so it shouldn't be a big deal.
367
##
368
## Ideally, I'd have it skip checks for items which have been
369
## found, but that would make this more "linear" and I'd remove
370
## the pretty while loop.
371
372
## Assume standard report by default
373
374
$self->{type} = "METAR";
375
$self->{TYPE} = "Routine Weather Report";
376
377
while (defined($tok = shift(@toks))) ## as long as there are tokens
378
{
379
print "trying to match [$tok]\n" if $self->{debug};
380
381
##
382
## is it a report type?
383
##
384
385
if (($tok =~ /METAR/i) or ($tok =~ /SPECI/i))
386
{
276
387
$self->{type} = $tok;
277
print "[$tok] is a report type.\n" if $debug;
388
389
if ($self->{type} eq "METAR")
390
{
391
$self->{TYPE} = "Routine Weather Report";
392
}
393
elsif ($self->{type} eq "SPECI")
394
{
395
$self->{TYPE} = "Special Weather Report";
396
}
397
print "[$tok] is a report type.\n" if $self->{debug};
278
398
next;
279
280
# is is a site ID?
281
} elsif ($tok =~ /K[A-Z]{3,3}/) {
399
}
400
401
##
402
## is is a site ID?
403
##
404
405
elsif ($tok =~ /^[A-Z]{4,4}$/ && !$self->{site})
406
{
282
407
$self->{site} = $tok;
283
print "[$tok] is a site ID.\n" if $debug;
408
print "[$tok] is a site ID.\n" if $self->{debug};
284
409
next;
285
286
# is it a date/time?
287
} elsif($tok =~ /\d{6,6}Z/i) {
410
}
411
412
##
413
## is it a date/time?
414
##
415
416
elsif ($tok =~ /\d{6,6}Z/i)
417
{
288
418
$self->{date_time} = $tok;
289
print "[$tok] is a date/time.\n" if $debug;
419
print "[$tok] is a date/time.\n" if $self->{debug};
290
420
next;
291
421
292
# is it a report modifier?
293
} elsif(($tok =~ /AUTO/i) or ($tok =~ /COR/i)) {
422
423
}
424
425
##
426
## is it a report modifier?
427
##
428
429
elsif (($tok =~ /AUTO/i) or ($tok =~ /COR/i))
430
{
294
431
$self->{modifier} = $tok;
295
print "[$tok] is a report modifier.\n" if $debug;
432
print "[$tok] is a report modifier.\n" if $self->{debug};
296
433
next;
297
298
# is it wind information?
299
} elsif($tok =~ /.*?KT$/i) {
434
}
435
436
##
437
## is it wind information?
438
##
439
440
elsif ($tok =~ /.*?KT$/i)
441
{
300
442
$self->{wind} = $tok;
301
print "[$tok] is wind information.\n" if $debug;
302
next;
303
304
# is it visibility information?
305
} elsif($tok =~ /.*?SM$/i) {
443
print "[$tok] is wind information.\n" if $self->{debug};
444
next;
445
}
446
447
##
448
## is it variable wind information?
449
##
450
451
elsif ($tok =~ /^\d\d\dV\d\d\d$/i)
452
{
453
$self->{vrbwind} = $tok;
454
print "[$tok] is variable wind information.\n" if $self->{debug};
455
next;
456
}
457
458
##
459
## is it visibility information?
460
##
461
462
elsif ($tok =~ /.*?SM$/i)
463
{
306
464
$self->{visibility} = $tok;
307
print "[$tok] is visibility information.\n" if $debug;
465
print "[$tok] is visibility information.\n" if $self->{debug};
308
466
next;
309
310
# is it visibility information with a leading digit?
311
} elsif($tok =~ /^\d$/) {
312
467
}
468
469
##
470
## does it say CAVOK? (ceiling and visibility ok)
471
##
472
473
elsif ($tok =~ /^CAVOK/i)
474
{
475
$self->{visibility} = $tok;
476
print "[$tok] is visibility information, too.\n" if $self->{debug};
477
next;
478
}
479
480
##
481
## is it visibility information with a leading digit?
482
##
483
484
elsif ($tok =~ /^\d$/)
485
{
313
486
$tok .= " " . shift(@toks);
314
487
$self->{visibility} = $tok;
315
print "[$tok is multi-part visibility information.\n" if $debug;
488
print "[$tok is multi-part visibility information.\n" if $self->{debug};
316
489
next;
317
318
# is it runway visibility info?
319
} elsif($tok =~ /R.*?FT$/i) {
490
}
491
492
##
493
## is it runway visibility info?
494
##
495
496
elsif ($tok =~ /R.*?FT$/i)
497
{
320
498
$self->{runway} = $tok;
321
print "[$tok] is runway visual information.\n" if $debug;
499
print "[$tok] is runway visual information.\n" if $self->{debug};
322
500
next;
323
324
# is it current weather info?
325
} elsif($tok =~ /^(-|\+|VC)?(TS|SH|FZ|BL|DR|MI|BC|PR|RA|DZ|SN|SG|GR|GS|PE|IC|UP|BR|FG|FU|VA|DU|SA|HZ|PY|PO|SQ|FC|SS|DS)+$/) {
501
}
502
503
##
504
## is it current weather info?
505
##
506
507
elsif ($tok =~ /^(-|\+)?(VC)?($_weather_types_pat)+/i)
508
{
509
my $engl = "";
510
my $qual = $1;
511
my $addlqual = $2;
512
513
## qualifier
514
515
if (defined $qual)
516
{
517
if ( $qual eq "-" ) {
518
$engl = "light";
519
} elsif ( $qual eq "+" ) {
520
$engl = "heavy";
521
} else {
522
$engl = ""; ## moderate
523
}
524
}
525
else
526
{
527
$engl = ""; ## moderate
528
}
529
530
while ( $tok =~ /($_weather_types_pat)/gi )
531
{
532
$engl .= " " . $_weather_types{$1}; ## figure out weather
533
}
534
535
## addl qualifier
536
537
if (defined $addlqual)
538
{
539
if ( $addlqual eq "VC" )
540
{
541
$engl .= " in vicinity";
542
}
543
}
544
545
$engl =~ s/^\s//gio;
546
$engl =~ s/\s\s/ /gio;
547
548
push(@{$self->{WEATHER}},$engl);
326
549
327
550
push(@{$self->{weather}},$tok);
328
print "[$tok] is current weather.\n" if $debug;
329
next;
330
331
# is it sky conditions (clouds)?
332
} elsif(($tok =~ /SKC|CLR/i) or
333
($tok =~ /(FEW|SCT|BKN|OVC)(\d\d\d)(CB|TCU)?$/i)) {
334
335
push(@{$self->{sky}},$tok);
336
print "[$tok] is a sky condition.\n" if $debug;
337
next;
338
339
# is it temperature and dew point info?
340
} elsif($tok =~ /(M?\d\d)\/(M?\d\d)/i) {
551
print "[$tok] is current weather.\n" if $self->{debug};
552
next;
553
}
554
555
##
556
## is it sky conditions (clear)?
557
##
558
559
elsif ( $tok eq "SKC" || $tok eq "CLR" )
560
{
561
push(@{$self->{sky}},$tok);
562
push(@{$self->{SKY}}, "Sky Clear");
563
}
564
565
##
566
## is it sky conditions (clouds)?
567
##
568
569
elsif ( $tok =~ /^(FEW|SCT|BKN|OVC|SKC|CLR)(\d\d\d)?(CB|TCU)?$/i)
570
{
571
push(@{$self->{sky}},$tok);
572
my $engl = "";
573
574
$engl = $_sky_types{$1};
575
576
if (defined $3)
577
{
578
if ($3 eq "TCU")
579
{
580
$engl .= " Towering Cumulus";
581
}
582
elsif ($3 eq "CB")
583
{
584
$engl .= " Cumulonimbus";
585
}
586
}
587
588
if ($2 ne "")
589
{
590
my $agl = int($2)*100;
591
$engl .= " at $agl" . "ft";
592
}
593
594
push(@{$self->{SKY}}, $engl);
595
print "[$tok] is a sky condition.\n" if $self->{debug};
596
next;
597
}
598
599
##
600
## is it temperature and dew point info?
601
##
602
603
elsif ($tok =~ /(M?\d\d)\/(M?\d\d)/i)
604
{
341
605
next if $self->{temp_dew};
342
606
$self->{temp_dew} = $tok;
343
print "[$tok] is temperature/dew point information.\n" if $debug;
607
608
$self->{TEMP_C} = $1;
609
$self->{DEW_C} = $2;
610
$self->{TEMP_C} =~ s/^M/-/;
611
$self->{DEW_C} =~ s/^M/-/;
612
613
print "[$tok] is temperature/dew point information.\n" if $self->{debug};
344
614
next;
345
346
# is it an altimeter setting?
347
} elsif($tok =~ /A\d{4,4}$/i) {
348
615
}
616
617
##
618
## is it an altimeter setting? (inches in mercury)
619
##
620
621
elsif (!$in_remarks && $tok =~ /^A(\d\d)(\d\d)$/i)
622
{
349
623
$self->{alt} = $tok;
350
print "[$tok] is an altimeter setting.\n" if $debug;
351
next;
352
353
# remarks?
354
} elsif($tok =~ /^RMK$/i) {
355
356
push(@{$self->{remarks}},$tok);
357
print "[$tok] is a remark.\n" if $debug;
358
next;
359
360
# unknown. assume remarks
361
} else {
362
363
push(@{$self->{remarks}},$tok);
364
print "[$tok] is unknown. Assuming remarks.\n" if $debug;
365
next;
366
}
367
368
} # end while
369
370
# Now that the internal stuff is set, let's do the external
371
# stuff.
372
373
if ($self->{type} eq "METAR") {
374
$self->{TYPE} = "Routine Weather Report";
624
$self->{ALT} = "$1.$2";
625
print "[$tok] is an altimeter setting.\n" if $self->{debug};
626
next;
627
}
628
629
##
630
## is it an altimeter setting? (hectopascals)
631
632
elsif (!$in_remarks && $tok =~ /^Q(\d\d\d\d)$/i)
633
{
634
$self->{alt_hp} = $tok;
635
$self->{ALT_HP} = $1;
636
print "[$tok] is an altimeter setting in hectopascals.\n"
637
if $self->{debug};
638
next;
639
}
640
641
##
642
## automatic station type?
643
##
644
645
elsif ($in_remarks && $tok =~ /^A(O\d)$/i)
646
{
647
$self->{autostationtype} = $tok;
648
$self->{AUTO_STATIONTYPE} = $1;
649
print "[$tok] is an automatic station type remark.\n" if $self->{debug};
650
next;
651
}
652
653
##
654
## remarks?
655
##
656
657
elsif ($tok =~ /^RMK$/i)
658
{
659
push(@{$self->{remarks}},$tok);
660
$in_remarks = 1;
661
print "[$tok] is a remark.\n" if $self->{debug};
662
next;
663
}
664
665
##
666
## sea level pressure
667
##
668
669
elsif ($tok =~ /^SLP(\d+)/i)
670
{
671
$self->{slp} = $tok;
672
$self->{SLP} = "$1 mb";
673
print "[$tok] is a sea level pressure.\n" if $self->{debug};
674
next;
675
}
676
677
##
678
## sea level pressure not available
679
##
680
681
elsif ($tok eq "SLPNO")
682
{
683
$self->{slp} = "SLPNO";
684
$self->{SLP} = "not available";
685
print "[$tok] is a sea level pressure.\n" if $self->{debug};
686
next;
687
}
688
689
##
690
## hourly precipitation
691
##
692
693
elsif ($tok =~ /^P(\d\d\d\d)$/i)
694
{
695
$self->{hourlyprecip} = $tok;
696
697
if ( $1 eq "0000" ) {
698
$self->{HOURLY_PRECIP} = "Trace";
699
} else {
700
$self->{HOURLY_PRECIP} = $1;
701
}
702
}
703
704
##
705
## weather begin/end times
706
##
707
708
elsif ($tok =~ /^($_weather_types_pat)([BE\d]+)$/i)
709
{
710
my $engl = "";
711
my $times = $2;
712
713
$self->{weatherlog} = $tok;
714
715
$engl = $_weather_types{$1};
716
717
while ( $times =~ /(B|E)(\d\d)/g )
718
{
719
if ( $1 eq "B" ) {
720
$engl .= " began :$2";
721
} else {
722
$engl .= " ended :$2";
723
}
724
}
725
726
push(@{$self->{WEATHER_LOG}}, $engl);
727
print "[$tok] is a weather log.\n" if $self->{debug};
728
next;
729
}
730
731
##
732
## remarks for significant cloud types
733
##
734
735
elsif ($in_remarks && ($tok eq "CB" || $tok eq "TCU"))
736
{
737
push(@{$self->{sigclouds}}, $tok);
738
739
if ( $tok eq "CB" ) {
740
push(@{$self->{SIGCLOUDS}}, "Cumulonimbus");
741
} elsif ( $tok eq "TCU" ) {
742
push(@{$self->{SIGCLOUDS}}, "Towering Cumulus");
743
}
744
}
745
746
##
747
## hourly temp/dewpoint
748
##
749
750
elsif ($tok =~ /^T(\d)(\d\d)(\d)(\d)(\d\d)(\d)$/i)
751
{
752
$self->{hourlytempdew} = $tok;
753
if ( $1 == 1 ) {
754
$self->{HOURLY_TEMP_C} = "-";
755
}
756
$self->{HOURLY_TEMP_C} .= "$2.$3";
757
758
$self->{HOURLY_DEW_C} = "";
759
if ( $4 == 1 ) {
760
$self->{HOURLY_DEW_C} = "-";
761
}
762
$self->{HOURLY_DEW_C} .= "$5.$6";
763
764
print "[$tok] is a hourly temp and dewpoint.\n" if $self->{debug};
765
next;
766
}
767
768
##
769
## unknown, not in remarks yet
770
##
771
772
elsif (!$in_remarks)
773
{
774
push(@{$self->{unknown}},$tok);
775
push(@{$self->{UNKNOWN}},$tok);
776
print "[$tok] is unknown.\n" if $self->{debug};
777
next;
778
}
779
780
##
781
## unknown. assume remarks
782
##
783
784
else
785
{
786
push(@{$self->{remarks}},$tok);
787
push(@{$self->{REMARKS}},$tok);
788
print "[$tok] is unknown remark.\n" if $self->{debug};
789
next;
790
}
791
375
792
}
793
794
##
795
## Now that the internal stuff is set, let's do the external
796
## stuff.
797
##
798
376
799
$self->{SITE} = $self->{site};
377
800
$self->{DATE} = substr($self->{date_time},0,2);
378
801
$self->{TIME} = substr($self->{date_time},2,4) . " UTC";
379
802
$self->{TIME} =~ s/(\d\d)(\d\d)/$1:$2/o;
380
803
$self->{MOD} = $self->{modifier};
381
804
382
# Okay, wind finally gets interesting.
805
##
806
## Okay, wind finally gets interesting.
807
##
383
808
384
809
{
385
810
my $wind = $self->{wind};
409
834
} elsif ($dir_deg < 195) {
410
835
$dir_eng = "South";
411
836
} elsif ($dir_deg < 210) {
412
$dir_eng = "South/Southeast";
837
$dir_eng = "South/Southwest";
413
838
} elsif ($dir_deg < 240) {
414
839
$dir_eng = "Southwest";
415
840
} elsif ($dir_deg < 265) {
416
$dir_eng = "South/Southwest";
841
$dir_eng = "West/Southwest";
417
842
} elsif ($dir_deg < 285) {
418
843
$dir_eng = "West";
419
844
} elsif ($dir_deg < 300) {
425
850
} else {
426
851
$dir_eng = "North";
427
852
}
428
} # end if
853
}
429
854
430
855
$wind =~ /...(\d\d\d?)/o;
431
856
my $kts_speed = $1;
436
861
if ($wind =~ /.{5,6}G(\d\d\d?)/o) {
437
862
$kts_gust = $1;
438
863
$mph_gust = $kts_gust * 1.1508;
439
} # end if
864
}
440
865
441
866
$self->{WIND_KTS} = $kts_speed;
442
867
$self->{WIND_MPH} = $mph_speed;
443
868
444
$self->{WIND_KTS_GUST} = $kts_gust;
445
$self->{WIND_MPH_GUST} = $mph_gust;
869
$self->{WIND_GUST_KTS} = $kts_gust;
870
$self->{WIND_GUST_MPH} = $mph_gust;
446
871
447
872
$self->{WIND_DIR_DEG} = $dir_deg;
448
873
$self->{WIND_DIR_ENG} = $dir_eng;
449
874
450
} # end wind block
451
452
# Visibility, now.
453
454
{
455
my $vis = $self->{visibility};
456
$vis =~ s/SM$//oi; # nuke the "SM"
457
if ($vis =~ /M(\d\/\d)/o) {
458
$self->{VISIBILITY} = "Less than $1 statute miles";
459
} else {
460
$self->{VISIBILITY} = $vis . " Statute Miles";
461
} # end if
462
463
} # end visibility block
464
465
# And F/C temperatures.
466
467
{
468
my ($tmp,$dew) = split(/\//, $self->{temp_dew});
469
470
# check for negative values
471
$tmp =~ s/^M/-/o;
472
$dew =~ s/^M/-/o;
473
474
# convert celcius to farenheit
475
$self->{C_TEMP} = $tmp;
476
$self->{F_TEMP} = (($tmp * (9/5)) + 32);
477
$self->{C_DEW} = $dew;
478
$self->{F_DEW} = (($dew * (9/5)) + 32);
479
}
480
875
}
876
877
##
878
## Variable wind information
879
##
880
881
{
882
if ($self->{vrbwind}) {
883
my $vrbwind = $self->{vrbwind};
884
my $vrbwind_deg_1 = substr($vrbwind,0,3);
885
my $vrbwind_deg_2 = substr($vrbwind,4,3);
886
my $vrbwind_eng_1 = "";
887
my $vrbwind_eng_2 = "";
888
889
if ($vrbwind_deg_1 < 15) { $vrbwind_eng_1 = "North"; }
890
elsif ($vrbwind_deg_1 < 30) { $vrbwind_eng_1 = "North/Northeast"; }
891
elsif ($vrbwind_deg_1 < 60) { $vrbwind_eng_1 = "Northeast"; }
892
elsif ($vrbwind_deg_1 < 75) { $vrbwind_eng_1 = "East/Northeast"; }
893
elsif ($vrbwind_deg_1 < 105) { $vrbwind_eng_1 = "East"; }
894
elsif ($vrbwind_deg_1 < 120) { $vrbwind_eng_1 = "East/Southeast"; }
895
elsif ($vrbwind_deg_1 < 150) { $vrbwind_eng_1 = "Southeast"; }
896
elsif ($vrbwind_deg_1 < 165) { $vrbwind_eng_1 = "South/Southeast"; }
897
elsif ($vrbwind_deg_1 < 195) { $vrbwind_eng_1 = "South"; }
898
elsif ($vrbwind_deg_1 < 210) { $vrbwind_eng_1 = "South/Southwest"; }
899
elsif ($vrbwind_deg_1 < 240) { $vrbwind_eng_1 = "Southwest"; }
900
elsif ($vrbwind_deg_1 < 265) { $vrbwind_eng_1 = "West/Southwest"; }
901
elsif ($vrbwind_deg_1 < 285) { $vrbwind_eng_1 = "West"; }
902
elsif ($vrbwind_deg_1 < 300) { $vrbwind_eng_1 = "West/Northwest"; }
903
elsif ($vrbwind_deg_1 < 330) { $vrbwind_eng_1 = "Northwest"; }
904
elsif ($vrbwind_deg_1 < 345) { $vrbwind_eng_1 = "North/Northwest"; }
905
else { $vrbwind_eng_1 = "North"; }
906
907
if ($vrbwind_deg_2 < 15) { $vrbwind_eng_2 = "North"; }
908
elsif ($vrbwind_deg_2 < 30) { $vrbwind_eng_2 = "North/Northeast"; }
909
elsif ($vrbwind_deg_2 < 60) { $vrbwind_eng_2 = "Northeast"; }
910
elsif ($vrbwind_deg_2 < 75) { $vrbwind_eng_2 = "East/Northeast"; }
911
elsif ($vrbwind_deg_2 < 105) { $vrbwind_eng_2 = "East"; }
912
elsif ($vrbwind_deg_2 < 120) { $vrbwind_eng_2 = "East/Southeast"; }
913
elsif ($vrbwind_deg_2 < 150) { $vrbwind_eng_2 = "Southeast"; }
914
elsif ($vrbwind_deg_2 < 165) { $vrbwind_eng_2 = "South/Southeast"; }
915
elsif ($vrbwind_deg_2 < 195) { $vrbwind_eng_2 = "South"; }
916
elsif ($vrbwind_deg_2 < 210) { $vrbwind_eng_2 = "South/Southwest"; }
917
elsif ($vrbwind_deg_2 < 240) { $vrbwind_eng_2 = "Southwest"; }
918
elsif ($vrbwind_deg_2 < 265) { $vrbwind_eng_2 = "West/Southwest"; }
919
elsif ($vrbwind_deg_2 < 285) { $vrbwind_eng_2 = "West"; }
920
elsif ($vrbwind_deg_2 < 300) { $vrbwind_eng_2 = "West/Northwest"; }
921
elsif ($vrbwind_deg_2 < 330) { $vrbwind_eng_2 = "Northwest"; }
922
elsif ($vrbwind_deg_2 < 345) { $vrbwind_eng_2 = "North/Northwest"; }
923
else { $vrbwind_eng_2 = "North"; }
924
925
push @{$self->{WIND_VAR_DEG}}, $vrbwind_deg_1;
926
push @{$self->{WIND_VAR_DEG}}, $vrbwind_deg_2;
927
push @{$self->{WIND_VAR_ENG}}, $vrbwind_eng_1;
928
push @{$self->{WIND_VAR_ENG}}, $vrbwind_eng_2;
929
}
930
}
931
932
##
933
## Visibility.
934
##
935
936
{
937
if ($self->{visibility}) {
938
my $vis = $self->{visibility};
939
$vis =~ s/SM$//oi; # nuke the "SM"
940
if ($vis =~ /^CAVOK$/i) {
941
$self->{VISIBILITY} = "Ceiling and visibility OK";
942
}
943
elsif ($vis =~ /M(\d\/\d)/o) {
944
$self->{VISIBILITY} = "Less than $1 statute miles";
945
} else {
946
$self->{VISIBILITY} = $vis . " Statute Miles";
947
} # end if
948
}
949
}
950
951
##
952
## Convert ALT to ALT_HP or vice versa
953
##
954
955
{
956
if ($self->{ALT} && !$self->{ALT_HP}) {
957
my $alt = $self->{ALT};
958
$alt = $alt * 1.33; # mmHg to hPa
959
$self->{ALT_HP} = $alt;
960
}
961
elsif (!$self->{ALT} && $self->{ALT_HP}) {
962
my $alt = $self->{ALT_HP};
963
$alt = $alt * 0.75; # hPa to mmHg
964
$self->{ALT} = $alt;
965
}
966
}
967
968
##
969
## Calculate F temps for all C temps
970
##
971
972
foreach my $key ( keys(%$self) )
973
{
974
if ( uc($key) eq $key && $key =~ /^(.*)_C$/ )
975
{
976
my $fkey = $1 . "_F";
977
978
next unless defined $self->{$key};
979
980
$self->{$fkey} = sprintf("%.1f", (($self->{$key} * (9/5)) + 32));
981
}
982
}
481
983
}
482
984
483
# ----------------------------------------------- #
985
##
986
## Print the tokens--usually when debugging.
987
##
484
988
485
sub print_tokens {
989
sub print_tokens
990
{
486
991
my $self = shift;
487
992
my $tok;
488
993
foreach $tok (@{$self->{tokens}}) {
490
995
}
491
996
}
492
997
493
# ----------------------------------------------- #
998
##
999
## Turn debugging on/off.
1000
##
494
1001
495
sub debug {
1002
sub debug
1003
{
496
1004
my $self = shift;
497
1005
my $flag = shift;
498
499
return $debug unless defined $flag;
1006
return $self->{debug} unless defined $flag;
500
1007
501
1008
if (($flag eq "Y") or ($flag eq "y") or ($flag == 1)) {
502
$debug = 1;
1009
$self->{debug} = 1;
503
1010
} elsif (($flag eq "N") or ($flag eq "n") or ($flag == 0)) {
504
$debug = 0;
1011
$self->{debug} = 0;
505
1012
}
506
return $debug;
1013
1014
return $self->{debug};
507
1015
}
508
1016
509
# ----------------------------------------------- #
510
511
# Dump internal data structure. Useful for debugging and such.
512
513
sub dump {
514
1017
##
1018
## Dump internal data structure. Useful for debugging and such.
1019
##
1020
1021
sub dump
1022
{
515
1023
my $self = shift;
516
1024
517
1025
print "METAR dump follows.\n\n";
521
1029
print "date_time: $self->{date_time}\n";
522
1030
print "modifier: $self->{modifier}\n";
523
1031
print "wind: $self->{wind}\n";
1032
print "variable wind: $self->{vrbwind}\n";
524
1033
print "visibility: $self->{visibility}\n";
525
1034
print "runway: $self->{runway}\n";
526
1035
print "weather: " . join(', ', @{$self->{weather}}) . "\n";
527
1036
print "sky: " . join(', ', @{$self->{sky}}) . "\n";
528
1037
print "temp_dew: $self->{temp_dew}\n";
529
1038
print "alt: $self->{alt}\n";
1039
print "alt_hp: $self->{alt_hp}\n";
1040
print "slp: $self->{slp}\n";
530
1041
print "remarks: " . join (', ', @{$self->{remarks}}) . "\n";
531
1042
print "\n";
532
print "VERSION: $self->{VERSION}\n";
533
print "METAR: $self->{METAR}\n";
534
print "TYPE: $self->{TYPE}\n";
535
print "SITE: $self->{SITE}\n";
536
print "DATE: $self->{DATE}\n";
537
print "TIME: $self->{TIME}\n";
538
print "MOD: $self->{MOD}\n";
539
print "WIND_DIR_DEG: $self->{WIND_DIR_DEG}\n";
540
print "WIND_DIR_ENG: $self->{WIND_DIR_ENG}\n";
541
print "WIND_KTS: $self->{WIND_KTS}\n";
542
print "WIND_MPH: $self->{WIND_MPH}\n";
543
print "WIND_KTS_GUST: $self->{WIND_KTS_GUST}\n";
544
print "WIND_MPH_GUST: $self->{WIND_MPH_GUST}\n";
545
print "VISIBILITY: $self->{VISIBILITY}\n";
546
print "C_TEMP: $self->{C_TEMP}\n";
547
print "F_TEMP: $self->{F_TEMP}\n";
548
print "C_DEW: $self->{C_DEW}\n";
549
print "F_DEW: $self->{F_DEW}\n";
1043
1044
foreach my $var ( sort(keys(%$self)) )
1045
{
1046
next if ( uc($var) ne $var );
1047
1048
if ( ref($self->{$var}) eq "ARRAY" )
1049
{
1050
print "$var: ", join(", ", @{$self->{$var}}), "\n";
1051
}
1052
else
1053
{
1054
print "$var: ", $self->{$var}, "\n";
1055
}
1056
}
550
1057
}
551
1058
552
# ----------------------------------------------- #
553
# ----------------------------------------------- #
554
# ----------------------------------------------- #
555
# ----------------------------------------------- #
556
# ----------------------------------------------- #
557
558
1059
1;
559
1060
560
1061
__END__
561
1062
562
1063
=head1 NAME
563
1064
564
METAR - Process routine aviation weather reports in the METAR format.
1065
Geo::METAR - Process aviation weather reports in the METAR format.
565
1066
566
1067
=head1 SYNOPSIS
567
1068
569
1070
use strict;
570
1071
571
1072
my $m = new Geo::METAR;
572
$m->metar("KFDY 251450Z 21012G21KT 8SM OVC065 04/M01 A3010 RMK 57014 ");
1073
$m->metar("KFDY 251450Z 21012G21KT 8SM OVC065 04/M01 A3010 RMK 57014");
573
1074
print $m->dump;
574
1075
575
1076
exit;
588
1089
Here is how you I<might> use the Geo::METAR module.
589
1090
590
1091
One use that I have had for this module is to query the NWS METAR page
591
(using the LWP modules) at
592
http://weather.noaa.gov/cgi-bin/mgetmetar.pl?cccc=KFDY to get an
593
up-to-date METAR. Then, I scan thru the output, looking for what looks
594
like a METAR string (that's not hard in Perl). Oh, KFDY can be any site
1092
(using the LWP modules) at:
1093
1094
I<http://weather.noaa.gov/cgi-bin/mgetmetar.pl?cccc=KFDY>
1095
1096
to get an up-to-date METAR. Then, I scan thru the output, looking for what
1097
looks like a METAR string (that's not hard in Perl). Oh, KFDY can be any site
595
1098
location code where there is a reporting station.
596
1099
597
1100
I then pass the METAR into this module and get the info I want. I can
706
1209
707
1210
=item WIND_DIR_ENG
708
1211
709
The current wind direction in english (Southwest, East, North, etc.)
1212
The current wind direction in English (Southwest, East, North, etc.)
710
1213
711
1214
=item WIND_DIR_DEG
712
1215
713
1216
The current wind direction in degrees.
714
1217
1218
=item WIND_VAR_ENG
1219
1220
Variable wind direction in English.
1221
1222
=item WIND_VAR_DEG
1223
1224
Variable wind direction in degrees.
1225
715
1226
=item WIND_KTS
716
1227
717
1228
The current wind speed in Knots.
720
1231
721
1232
The current wind speed in Miles Per Hour.
722
1233
723
=item WIND_KTS_GUST
1234
=item WIND_GUST_KTS
724
1235
725
1236
The current wind gusting speed in Knots.
726
1237
727
=item WIND_MPH_GUST
1238
=item WIND_GUST_MPH
728
1239
729
1240
The current wind gusting speed in Miles Per Hour.
730
1241
748
1259
749
1260
Current sky conditions.
750
1261
751
=item C_TEMP
1262
=item TEMP_C
752
1263
753
1264
Temperature in Celsius.
754
1265
755
=item F_TEMP
1266
=item TEMP_F
756
1267
757
1268
Temperature in Farenheit.
758
1269
768
1279
769
1280
Altimeter setting (barometric pressure).
770
1281
1282
=item ALT_HP
1283
1284
Altimeter setting in hectopascals.
1285
771
1286
=item REMARKS
772
1287
773
1288
Any remarks in the report.
792
1307
793
1308
=head1 BUGS
794
1309
795
The only known bug was corrected in the latest release. Please report
796
any bugs that you find.
1310
There currently aren't any known BUGS (features which don't work as
1311
advetised). There are lacking features. See the TODO section for more
1312
on that.
1313
1314
=head1 TODO
1315
1316
There is a TODO file included in the Geo::METAR distribution listing
1317
the outstanding tasks that I or others have devised. Please check that
1318
list before you submit a bug report or request a new feture. It might
1319
already be on the TODO list.
797
1320
798
1321
=head1 AUTHOR AND COPYRIGHT
799
1322
800
Copyright 1997-99, Jeremy D. Zawodny <Jeremy@Zawodny.com>
1323
Copyright 1997-2000, Jeremy D. Zawodny <Jeremy@Zawodny.com>
801
1324
802
1325
Geo::METAR is covered under the GNU Public License (GPL) version 2 or
803
1326
later.
806
1329
807
1330
http://www.wcnet.org/~jzawodn/perl/Geo-METAR/
808
1331
1332
=head1 CREDITS
1333
1334
In addition to my work on Geo::METAR, I've received ideas, help, and
1335
patches from the following folks:
1336
1337
* Otterboy <jong@watchguard.com>
1338
1339
Random script fixes and initial debugging help
1340
1341
* Remi Lefebvre <remi@solaria.dhis.org>
1342
1343
Debian packaging as libgeo-metar-perl.deb.
1344
1345
* Mike Engelhart <mengelhart@earthtrip.com>
1346
1347
Wind direction naming corrections.
1348
1349
* Michael Starling <mstarling@logic.bm>
1350
1351
Wind direction naming corrections.
1352
1353
* Hans Einar Nielssen <hans.einar@nielssen.com>
1354
1355
Wind direction naming corrections.
1356
1357
* Nathan Neulinger <nneul@umr.edu>
1358
1359
Lots of enhancements and corrections. Too many to list here.
1360
809
1361
=cut
1362
1363
1364
Loggerhead is a web-based interface for Breezy
Version: 2.0.1