view release on metacpan or  search on metacpan

WeatherNOAA.pm  view on Meta::CPAN

	#
	if (@$warnings) {
		$out .= qq|<!-- Warnings -->\n|;
		foreach my $warning (@$warnings) {
			$out .= qq|<TR BGCOLOR="#FF8389" ALIGN="CENTER">\n|;
			$out .= qq|\t<TD COLSPAN="$cols">|;
			$out .= qq|<FONT $font_face COLOR="#440000">\n|;
			$out .= qq|\t$warning\n</TD></TR>\n|;
		}
	}

	# Iterate over the first $max_items items in forecast
	#
	my $bottom; # add this after the iteration;
	$out    .= qq|<TR VALIGN="TOP" BGCOLOR="$med_bg">\n|;
	$bottom .= qq|<TR VALIGN="TOP">\n|;
	foreach my $key ( (keys %$forecast)[0..($cols - 1)] ) {
		#print STDERR "DEBUG: $key\n";
		$out    .= "\t<TD>" . font($key) . "</TD>\n";
		$bottom .= "\t<TD>" . font($forecast->{$key}) . "</TD>\n";
	}
	$out .= "</TR>\n" . $bottom . "</TR>\n";
	
	# Add coverage area
	$out .= qq|<TR BGCOLOR="$light_bg" ALIGN="LEFT">\n|;
	$out .= qq|	<TD>| . font('Area') . qq|</TD>\n|;
	$out .= qq|	<TD COLSPAN="$cols">| . font($coverage,1) . qq|</TD>\n|;
	$out .= qq|</TR>\n|;

	# Add credits
	#
	my $wx_cred = '<A HREF="http://www.noaa.gov">NOAA</A> forecast made ' .
	  "$date by " .
	  "<A HREF=\"http://www.seva.net/~msolomon/WeatherNOAA/dist/\">" .
	  "Geo::WeatherNOAA</A> V.$Geo::WeatherNOAA::VERSION";
	$out .= qq|<TR BGCOLOR="$light_bg" ALIGN="CENTER">\n|;
	$out .= qq|<TD COLSPAN="$cols">| . font($wx_cred) . "</TD></TR>\n";
	$out .= qq|</TABLE>\n|;



}

##############################################################################
##############################################################################
##
## Misc funcs
## 
##############################################################################
##############################################################################

sub get_url {
    my ($URL, $UA) = @_;

	$URL or die "No URL to get!";

    # Create the useragent and get the data
    #
    if (! $UA) {
		$UA = new LWP::UserAgent;
		if ( $ENV{'HTTP_PROXY'} or $ENV{'http_proxy'} ) {
        	$UA->env_proxy;
		}
    }
    $UA->agent("WeatherNOAA/$VERSION");
    
    # Create a request
    my $req = new HTTP::Request GET => $URL;
    my $res = $UA->request($req);
    if ($res->is_success) {	
		return $res->content;
    }
    else {
		return;
    }
} # getURL()    

sub get_data {
	my ($URL,$filename,$fileopt,$UA) = @_;

	$fileopt ||= 'get';

	my $data;	# Data

	if ( ($fileopt eq 'get') || ($fileopt eq 'save') ) {
		print STDERR "Retrieving $URL\n" if $main::opt_v;
		$data = get_url($URL,$UA) || 
			return "Error getting data from $URL"; 
		if ( $fileopt eq 'save' ) {
			print STDERR "Writing $URL to $filename\n" if $main::opt_v;
			open(OUT,">$filename") or die "Cannot create $filename";
			print OUT $data;
			close OUT;
			$fileopt = 'usefile';
		}
	}
	if ( $fileopt eq 'usefile' ) {
		print STDERR "Reading data from $filename\n" if $main::opt_v;
		open(FILE,$filename) or die "Cannot read $filename";
		while (<FILE>) { $data .= $_; }
	}
	return $data;
} # get_fh

sub format_date {
	my $in = shift;
	$in =~ s/^(\d+)(\d\d)\s(AM|PM)\s(\w+)\s(\w+)\s(\w+)\s0*(\d+)/$1:$2\L$3\E ($4) \u\L$5\E\E \u\L$6 $7,/;
	$in =~ tr/\015//d; # \r
	return $in;
}
sub sent_caps {
	my $in = shift;
	$in = ucfirst(lc($in));
	$in =~ s/(\.\W+)(\w)/$1\U$2/g;		# Proper sentance caps
	return $in;
}

sub ucfirst_words {
	my ($in) = @_;
	return join " ", map ucfirst(lc($_)),(split /\s+/, $in);
}