#
# Geo::WeatherNOAA.pm (Weather Module)
# Mark Solomon <msolomon@seva.net> 
# Started 3/2/98
# $Id: WeatherNOAA.pm,v 3.6 1998/07/22 19:29:08 msolomon Exp msolomon $
# $Name:  $
# Copyright 1998 Mark Solomon (See GNU GPL)
#

package Geo::WeatherNOAA;

use LWP::Simple;
use Text::Wrap;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw( 
	get_currentWX
	get_currentWX_html
	get_forecast
	print_forecast
);


# Preloaded methods go here.
$VERSION = do { my @r = (q$Revision: 3.6 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
my $URL_BASE = 'http://iwin.nws.noaa.gov/iwin/';

sub states {
	return (qw/al ak az ar ca co ct de fl ga hi id il in ia ks ky la me md ma mi mn ms mo nt ne nh nj nm nv ny nc nd oh ok or pa pr ri sc sd tn tx ut vt va wa wv wi wy/);
}

sub First_caps {
    my $in = \(shift);
    $$in = ucfirst(lc($$in));
    $$in =~ s/\s([a-z])/ \U$1/g;
    return $$in;
} # First_caps()

sub First_caps_sent {
    my $in = \(shift);
    $$in = ucfirst(lc($$in));
    $$in =~ s/([\.:]\W+)([a-z])/$1\U$2/g;	# Cap first of sent
    $$in = ucfirst($$in);
    return $$in;
} # First_caps_sent()

sub get_forecast {
    Usage("Bad Arguments") if (@_ lt 2);
    my ($CITY,$STATE,$CACHE,$CACHEDIR) = @_;

    $CITY = uc($CITY);
    ($STATE) = ($STATE =~ /^(\w\w)/);  # Untaint
    $STATE = uc($STATE);

    my %retValue;	# This will be returned
    
    my $URL = lc($URL_BASE . "$STATE/zone.html");
    $retValue{URL} = $URL;
    
    my $RAW_DATA;
    if (! $CACHE) {
	$RAW_DATA  = get($URL) || Usage("Cannot get Wx Data at $URL");
    }
    else {
	$RAW_DATA  = get_cache($STATE,'zone',$CACHE,$CACHEDIR) || Usage("Cannot retrieve cached zone data for $STATE");
    }
    
    $RAW_DATA =~ tr/\r//d;
    
    # get @list of REAL data
    #
    my $START_ZONE = "\U${STATE}Z";
    my @RAW_DATA = (); 
    while ( $RAW_DATA =~ /$START_ZONE(.*?)\$\$/gs ) {
	my $data = $1;
	# This next line removes confusing NWS Station ID
	$data =~ s#\nNATIONAL\sWEATHER\sSERVICE.*?\n#\n#gs;
	push @RAW_DATA, $data;
    }
	
    my ($LOCAL_DATA) = grep /$CITY/, @RAW_DATA; # get local section
    
    
    # Separate header info and data
    #
    my $type = 'HEAD';				# This will show where we are in data
    my (@NEAR, @EXTENDED, $HEAD); 
    my @LOCAL_DATA = split('\n',$LOCAL_DATA);
    foreach (@LOCAL_DATA) {
	chomp;					# No \n's
	s/^\s*//;				# No leading spaces
	if ($type eq 'HEAD') {
	    if (/^\d+\s(AM|PM)/) {
		$retValue{Date} = $_ if ! $retValue{Date};
	    }
	    elsif ((! $retValue{Date}) && ($_) ) {	# If no date and data
		$HEAD .= "$_";		#    append to HEAD
	    }
	    else {
		# We're past the head set type to NEAR
		$type = 'NEAR';
	    }
	}
	elsif ( /FORECAST\.\.\.$/ ) {
	    $type = 'EXTENDED';
	}
	elsif ( $type =~ /(NEAR|EXTENDED)/ ) {
	    my $ref;
	    $ref = \@NEAR if $type eq 'NEAR';
	    $ref = \@EXTENDED if $type eq 'EXTENDED';
	    next unless $ref;
	    if (/^\.\.\./) {	# This indicates a warning
		push @$ref, /^\.\.\.(.*)/;
	    }
	    elsif (/^\.\w/) {	# This indicates a list item
		my ($key,$value) = /\.([\w\s]+)\.\.\.(.*)$/;
		First_caps($key);
		$value = ucfirst(lc($value));
		push @$ref, join ': ', $key, $value;
	    }
	    else {
		$ref->[-1] .= ' ' . lc($_) if $#{$ref} >= 0;
	    }
	}
    }
    
    # Split cites into ';' delin list 
    #
    $HEAD =~ s#([/&-]|INCLUDING|\.\.\.)#;#g;
    $HEAD =~ s/\b(?:THE|AND|CITIES\sOF)\b//g;
    my @HEAD;
    @HEAD = grep ! /^$/, grep ! /\d/, split ';', $HEAD;
    foreach (@HEAD) {
	s#(?:^\s+|\s*$)##; 		# remove extraneous \s's
    }
    $retValue{Coverage} = join ', ', sort { lc($a) cmp lc($b) } grep ! /^$/, @HEAD;
    First_caps($retValue{Coverage}); 
    
    caps_and_symbols(\@NEAR);
    caps_and_symbols(\@EXTENDED);
    $retValue{NEAR} = join "\n",@NEAR; 
    $retValue{EXTENDED} = join "\n",@EXTENDED; 
    return %retValue;

} # get_wx()

sub caps_and_symbols {
    my $ref = shift;
    for (@$ref) {
	First_caps_sent($_);
	s/</&lt;/g;
	s/>/&gt;/g;
	s/\.\.\.$//;
    }
}

sub print_forecast {
	my %wx = get_forecast(@_);
	print "Forecast for $_[0], $_[1]\n";
	for (split "\n",$wx{NEAR}) {
		my ($key,$data) = split ':';
		print wrap '', ' 'x4, "WARNING: $key\n\n" if ! $data;
		print wrap '', ' 'x4, "$_\n\n" if $data;
	}

} # print_forecast()

##########################################################################
#
#	New section: get_currentWX()
#
##########################################################################

sub get_currentWX {
    Usage("Bad Arguments") if (@_ lt 2);
    my ($CITY,$STATE,$CACHE,$CACHEDIR) = @_;
    $CITY = uc($CITY);
    ($STATE) = ($STATE =~ /^(\w\w)/);  # Untaint
    $STATE = uc($STATE);
    
    # my $URL_BASE = 'http://iwin.nws.noaa.gov/iwin/';
    my $URL = lc($URL_BASE . "$STATE/hourly.html");
    
    my $RAW_DATA;
    if (! $CACHE) {
	$RAW_DATA = get($URL) || Usage("Cannot get current wx data at $URL");
    }
    else {
	$RAW_DATA = get_cache($STATE,'hourly',$CACHE,$CACHEDIR);
    }
    $RAW_DATA =~ tr/\r//d;
    my @RAW_DATA = split /\n/, $RAW_DATA;
    
    my $date = localtime();
    my $year = (split( /\s+/, $date))[4];
    
    my %returnHash;
    my (@return_keys, @return_data);
    
    foreach (@RAW_DATA) {
	tr/\r//;
	if (/^CITY/) {
	    push @return_keys, unpack
		'@0 A15 @15 A9 @24 A5 @29 A5 @35 A4 @39 A8 @47 A8 @55 A8',$_ 
		    if length($_) > 54;
	    # print "KEYS: ", join(',',@return_keys),"\n" if @return_keys;
	}
	elsif (/^\s*$CITY/i) {
	    my @tmp = unpack
		'@0 A15 @15 A9 @24 A5 @29 A5 @34 A4 @39 A8 @47 A8 @55 A8',$_ 
		    if length($_) > 54;
	    # print "DATA: ", join(',',@tmp),"\n" if @tmp;
	    # check to see if there's city data (NEW YORK, etc);
	    $tmp[6] and push @return_data, @tmp;
	}
	elsif (/$year/) {
	    $returnHash{DATE} = $_;
	    
	    # Load TIME with data's time
	    my @tmp = /(\d+)\s+(AM|PM)\s+(\w+)/;
	    $tmp[0] =~ s/(\d+)(\d\d)/$1:$2/;
	    $returnHash{TIME} = "$tmp[0]\L$tmp[1] \U$tmp[2]";
	}
    }
    
    $returnHash{'URL'} = $URL;
    $returnHash{'STATE'} = $STATE;
    
    my $i;
    foreach $i (0..$#return_keys) {
	$returnHash{ $return_keys[$i] } = $return_data[$i] if $return_data[$i];
    }
    return %returnHash;

} # get_currentWX()


sub get_currentWX_html {
    my $CITY = shift;
    my $STATE = shift;
    my $CACHE = shift;
    my $CACHEDIR = shift;
    
    my %sky = (
	       'SUNNY'	        => 'sunny skies',
	       'MOSUNNY'	=> 'mostly sunny skies',
	       'PTSUNNY'	=> 'partly sunny skies',
	       'CLEAR' 	        => 'clear weather',
	       'DRIZZLE'        => 'a drizzle',
	       'CLOUDY'	        => 'cloudy skies',
	       'MOCLDY'	        => 'mostly cloudy skies',
	       'PTCLDY'	        => 'partly cloudy skies',
	       'LGT RAIN'	=> 'light rain',
	       'FLURRIES'	=> 'flurries',
	       'LGT SNOW'	=> 'light snow',
	       'SNOW'		=> 'snow',
	       'N/A'		=> 'N/A',
	       'NOT AVBL'	=> '*not available*',
	       'FAIR'		=> 'fair weather');
    my %compass = qw/N north S south E east W west/;
    
    my %wx = get_currentWX($CITY,$STATE,$CACHE,$CACHEDIR);
    
    $wx{CITY} or return "No data available";
    First_caps($wx{CITY});
    $wx{STATE} = uc($wx{STATE});
    
    my $direction = join '',map $compass{$_},split( /(\w)\d/g, $wx{WIND} );
    my ($speed) = ($wx{WIND} =~ /(\d+)/);
    my ($gusts) = ($wx{WIND} =~ /G(\d+)/);
    
    if ($wx{WIND} eq 'CALM') {
	$wx{WIND} = 'calm';
    }
    else {
	$wx{WIND} = "$direction at ${speed} mph";
	$wx{WIND} .= ", gusts up to ${gusts} mph" if $gusts;
    }

    my $rh_pres;
    if ($wx{RH}) {
	$rh_pres = " The relative humidity was $wx{RH}\%";
    }
    if ($wx{PRES}) {
	my %rise_fall = qw/R rising S steady F falling/;
	my $direction = join '',map $rise_fall{$_},split( /\d(\w)/g, $wx{PRES} );
	$wx{PRES} =~ tr/RSF//d;
	if ($rh_pres) {
		$rh_pres .= ", and b";
	}
	else {
		$rh_pres .= " B";
	}
	$rh_pres .= "arometric pressure was $direction at $wx{PRES} in";
    }
    $rh_pres .= '.' if $rh_pres;
	    
    my $out = "At $wx{TIME}, $wx{CITY}, ";
    $out .= "$wx{STATE} was experiencing $sky{$wx{'SKY/WX'}} ";
    $out .= "at $wx{TEMP}&deg;F, wind is $wx{WIND}.  $rh_pres\n";
    return $out;

} # get_currentWX_html()

sub Usage {
    my ($in) = @_;
    print STDOUT "Content-type:text/plain\n\nERROR: $in Geo::WeatherNOAA v$Geo::WeatherNOAA::VERSION\n";
    exit(1);
    
} # Usage()

sub Error {
  Misc::WX::Usage(@_);
}

sub get_cache {
    Usage("Wrong args to get_cache()") if (@_ lt '3');
    my $STATE = lc(shift);
    ($STATE) = ($STATE =~ /^(\w\w)/);  # Untaint
    my $TYPE = lc(shift);
    my $CACHE = shift;
    my $DIR = shift;
    $DIR or $DIR = '/tmp/wxdata';
    my $URL_BASE = 'http://iwin.nws.noaa.gov/iwin/';
    my $URL = $URL_BASE . "${STATE}/${TYPE}.html";
    my $FILE = "$DIR/$STATE\_$TYPE\.html";
    if (! opendir(DIR,$DIR) ) {
	mkdir $DIR, 0775 || Usage("Cannot make $DIR: $!");
    }
    closedir DIR;

    open(TOUCH,">$DIR/time") or Usage("Cannot make NOWfile: $!");
    print TOUCH "\n"; close TOUCH;

    my $testfile = ( stat($FILE) )[9];
    my $nowfile = ( stat("$DIR/time") )[9];
    unlink "$DIR/time" || print STDERR "Cannot delete $DIR/time\n";
    if ( ($nowfile - $testfile) > (60 * $CACHE)) {
	open(CACHE,">$FILE") or Usage("Cannot create $FILE: $!");
	# print STDERR "GETTING NEW DATA\n";
	my $DATA = get($URL);
	print CACHE $DATA;
	close CACHE;
	return $DATA;
    }
    else {
	open(FILE,"$FILE") or Usage($!);
	my $retValue;
	while (<FILE>) { $retValue .= "$_"; }
	return $retValue;
    }

} # get_cache() 

sub State_verify {
	my $state = shift;
	$state = lc($state);
	my @states = states();
	if (! grep /$state/, @states ) {
		print "Content-type:text/plain\n\nERROR: $state is not a U.S. state\n";
		exit(1);
	}
	else {
		return 1;
	}
} # State_verify()

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__
# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

Geo::WeatherNOAA - Perl extension for getting NOAA Weather(Wx) Data

=head1 SYNOPSIS

  use Geo::WeatherNOAA;
  print get_currentWX_html('NEW YORK','NY');
  print_forecast('NEW YORK','NY');

  %wx = get_forecast('BOSTON','MA');
  print "The forecast is $wx{NEAR}\n";
  print "The extended forecast is $wx{EXTENDED}\n";
  print "This information was updated $wx{Date}\n";
  print "The affected areas are $wx{Coverage}\n";

=head1 DESCRIPTION

I needed a way to get NOAA weather data for both web pages and
perl scripts for web pages etc.  This module gets information from the
NOAA web site and "decodes" it into usable format: hashes, lists, 
english, etc.

=head1 FUNCTIONS

The idea behind these function calls is simplicity.  Each function needs
at least the city and state.  If you want to use the neato cacheing
function, give the minutes to cache and, optionally, the directory to
use to hold the weather data cache.

=over 4

=item * 

get_forecast(CITY,STATE,CACHE,CACHEDIR)

Call with at least to tokens: City and State (Two letter abbr)

The third token, if used will tell the module to use the
caching function so that the data will only be retrieved
from NOAA when the cached data is this many minutes old.
I figured this would be usefull to a web server where only
the first 'hit' would have to wait for the remote data.

The fourth argument is the directory in which to cache the data.
If omitted, the module will use B<C</tmp/wxdata>>

Returns a hash with the following keys:

  Coverage 	=> A list of the affected areas for the forecast
  Date 		=> Date/time when the data was reported to NOAA
  NEAR 		=> Newline delineated list, each line contains
		   a colon (:) delin list of day and data.
		   NOTE: If there's no data, the "key" is a weather
		   warning
  EXTENDED 	=> Same as NEAR but without weather warnings
  URL 		=> URL where the data originated

It can be used like this:

  use Geo::WeatherNOAA;
  %wx = get_forecast('BOSTON','MA');
  print "The forecast is $wx{NEAR}\n";
  print "The extended forecast is $wx{EXTENDED}\n";
  print "This information was updated $wx{Date}\n";
  print "and covers $wx{Coverage}\n";

In examples/wx.cgi, I split the NEAR and EXTENDED fields to make nicer output:

  use Geo::WeatherNOAA;
  %wx = get_forecast('BOSTON','MA');
  print "<TABLE>\n";
  foreach $line (split "\n", $wx{NEAR}) {
      my ($day,$data) = split /:/, $line;

      if ($data) {
          # Normal line if there are both keys
          print "<TR><TD>$day</TD><TD>$data</TD></TR>\n";
      } else {
          # Warning line if there's only the $day value
          print "<TR><TD COLSPAN=2>$day</TD></TR>\n";
      }
  }	
  print "</TABLE>\n";

=item * 

print_forecast(CITY,STATE)

Prints an english (text) description of the forecast

Its output looks like this:

	Forecast for BLACKSBURG, VA for March 6, 1998

  WARNING: The national weather service has issued a flood watch for
    late tonight through monday
    
  WARNING: A wind advisory has also been posted for very late tonight 
    through monday... 

  Tonight: Showers...With a chance of thunderstorms.  Lows in the upper
    40s. South wind around 15 mph. Chance of rain near 100 percent.

  Monday: Showers with a chance of thunderstorms...Mainly in the 
    morning.

  Turning cooler.  Temperatures falling into the lower 40s. West wind
    around 15 mph.  Chance of rain 90 percent.
    
  Monday night: Mostly cloudy with a chance of rain or snow. Breezy. 
    Lows mostly in the 20s. Chance of precipitation 40 percent.
    
  Tuesday: Partly cloudy with a chance of snow flurries.	
    Colder and breezy. Highs from the upper 20s to near 40. 
    

=item * 

get_currentWX(CITY,STATE,CACHE,CACHEDIR)

Call with at least to tokens: City and State (Two letter abbr)

The third token, if used will tell the module to use the
caching function so that the data will only be retrieved
from NOAA when the cached data is this many minutes old.
I figured this would be usefull to a web server where only
the first 'hit' would have to wait for the remote data.

The fourth argument is the directory in which to cache the data.
If omitted, the module will use B<C</tmp/wxdata>>

Returns a hash with the following keys:

  CITY		=> Name of reported city
  SKY/WX	=> Sky conditions
  TEMP		=> Current temp
  DEWPT		=> Dewpoint
  RH		=> ???
  WIND		=> Wind direction and speed
  PRES		=> Pressure
  REMARKS	=> Remarks

=item * 

get_current_html(CITY,STATE,CACHE)

Call with at least to tokens: City and State (Two letter abbr)

The third token, if used will tell the module to use the
	caching function so that the data will only be retrieved
	from NOAA when the cached data is this many minutes old.
	I figured this would be usefull to a web server where only
	the first 'hit' would have to wait for the remote data.

This call returns a scalar containing a (sort-of) html'ized english
sentence describing the weather in the requested city.

  use Geo::WeatherNOAA;
  $weather = get_currentWX_html('RICHMOND','VA');
  print "$weather\n";

The output looks like this:

  At 8:00pm EST, Richmond, VA was experiencing cloudy skies at 66°F,
  wind is south at 15mph. 

=back

=head1 AUTHOR

Mark Solomon 

msolomon@seva.net

http://www.seva.net/~msolomon/wx/

=head1 SEE ALSO

perl(1).

=cut

