File Coverage

blib/lib/Geo/WeatherNWS.pm
Criterion Covered Total %
statement 277 403 68.7
branch 103 170 60.5
condition 46 83 55.4
subroutine 19 27 70.3
pod 20 20 100.0
total 465 703 66.1


line stmt bran cond sub pod time code
1             package Geo::WeatherNWS;
2              
3             #------------------------------------------------------------------------------
4             #
5             # Package Name: Get Observations from NWS (Geo::WeatherNWS)
6             #
7             # Last Modified: 18 December 2001 - Prepared for CPAN - Marc Slagle
8             # 24 February 2002 - Adding server/error code - Marc
9             # 10 August 2011 - changed FTP server name, added tests,
10             # docs, some restructuring. - Bob Ernst
11             # 14 November 2012 - removed unneeded /d after tr,
12             # make network tests optional,
13             # check status of opens - Bob
14             # 26 November 2012 - Address bug 14632 (METAR Decoding) from dstroma
15             # Address bug 27513 (Geo-WeatherNWS returns wrong station code)
16             # from Guenter Knauf
17             # Fix issues with undefined values,
18             # Change some conversion constants,
19             # Round instead of truncate results,
20             # Only calculate windchill for proper range,
21             # "ptemerature" is now spelled "ptemperature"
22             # Fixed handling of condition text
23             # Relax ICAO naming rules
24             # Change ICAO website
25             # Change http web site from weather.noaa.gov
26             # to www.aviationweather.gov, and change parsing to match.
27             # Add report_date and report_time items.
28             # - Bob
29             # 27 November 2012 - Add POD documentation for new functions.
30             # 1 January 2017 - Switched from POSIX module to File::Temp
31             #
32             #
33             #------------------------------------------------------------------------------
34              
35             #------------------------------------------------------------------------------
36             # We need these
37             #------------------------------------------------------------------------------
38              
39             require 5.005_62;
40 5     5   256357 use strict;
  5         61  
  5         117  
41 5     5   33 use warnings;
  5         6  
  5         102  
42 5     5   2380 use Net::FTP;
  5         418594  
  5         232  
43 5     5   37 use IO::Handle;
  5         9  
  5         134  
44 5     5   2890 use File::Temp;
  5         46698  
  5         282  
45 5     5   29 use Carp;
  5         10  
  5         5230  
46              
47             #------------------------------------------------------------------------------
48             # Version
49             #------------------------------------------------------------------------------
50              
51             our $VERSION = '1.054';
52              
53             #------------------------------------------------------------------------------
54             # Round function
55             # Using Math::Round would add another dependency
56             #------------------------------------------------------------------------------
57              
58             sub round {
59 149     149 1 249 my $float = shift;
60 149         148 my $rounded;
61              
62 149 100       201 if ( defined $float ) {
63 132         223 $rounded = sprintf "%.0f", $float;
64             }
65 149         270 return $rounded;
66             }
67              
68             #------------------------------------------------------------------------------
69             # Temperature conversion
70             # If the temperature we are converting from is undefined,
71             # then the temperature we are converting to is also undefined.
72             #------------------------------------------------------------------------------
73              
74             sub convert_f_to_c {
75 20     20 1 26 my $fahrenheit = shift;
76 20         22 my $celsius;
77              
78 20 100       38 if (defined $fahrenheit) {
79 11         19 $celsius = (5.0/9.0) * ($fahrenheit - 32.0);
80             }
81 20         34 return $celsius;
82             }
83              
84             sub convert_c_to_f {
85 20     20 1 28 my $celsius = shift;
86 20         22 my $fahrenheit;
87              
88 20 100       31 if (defined $celsius) {
89 19         34 $fahrenheit = ((9.0/5.0) * $celsius) + 32.0;
90             }
91 20         41 return $fahrenheit;
92             }
93              
94             #------------------------------------------------------------------------------
95             # Windchill
96             #------------------------------------------------------------------------------
97              
98             sub windchill {
99 13     13 1 19 my $F = shift;
100 13         15 my $wind_speed_mph = shift;
101 13         16 my $windchill;
102              
103             # This is the North American wind chill index.
104             # Windchill temperature is only defined for:
105             # * temperatures at or below 50 F
106             # * wind speed above 3 mph
107             # Bright sunshine may increase the wind chill temperature by
108             # 10 to 18 degress F.
109              
110 13 100 66     44 if (defined $F && defined $wind_speed_mph) {
111             # Old Formula
112             # my $Windc=int(
113             # 0.0817*
114             # (3.71*$Self->{windspeedmph}**0.5 + 5.81 - 0.25*$Self->{windspeedmph})*
115             # ($F - 91.4) + 91.4);
116              
117             # New Formula
118 12 100 100     32 if ($F <= 50 && $wind_speed_mph > 3) {
119 3         16 $windchill =
120             35.74 +
121             ( 0.6215 * $F ) -
122             ( 35.75 * ( $wind_speed_mph**0.16 ) ) +
123             ( ( 0.4275 * $F ) * ( $wind_speed_mph**0.16 ) );
124             }
125             }
126 13         24 return $windchill;
127             }
128              
129             #------------------------------------------------------------------------------
130             # Heat Index
131             #------------------------------------------------------------------------------
132              
133             sub heat_index {
134 10     10 1 13 my $F = shift;
135 10         13 my $rh = shift;
136 10         12 my $heat_index;
137              
138 10 50 33     32 if (defined $F && defined $rh) {
139 10         43 $heat_index =
140             -42.379 +
141             2.04901523 * $F +
142             10.14333127 * $rh -
143             0.22475541 * $F * $rh -
144             6.83783e-03 * $F**2 -
145             5.481717e-02 * $rh**2 +
146             1.22874e-03 * $F**2 * $rh +
147             8.5282e-04 * $F * $rh**2 -
148             1.99e-06 * $F**2 * $rh**2;
149             }
150 10         17 return $heat_index;
151             }
152              
153             #------------------------------------------------------------------------------
154             # Convert wind speed from nautical miles per hour to miles per hour
155             #------------------------------------------------------------------------------
156              
157             sub convert_kts_to_mph {
158 18     18 1 24 my $knots = shift;
159 18         18 my $mph;
160              
161 18 50       30 if (defined $knots) {
162 18         27 $mph = $knots * 1.150779;
163             }
164 18         37 return $mph;
165             }
166              
167             #------------------------------------------------------------------------------
168             # Convert wind speed from nautical miles per hour to kilometers per hour
169             #------------------------------------------------------------------------------
170              
171             sub convert_kts_to_kmh {
172 17     17 1 25 my $knots = shift;
173 17         19 my $kmh;
174              
175 17 50       27 if (defined $knots) {
176 17         22 $kmh = $knots * 1.852;
177             }
178 17         29 return $kmh;
179             }
180              
181             #------------------------------------------------------------------------------
182             # Convert miles to kilometers
183             #------------------------------------------------------------------------------
184              
185             sub convert_miles_to_km {
186 8     8 1 13 my $miles = shift;
187 8         10 my $km;
188              
189 8 50       13 if (defined $miles) {
190 8         12 $km = $miles * 1.609344;
191             }
192 8         16 return $km;
193             }
194              
195             #------------------------------------------------------------------------------
196             # Translate Weather into readable Conditions Text
197             #
198             # Reference is WMO Code Table 4678
199             #------------------------------------------------------------------------------
200              
201             sub translate_weather {
202 10     10 1 4702 my $coded = shift;
203 10         17 my $old_conditionstext = shift;
204 10         22 my $old_conditions1 = shift;
205 10         13 my $old_conditions2 = shift;
206 10         14 my ($conditionstext, $conditions1, $conditions2, $intensity);
207              
208             # We use %Converter to translate 2-letter codes into text
209              
210 10         140 my %Converter = (
211             BR => 'Mist',
212             TS => 'Thunderstorm',
213             MI => 'Shallow',
214             PR => 'Partial',
215             BC => 'Patches',
216             DR => 'Low Drifting',
217             BL => 'Blowing',
218             SH => 'Shower',
219             FZ => 'Freezing',
220             DZ => 'Drizzle',
221             RA => 'Rain',
222             SN => 'Snow',
223             SG => 'Snow Grains',
224             IC => 'Ice Crystals',
225             PE => 'Ice Pellets',
226             PL => 'Ice Pellets',
227             GR => 'Hail',
228             GS => 'Small Hail/Snow',
229             UP => 'Unknown Precipitation',
230             FG => 'Fog',
231             FU => 'Smoke',
232             VA => 'Volcanic Ash',
233             DU => 'Widespread Dust',
234             SA => 'Sand',
235             HZ => 'Haze',
236             PY => 'Spray',
237             PO => 'Dust Devils',
238             SQ => 'Squalls',
239             FC => 'Tornado',
240             SS => 'Sandstorm'
241             );
242              
243 10 100       33 if ( $coded =~ /^[-+]/ ) {
244             # Heavy(+) or Light(-) condition
245              
246 6 50       13 if ( !$old_conditions1 ) {
247 6         8 my ( $Block1, $Block2 );
248 6         12 my $Modifier = substr( $coded, 0, 1 ); # +/-
249 6         10 my $Block1t = substr( $coded, 1, 2 ); # e.g. TS
250 6         10 my $Block2t = substr( $coded, 3, 4 ); # e.g. RA
251              
252 6         9 $Block1 = $Converter{$Block1t}; # e.g. Thunderstorm
253 6         8 $conditions1 = $Block1; # e.g. Thunderstorm
254              
255 6 50       11 if ($Block2t) {
256 6         8 $Block2 = $Converter{$Block2t}; # e.g. Rain
257 6         7 $conditions2 = $Block2; # e.g. Rain
258             }
259              
260 6 100       23 if ( $Modifier =~ /^\-/ ) {
    50          
261 3         6 $Block1 = "Light $Block1"; # e.g. Light Thunderstorm
262 3         6 $intensity = "Light";
263             }
264             elsif ( $Modifier =~ /^\+/ ) {
265 3         6 $Block1 = "Heavy $Block1"; # e.g. Heavy Thunderstorm
266 3         6 $intensity = "Heavy";
267             }
268              
269 6 50       11 if ($Block2) {
270 6         12 $Block1 = "$Block1 $Block2"; # e.g. Light Thunderstorm Rain
271             }
272              
273 6 50       17 if ($old_conditionstext) {
274 0 0       0 if ( $Block1 eq "SH" ) {
275 0         0 $conditionstext = "$Block2 of $Block1";
276 0         0 $conditions1 = "Showers of";
277             }
278             else {
279 0         0 $conditionstext = "$old_conditionstext and $Block1";
280             }
281             }
282             else {
283 6         11 $conditionstext = $Block1;
284             }
285             }
286             }
287             else {
288             # Moderate condition
289              
290 4 50       9 if ( !$old_conditions1 ) {
291 4         6 my ( $Block1, $Block2 );
292 4         8 my $Block1t = substr( $coded, 0, 2 ); # e.g. TS
293 4         6 my $Block2t = substr( $coded, 2, 4 ); # e.g. RA
294              
295 4         7 $Block1 = $Converter{$Block1t}; # e.g. Thunderstorm
296 4         6 $conditions1 = $Block1; # e.g. Thunderstorm
297              
298 4 50       13 if ($Block2t) {
299 4         6 $Block2 = $Converter{$Block2t};
300 4         6 $conditions2 = $Block2;
301 4         14 $Block1 = "$Block1 $Block2";
302             }
303              
304 4 50       8 if ($old_conditionstext) {
305 0 0       0 if ( $Block1 eq "SH" ) {
306 0         0 $conditionstext = "$Block2 of $Block1";
307 0         0 $conditions1 = "Showers of";
308             }
309             else {
310 0         0 $conditionstext = "$old_conditionstext and $Block1";
311             }
312             }
313             else {
314 4         8 $conditionstext = $Block1;
315             }
316             }
317             }
318 10         57 return ($conditionstext, $conditions1, $conditions2, $intensity);
319             }
320              
321             #------------------------------------------------------------------------------
322             # Lets create a new self
323             #------------------------------------------------------------------------------
324              
325             sub new {
326 9     9 1 36765 my $Proto = shift;
327 9   100     51 my $Class = ref($Proto) || $Proto || __PACKAGE__;
328 9         21 my $Self = {};
329              
330 9         37 $Self->{servername} = "tgftp.nws.noaa.gov";
331 9         17 $Self->{username} = "anonymous";
332 9         13 $Self->{password} = 'weather@cpan.org';
333 9         16 $Self->{directory} = "/data/observations/metar/stations";
334 9         15 $Self->{timeout} = 120;
335              
336 9         16 bless $Self, $Class;
337 9         17 return $Self;
338             }
339              
340             #------------------------------------------------------------------------------
341             # Adding ability to edit server/user/directory at runtime...
342             #------------------------------------------------------------------------------
343              
344             sub setservername {
345 0     0 1 0 my $Self = shift;
346 0         0 my $Servername = shift;
347 0         0 $Self->{servername} = $Servername;
348 0         0 return $Self;
349             }
350              
351             sub setusername {
352 0     0 1 0 my $Self = shift;
353 0         0 my $User = shift;
354 0         0 $Self->{username} = $User;
355 0         0 return $Self;
356             }
357              
358             sub setpassword {
359 0     0 1 0 my $Self = shift;
360 0         0 my $Pass = shift;
361 0         0 $Self->{password} = $Pass;
362 0         0 return $Self;
363             }
364              
365             sub setdirectory {
366 0     0 1 0 my $Self = shift;
367 0         0 my $Dir = shift;
368 0         0 $Self->{directory} = $Dir;
369 0         0 return $Self;
370             }
371              
372             sub settemplatefile {
373 0     0 1 0 my $Self = shift;
374 0         0 my $Tfile = shift;
375 0         0 $Self->{tfile} = $Tfile;
376 0         0 return $Self;
377             }
378              
379             sub settimeout {
380 0     0 1 0 my $Self = shift;
381 0         0 my $Seconds = shift;
382 0         0 $Self->{timeout} = $Seconds;
383 0         0 return $Self;
384             }
385              
386             #------------------------------------------------------------------------------
387             # Here we get to FTP to the NWS and get the data
388             #------------------------------------------------------------------------------
389              
390             sub getreporthttp {
391 0     0 1 0 my $Self = shift;
392 0         0 my $Code = shift;
393             # The old site was: http://weather.noaa.gov/cgi-bin/mgetmetar.pl?cccc=$Code
394             $Self->{http} =
395 0         0 'http://www.aviationweather.gov/adds/metars/?station_ids=' . $Code . '&chk_metars=on&hoursStr=most+recent+only';
396 0         0 my $Ret = &getreport( $Self, $Code );
397 0         0 return $Ret;
398             }
399              
400             sub getreport {
401 0     0 1 0 my $Self = shift;
402 0         0 my $Station = shift;
403              
404 0         0 $Self->{error} = "0";
405              
406 0         0 my $Tmphandle = File::Temp->new();
407 0         0 my $Tmpfile = $Tmphandle->filename;
408 0         0 close $Tmphandle;
409              
410 0         0 my $Code = uc($Station);
411              
412 0 0       0 if ( !$Code ) {
413 0         0 $Self->{error} = "1";
414 0         0 $Self->{errortext} = "No Station Code Entered\n";
415 0         0 return $Self;
416             }
417              
418 0 0       0 if ( $Self->{http} ) {
419 5     5   2611 use LWP::UserAgent;
  5         170209  
  5         11853  
420 0         0 my $Ua = LWP::UserAgent->new();
421 0         0 $Ua->agent("Geo::WeatherNWS $VERSION");
422              
423 0         0 my $Req = HTTP::Request->new( GET => $Self->{http} );
424 0         0 $Req->content_type('application/x-www-form-urlencoded');
425 0         0 my $Res = $Ua->request($Req);
426              
427 0 0       0 if ( $Res->is_success ) {
428 0         0 my @Lines = split( /\n/, $Res->content );
429 0         0 foreach my $Line (@Lines) {
430 0 0       0 if ( $Line =~ /<(TITLE|H1|H2)>/ ) {
431             # ignore
432             }
433             else {
434             # Remove HTML elements.
435             # (This isn't very robust, but it gets the job done for now.)
436 0         0 $Line =~ s/<[^>]*>//g;
437              
438             # If the line starts with an ICAO, then the line is an observation (we hope)
439 0 0       0 if ( $Line =~ /^[A-Z][A-Z0-9]{3}\s/ ) {
440 0         0 $Self->{obs} = $Line;
441 0         0 last;
442             }
443             }
444             }
445             }
446             }
447             else {
448              
449             # Some users needed this for firewalls...
450             my $Ftp = Net::FTP->new(
451             $Self->{servername},
452             Debug => 0,
453             Passive => 1,
454             Timeout => $Self->{timeout}
455 0         0 );
456              
457             # my $Ftp=Net::FTP->new($Self->{servername}, Debug => 0);
458 0 0       0 if ( !defined $Ftp ) {
459 0         0 $Self->{error} = 1;
460 0         0 $Self->{errortext} = "Cannot connect to $Self->{servername}: $@";
461 0         0 return $Self;
462             }
463 0         0 $Ftp->login( $Self->{username}, $Self->{password} );
464 0         0 my $Rcode = $Ftp->code();
465 0         0 my $Message = $Ftp->message();
466              
467 0 0       0 if ( $Rcode =~ /^[45]/ ) {
468 0         0 $Self->{error} = $Rcode;
469 0         0 $Self->{errortext} = $Message;
470 0         0 return $Self;
471             }
472              
473 0         0 $Ftp->cwd( $Self->{directory} );
474 0         0 $Rcode = $Ftp->code();
475 0         0 $Message = $Ftp->message();
476              
477 0 0       0 if ( $Rcode =~ /^[45]/ ) {
478 0         0 $Self->{error} = $Rcode;
479 0         0 $Self->{errortext} = $Message;
480 0         0 return $Self;
481             }
482              
483 0         0 $Rcode = $Ftp->get( "$Code.TXT", $Tmpfile );
484 0         0 $Rcode = $Ftp->code();
485 0         0 $Message = $Ftp->message();
486 0         0 $Ftp->quit;
487              
488 0 0       0 if ( $Rcode =~ /^[45]/ ) {
489 0         0 $Self->{error} = $Rcode;
490 0         0 $Self->{errortext} = $Message;
491 0         0 return $Self;
492             }
493              
494 0         0 local $/; # enable slurp mode
495 0 0       0 open my $F, '<', $Tmpfile or
496             croak "error opening temp input $Tmpfile: $!";
497 0         0 my $Data = <$F>;
498 0         0 close($F);
499 0         0 unlink($Tmpfile);
500              
501 0         0 $Data =~ tr/\n/ /;
502 0         0 $Self->{obs} = $Data;
503             }
504              
505 0         0 $Self->decode();
506 0         0 return $Self;
507             }
508              
509             #------------------------------------------------------------------------------
510             # Decodeobs takes the obs in a string format and decodes them
511             #------------------------------------------------------------------------------
512              
513             sub decodeobs {
514 8     8 1 690 my $Self = shift;
515 8         11 my $Obs = shift;
516 8         14 $Self->{obs} = $Obs;
517 8         33 $Self->decode();
518 8         16 return $Self;
519             }
520              
521             #------------------------------------------------------------------------------
522             # Decode does the work, and is only called internally
523             #------------------------------------------------------------------------------
524              
525             sub decode {
526 8     8 1 10 my $Self = shift;
527 8         9 my @Cloudlevels;
528              
529 8         67 my @Splitter = split( /\s+/, $Self->{obs} );
530              
531             #------------------------------------------------------------------------------
532             # Break the METAR observations down and decode
533             #------------------------------------------------------------------------------
534              
535 8         14 my $have_icao_code = 0;
536 8         10 my $column = 0;
537              
538 8         13 foreach my $Line (@Splitter) {
539 100         108 $column++;
540              
541              
542             #------------------------------------------------------------------------------
543             # Report date and time
544             # These aren't always present (for example, from the http interface)
545             #------------------------------------------------------------------------------
546              
547 100 100 66     195 if ( $column == 1 && $Line =~ /^\d{4}\/\d{2}\/\d{2}$/) {
548 8         14 $Self->{report_date} = $Line;
549             }
550              
551 100 100 66     165 if ( $column == 2 && $Line =~ /^\d{2}:\d{2}$/) {
552 8         20 $Self->{report_time} = $Line;
553             }
554              
555             #------------------------------------------------------------------------------
556             # ICAO station code
557             #------------------------------------------------------------------------------
558              
559 100 100 100     1157 if ( ( $Line =~ /^([A-Z][A-Z0-9]{3})/ ) &&
    100 66        
    100 66        
    100 33        
    100 33        
    100 66        
    100 100        
    100 100        
    100 100        
    100 66        
      66        
      33        
560             ( !$have_icao_code ) ) {
561             # Use the first value that looks like the ICAO code.
562             # This should either be the first item, or
563             # the third item if there is a leading date and time.
564             # (Before we checked have_icao_code, we'd get values
565             # like TSRA or FZFG later in the observation being treated
566             # as the ICAO code.)
567             # We also allow the last three characters to be digits.
568              
569             # There was a check for "AUTO" above before, for now
570             # we'll add an extra check for that value. (AUTO should
571             # show up in the fifth column.)
572 8 50       17 croak "Unexpected value AUTO for ICAO code" if $Line eq "AUTO";
573              
574 8         10 $Self->{code} = $Line;
575 8         12 $have_icao_code = 1;
576             }
577              
578             #------------------------------------------------------------------------------
579             # Report Time
580             #------------------------------------------------------------------------------
581              
582             elsif ( $Line =~ /([0-9]Z)$/ ) {
583 8         17 my $Timez = substr( $Line, 2, 4 );
584 8         10 $Self->{time} = $Timez;
585 8         18 $Self->{day} = substr( $Line, 0, 2 );
586             }
587              
588             #------------------------------------------------------------------------------
589             # Wind speed and direction
590             #------------------------------------------------------------------------------
591              
592             elsif ( $Line =~ /([0-9]KT)$/ ) {
593 8         10 my $Newline;
594             my $Variable;
595              
596 8 50       15 if ( $Line =~ /VRB/ ) {
597 0         0 $Newline = substr( $Line, 3 );
598 0         0 $Variable = "1";
599             }
600             else {
601 8         11 $Newline = $Line;
602             }
603              
604 8         11 my $Winddir = substr( $Newline, 0, 3 );
605 8         13 $Winddir =~ tr/[A-Z]/ /d;
606 8         15 $Winddir = $Winddir - 0;
607 8         11 my $Winddirtxt;
608              
609 8 50 66     65 if ($Variable) {
    100 33        
    50 33        
    50 33        
    50 33        
    50 33        
    50 0        
    0 0        
    0          
610 0         0 $Winddirtxt = "Variable";
611             }
612             elsif ( ( $Winddir <= 22.5 ) || ( $Winddir >= 337.5 ) ) {
613 2         3 $Winddirtxt = "North";
614             }
615             elsif ( ( $Winddir <= 67.5 ) && ( $Winddir >= 22.5 ) ) {
616 0         0 $Winddirtxt = "Northeast";
617             }
618             elsif ( ( $Winddir <= 112.5 ) && ( $Winddir >= 67.5 ) ) {
619 0         0 $Winddirtxt = "East";
620             }
621             elsif ( ( $Winddir <= 157.5 ) && ( $Winddir >= 112.5 ) ) {
622 0         0 $Winddirtxt = "Southeast";
623             }
624             elsif ( ( $Winddir <= 202.5 ) && ( $Winddir >= 157.5 ) ) {
625 0         0 $Winddirtxt = "South";
626             }
627             elsif ( ( $Winddir <= 247.5 ) && ( $Winddir >= 202.5 ) ) {
628 6         9 $Winddirtxt = "Southwest";
629             }
630             elsif ( ( $Winddir <= 292.5 ) && ( $Winddir >= 247.5 ) ) {
631 0         0 $Winddirtxt = "West";
632             }
633             elsif ( ( $Winddir <= 337.5 ) && ( $Winddir >= 292.5 ) ) {
634 0         0 $Winddirtxt = "Northwest";
635             }
636              
637 8         10 my $Windspeedkts = substr( $Line, 3 );
638 8         11 my $Windgustkts = 0;
639              
640 8 100       19 if ( $Windspeedkts =~ /G/ ) {
641 6         13 my @Splitter = split( /G/, $Windspeedkts );
642              
643 6         9 $Windspeedkts = $Splitter[0];
644 6         10 $Windgustkts = $Splitter[1];
645             }
646              
647 8         17 $Windspeedkts =~ tr/[A-Z]//d;
648 8         11 $Windgustkts =~ tr/[A-Z]//d;
649              
650 8 100       18 if ( $Windspeedkts == 0 ) {
651 1         2 $Winddirtxt = "Calm";
652             }
653              
654 8         18 my $MPH = round( convert_kts_to_mph($Windspeedkts) );
655 8         12 my $GMPH = round( convert_kts_to_mph($Windgustkts) );
656 8         16 my $KMH = round( convert_kts_to_kmh($Windspeedkts) );
657 8         10 my $GKMH = round( convert_kts_to_kmh($Windgustkts) );
658              
659 8         14 $Self->{windspeedkts} = $Windspeedkts;
660 8         13 $Self->{windgustkts} = $Windgustkts;
661 8         12 $Self->{windspeedkts} = $Self->{windspeedkts} - 0;
662 8         13 $Self->{windspeedmph} = $MPH;
663 8         12 $Self->{windspeedkmh} = $KMH;
664 8         18 $Self->{windgustmph} = $GMPH;
665 8         12 $Self->{windgustkmh} = $GKMH;
666 8         11 $Self->{winddirtext} = $Winddirtxt;
667 8         10 $Self->{winddir} = $Winddir;
668 8         15 $Self->{winddir} = $Self->{winddir} - 0;
669             }
670              
671             #------------------------------------------------------------------------------
672             # Current Visibility
673             #------------------------------------------------------------------------------
674              
675             elsif ( $Line =~ /([0-9]SM)$/ ) {
676 7         10 $Line =~ tr/[A-Z]//d;
677              
678             #------------------------------------------------------------------------------
679             # Some stations were reporting fractions for this value
680             #------------------------------------------------------------------------------
681              
682 7 100       15 if ( $Line =~ /\// ) {
683 6         13 my @Splitter = split( /\//, $Line );
684 6         15 $Line = $Splitter[0] / $Splitter[1];
685             }
686              
687 7         11 my $Viskm = convert_miles_to_km( $Line );
688 7         9 $Self->{visibility_mi} = round($Line);
689 7         10 $Self->{visibility_km} = round($Viskm);
690             }
691              
692             #------------------------------------------------------------------------------
693             # Current Conditions
694             #------------------------------------------------------------------------------
695              
696             elsif (
697             ( $Line =~ /
698             (BR|TS|MI|PR|BC|DR|BL|SH|FZ|DZ|RA|SN|SG|IC|PE|PL|GR|GS|UP|FG|FU|VA|DU|SA|HZ|PY|PO|SQ|FC|SS)
699             ([A-Z])*
700             /x)
701             || ( $Line =~ /^VC([A-Z])*/ )
702             || ( $Line =~ /[\+\-]VC([A-Z])*/ ) )
703             {
704             my ($conditionstext, $conditions1, $conditions2, $intensity) =
705 6         21 translate_weather($Line, $Self->{conditionstext}, $Self->{conditions1},$Self->{conditions2});
706 6 50       23 $Self->{conditionstext} = $conditionstext if defined $conditionstext;
707 6 50       13 $Self->{conditions1} = $conditions1 if defined $conditions1;
708 6 50       12 $Self->{conditions2} = $conditions2 if defined $conditions2;
709 6 100       12 $Self->{intensity} = $intensity if defined $intensity;
710             }
711              
712             #------------------------------------------------------------------------------
713             # Cloud Cover
714             #------------------------------------------------------------------------------
715              
716             elsif (( $Line =~ /^(VV[0-9])/ )
717             || ( $Line =~ /^(SKC[0-9])/ )
718             || ( $Line =~ /^(CLR)/ )
719             || ( $Line =~ /^(FEW)/ )
720             || ( $Line =~ /^(SCT[0-9])/ )
721             || ( $Line =~ /^(BKN[0-9])/ )
722             || ( $Line =~ /^(OVC[0-9])/ ) )
723             {
724              
725 11         19 push( @Cloudlevels, $Line );
726              
727 11 50       43 if ( $Line =~ /^(CLR)/ ) {
    100          
    100          
    100          
    50          
728 0         0 $Self->{cloudcover} = "Clear";
729             }
730             elsif ( $Line =~ /^(FEW)/ ) {
731 2         3 $Self->{cloudcover} = "Fair";
732             }
733             elsif ( $Line =~ /^(SCT[0-9])/ ) {
734 2         4 $Self->{cloudcover} = "Partly Cloudy";
735             }
736             elsif ( $Line =~ /^(BKN[0-9])/ ) {
737 1         2 $Self->{cloudcover} = "Mostly Cloudy";
738             }
739             elsif ( $Line =~ /^(OVC[0-9])/ ) {
740 6         9 $Self->{cloudcover} = "Cloudy";
741             }
742              
743 11 100       20 if ( !$Self->{conditionstext} ) {
744 2         4 $Self->{conditionstext} = $Self->{cloudcover};
745             }
746             }
747              
748             #------------------------------------------------------------------------------
749             # Get the temperature/dewpoint and calculate windchill/heat index
750             #------------------------------------------------------------------------------
751              
752             elsif (( $Line =~ /^([0-9][0-9]\/[0-9][0-9])/ )
753             || ( $Line =~ /^(M[0-9][0-9]\/)/ )
754             || ( $Line =~ /^(M[0-9][0-9]\/M[0-9][0-9])/ )
755             || ( $Line =~ /^([0-9][0-9]\/M[0-9][0-9])/ ) )
756             {
757 8         22 my @Splitter = split( /\//, $Line );
758 8         14 my $Temperature = $Splitter[0];
759 8         12 my $Dewpoint = $Splitter[1];
760              
761 8 50       23 if ( $Temperature =~ /M/ ) {
762 0         0 $Temperature =~ tr/[A-Z]//d;
763 0         0 $Temperature = ( $Temperature - ( $Temperature * 2 ) );
764             }
765              
766 8 50       14 if ( $Dewpoint =~ /M/ ) {
767 0         0 $Dewpoint =~ tr/[A-Z]//d;
768 0         0 $Dewpoint = ( $Dewpoint - ( $Dewpoint * 2 ) );
769             }
770              
771 8         19 my $Tempf = convert_c_to_f( $Temperature );
772 8         14 my $Dewf = convert_c_to_f( $Dewpoint );
773              
774 8         26 my $Es =
775             6.11 * 10.0**( 7.5 * $Temperature / ( 237.7 + $Temperature ) );
776 8         16 my $E = 6.11 * 10.0**( 7.5 * $Dewpoint / ( 237.7 + $Dewpoint ) );
777 8         18 my $rh = round( ( $E / $Es ) * 100 );
778              
779 8         13 my $F = $Tempf;
780              
781 8         12 my $Heati = heat_index( $F, $rh );
782 8         14 my $Heatic = convert_f_to_c( $Heati );
783              
784 8         11 $Tempf = round($Tempf);
785 8         12 $Dewf = round($Dewf);
786 8         9 $Heati = round($Heati);
787 8         11 $Heatic = round($Heatic);
788              
789 8         12 my $Windc = windchill( $F, $Self->{windspeedmph} );
790 8         10 my $Windcc = convert_f_to_c( $Windc );
791 8         11 $Windc = round($Windc);
792 8         10 $Windcc = round($Windcc);
793              
794 8         13 $Self->{temperature_c} = $Temperature;
795 8         15 $Self->{temperature_f} = $Tempf;
796 8         12 $Self->{dewpoint_c} = $Dewpoint;
797 8         11 $Self->{dewpoint_f} = $Dewf;
798 8         10 $Self->{relative_humidity} = $rh;
799 8         33 $Self->{heat_index_c} = $Heatic;
800 8         16 $Self->{heat_index_f} = $Heati;
801 8         19 $Self->{windchill_c} = $Windcc;
802 8         26 $Self->{windchill_f} = $Windc;
803             }
804              
805             #------------------------------------------------------------------------------
806             # Calculate the atmospheric pressure in different formats.
807             # Based on report (inches of mercury)
808             #------------------------------------------------------------------------------
809              
810             elsif ( $Line =~ /^(A[0-9]{4})/ ) {
811 7         16 $Line =~ tr/[A-Z]//d;
812 7         13 my $Part1 = substr( $Line, 0, 2 );
813 7         11 my $Part2 = substr( $Line, 2, 4 );
814 7         14 $Self->{pressure_inhg} = "$Part1.$Part2";
815              
816 7         18 my $mb = $Self->{pressure_inhg} * 33.8639;
817 7         9 my $mmHg = $Self->{pressure_inhg} * 25.4;
818 7         9 my $lbin = ( $Self->{pressure_inhg} * 0.491154 );
819 7         8 my $kgcm = ( $Self->{pressure_inhg} * 0.0345316 );
820 7         11 $mb = round($mb);
821 7         11 $mmHg = round($mmHg);
822              
823 7         11 $Self->{pressure_mb} = $mb;
824 7         10 $Self->{pressure_mmhg} = $mmHg;
825 7         19 $Self->{pressure_lbin} = $lbin;
826 7         14 $Self->{pressure_kgcm} = $kgcm;
827             }
828              
829             #------------------------------------------------------------------------------
830             # Calculate the atmospheric pressure in different formats.
831             # Based on report (millibars)
832             #------------------------------------------------------------------------------
833              
834             elsif ( $Line =~ /^(Q[0-9]{4})/ ) {
835 1         2 $Line =~ tr/[A-Z]//d;
836 1         9 $Self->{pressure_mb} = $Line;
837              
838 1         4 my $inhg = ( $Self->{pressure_mb} * 0.02953 );
839 1         10 $Self->{pressure_inhg} = sprintf( "%.2f", $inhg );
840 1         4 my $mmHg = $Self->{pressure_inhg} * 25.4;
841 1         3 my $lbin = ( $Self->{pressure_inhg} * 0.491154 );
842 1         13 my $kgcm = ( $Self->{pressure_inhg} * 0.0345316 );
843 1         3 $mmHg = round($mmHg);
844              
845 1         2 $Self->{pressure_mmhg} = $mmHg;
846 1         2 $Self->{pressure_lbin} = $lbin;
847 1         3 $Self->{pressure_kgcm} = $kgcm;
848             }
849              
850             #------------------------------------------------------------------------------
851             # If the remarks section is starting, we are done
852             #------------------------------------------------------------------------------
853              
854             elsif ( $Line =~ /^(RMK)/ ) {
855 7         14 last;
856             }
857             }
858              
859             #------------------------------------------------------------------------------
860             # Read the remarks into an array for later processing
861             #------------------------------------------------------------------------------
862              
863 8         9 my $Remarks = 0;
864 8         11 my @Remarkarray;
865              
866 8         12 foreach my $Line (@Splitter) {
867 116 100       203 if ( $Line =~ /^(RMK)/ ) {
868 7         10 $Remarks = 1;
869             }
870              
871 116 100       169 if ($Remarks) {
872 23         37 push( @Remarkarray, $Line );
873             }
874             }
875              
876             #------------------------------------------------------------------------------
877             # Delete the temp file
878             #------------------------------------------------------------------------------
879              
880 8         14 $Self->{cloudlevel_arrayref} = \@Cloudlevels;
881 8         13 $Self->{station_type} = "Manual";
882              
883             #------------------------------------------------------------------------------
884             # Now we process remarks. These aren't all going to be in the report,
885             # and usually aren't. This has made it hard to develop. This section
886             # is basically incomplete, but you can get some of the data out
887             #------------------------------------------------------------------------------
888              
889 8         10 foreach my $Remark (@Remarkarray) {
890 23 50       40 if ($Remark) {
891 23         24 my $Line = $Remark;
892              
893 23 100       87 if ( $Remark =~ /^AO[1-2]/ ) {
    100          
    50          
    100          
    50          
    50          
    50          
    100          
894 1         2 $Self->{station_type} = "Automated";
895             }
896             elsif ( $Remark =~ /^SLP/ ) {
897 7         13 $Remark =~ tr/[A-Z]//d;
898              
899 7 50 33     24 if ( !defined $Remark || $Remark eq "") {
900 0         0 $Remark = 0;
901             }
902              
903 7 50 33     20 if ( ($Remark) && ( $Remark >= 800 ) ) {
904 0         0 $Remark = $Remark * .1;
905 0         0 $Remark = $Remark + 900;
906             }
907             else {
908 7         23 $Remark = $Remark * .1;
909 7         9 $Remark = $Remark + 1000;
910             }
911              
912 7         12 $Self->{slp_inhg} = ( $Remark * 0.0295300 );
913 7         34 $Self->{slp_inhg} = substr( $Self->{slp_inhg}, 0, 5 );
914 7         16 $Self->{slp_mmhg} = round( $Remark * 0.750062 );
915 7         11 $Self->{slp_lbin} = ( $Remark * 0.0145038 );
916 7         9 $Self->{slp_kgcm} = ( $Remark * 0.00101972 );
917 7         18 $Self->{slp_mb} = round($Remark);
918             }
919              
920             #------------------------------------------------------------------------------
921             # Thunderstorm info
922             #------------------------------------------------------------------------------
923              
924             elsif ( $Remark =~ /^TS/ ) {
925 0         0 $Self->{storm} = $Remark;
926             }
927              
928             #------------------------------------------------------------------------------
929             # Three hour pressure tendency
930             #------------------------------------------------------------------------------
931              
932             elsif ( $Remark =~ /^5[0-9]/ ) {
933 1         3 $Self->{thpressure} = $Remark;
934             }
935              
936             #------------------------------------------------------------------------------
937             # Automated station needs maintenance
938             #------------------------------------------------------------------------------
939              
940             elsif ( $Remark =~ /\$/ ) {
941 0         0 $Self->{maintenance} = $Remark;
942             }
943              
944             #------------------------------------------------------------------------------
945             # Precipitation since last report (100ths of an inch)
946             #------------------------------------------------------------------------------
947              
948             elsif ( $Remark =~ /^P[0-9]/ ) {
949 0         0 $Self->{precipslr} = $Remark;
950             }
951              
952             #------------------------------------------------------------------------------
953             # Event beginning or ending
954             #------------------------------------------------------------------------------
955              
956             elsif ( $Line =~ /^(BRB|TSB|MIB|PRB|BCB|DRB|BLB|SHB|FZB|DZB|RAB|SNB|SGB|ICB|PEB|GRB|GSB|UPB|FGB|FUB|VAB|DUB|SAB|HZB|PYB|POB|SQB|FCB|SSB)/ )
957             {
958 0         0 $Self->{eventbe} = $Remark;
959             }
960              
961             #------------------------------------------------------------------------------
962             # Precise temperature reading
963             #------------------------------------------------------------------------------
964              
965             elsif ( $Remark =~ /^T[0-9]/ ) {
966 7         15 $Self->{ptemperature} = $Remark;
967             }
968             }
969             }
970              
971 8         12 my $Templatefile = $Self->{tfile};
972              
973 8 50       12 if ($Templatefile) {
974 0         0 local $/; # enable slurp mode
975 0 0       0 open my $F, '<', $Templatefile or
976             croak "error opening template file $Templatefile: $!";
977 0         0 my $tout = <$F>;
978 0         0 close($F);
979              
980 0         0 $tout =~ s{ %% ( .*? ) %% }
981 0 0       0 { exists( $Self->{$1} )
982             ? $Self->{$1}
983             : ""
984             }gsex;
985 0         0  
986             $Self->{templateout} = $tout;
987             }
988 8         11  
989 8         22 $Self->{remark_arrayref} = \@Remarkarray;
990             return $Self;
991             }
992              
993             1;
994             __END__