File Coverage

blib/lib/Geo/Weather.pm

Criterion	Covered	Total	%
statement	40	280	14.2
branch	1	174	0.5
condition	2	49	4.0
subroutine	6	15	40.0
pod	11	11	100.0
total	60	529	11.3

## Geo::Weather
## Written by Mike Machado  2000-11-01
##

# Modified by Kevin L. Papendick
# E-mail:	[e-mail]
# Website:	www.polarlava.com

# V0.9b
# - Added report_raw() function
# - Modified report() format

# V0.9c
# - URL & RegEx Changes due to weather.com changes

# V1.1_PL
# - Incorporated Mike's V1.1 $ERROR_BUSY changes

# V1.2
#  Parse new weather.com as of 2002-12-05 -klp
# - New image locator comment
# - New current temperature locator
# - New dew point locator
# - New relative humidity locator
# - New visability locator
# - New barometric locator
# - New UV locator
# - New wind locator

# V1.21
#  Parse new weather.com as of 2003-01-08 -klp

# V1.22 - 1/27/03
#  Bug Fix for negative dew points -klp

# V1.23 - 02/24/03
# Change to picture parsing for new HTML code -klp

# V1.3 - 05/27/03
# Change request URL -klp

# V1.31 - 05/28/03
# Added data_check() function in an effort to detect and catch bad/missing data. -klp
# Removed unnecessary UserAgent cookie jar left behind from V1.3 development -klp

# V1.32 - 06/12/03 -klp
# Changed $self->{server_zip} value
# Cleared $self->{ext} value

# V1.4 - 08/12/03 -klp
# Bug Fix for City, State request.  Added recursive lookup call against redirect URL.
# Added get_city(), get_state() functions.
# Added set_report_colors() functions.
# Minor reformatting of report() function.
# Added lookup_forecast() and report_forecast() function.
# Removed $self->{ext} variable.
# Additional debugging messages added.

# V1.41 - 08/27/03 -klp
# Changed City, State URL extraction due to weather.com change
# Changed $self->{forecast_flag} to $self->{location_code} as it is now needed by
# both the current and forecast weather retrievals

package Geo::Weather;

use strict;
use Carp;
use LWP::UserAgent;

use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK
		 $OK $ERROR_UNKNOWN $ERROR_QUERY $ERROR_PAGE_INVALID $ERROR_CONNECT $ERROR_NOT_FOUND $ERROR_TIMEOUT $ERROR_BUSY);

require Exporter;

@ISA = qw(Exporter);
@EXPORT_OK = qw();
@EXPORT = qw( $OK $ERROR_UNKNOWN $ERROR_QUERY $ERROR_PAGE_INVALID $ERROR_CONNECT $ERROR_NOT_FOUND $ERROR_TIMEOUT $ERROR_BUSY);
$VERSION = '1.41';

$OK = 1;
$ERROR_UNKNOWN = 0;
$ERROR_QUERY = -1;
$ERROR_PAGE_INVALID = -2;
$ERROR_CONNECT = -3;
$ERROR_NOT_FOUND = -4;
$ERROR_TIMEOUT = -5;
$ERROR_BUSY = -6;


sub new {
	my $class = shift;
	my $self = {};
	$self->{debug} = 0;
	$self->{version} = $VERSION;
	$self->{server_zip} = 'www.w3.weather.com';
	$self->{server_cst} = 'www.weather.com';
	$self->{port} = 80;
	$self->{timeout} = 10;
	$self->{proxy} = '';
	$self->{proxy_username} = '';
	$self->{proxy_password} = '';
	$self->{agent_string} = "Geo::Weather/$VERSION";
	$self->{base_zip} = '/weather/local/';
	$self->{base_cst} = '/search/search?where=';
	$self->{location_code} = '';

	#--- Forecast
	$self->{forecast_server} = $self->{server_zip};
	$self->{forecast_base} = '/weather/print/';
	$self->{forecast_table_size} = '80';

	#--- Report Colors
	$self->{report_hdr_color} = "#000000";
	$self->{report_cond_color} = "#000080";
	$self->{report_result_color} = "#0000a0";

	bless $self, $class;
	return $self;
}

sub get_weather {
	my $self = shift;
	my $city = shift || '';
	my $state = shift || '';
	my $mode;

	return $ERROR_QUERY unless $city;

	my $page = '';
	if ($city =~ /^\d+$/) {
		# Use zip code
		$page = $self->{base_zip}.$city;
		$self->{location_code} = $city;
		$mode = 'zip';
	} else {
		# Use City, State
		$state = lc($state);
		$city = lc($city);
		$city =~ s/ /+/g;
		$page = $self->{base_cst}.$city.','.$state;
		#forecast flag set in lookup for City, State
		$mode = 'cst';
	}

	$self->{results} = $self->lookup($page, $mode);

	return $self->{results};
}

sub get_city {
	my $self = shift;

	return $ERROR_UNKNOWN unless $self->{results};
	my $results = $self->{results};

	return $results->{city};
}

sub get_state {
	my $self = shift;

	return $ERROR_UNKNOWN unless $self->{results};
	my $results = $self->{results};

	return $results->{state};
}

sub set_report_colors {
	my $self = shift;
	my $report_hdr_color = shift;
	my $report_cond_color = shift;
	my $report_result_color = shift;

	return 0 if (length($report_hdr_color) < 7);
	return 0 if (length($report_cond_color) < 7);
	return 0 if (length($report_result_color) < 7);

	$self->{report_hdr_color} = $report_hdr_color;
	$self->{report_cond_color} = $report_cond_color;
	$self->{report_result_color} = $report_result_color;

	return 1;
}

sub data_check {
	my $self = shift;
	my $data = $self->report_raw();
	my $data_integrity = 1;

	$data_integrity = 0 if ($data =~ /^\|{4}/);

	return $data_integrity;
}

sub report_raw {
	my $self = shift;
	my $results = $self->{results};
	my $output;

	return $ERROR_UNKNOWN unless $self->{results};

	$output .= $results->{city}  . '|';
	$output .= $results->{state} . '|';
	$output .= $results->{pic}   . '|';
	$output .= $results->{cond}  . '|';
	$output .= $results->{temp}  . '|';
	$output .= $results->{wind}  . '|';
	$output .= $results->{dewp}  . '|';
	$output .= $results->{humi}  . '|';
	$output .= $results->{visb}  . '|';
	$output .= $results->{baro}  . '|';
	$output .= $results->{uv};

	return $output;
}

sub report {
	my $self = shift;

	return $ERROR_UNKNOWN unless $self->{results};

	my $output = '';
	my $heat_c = 0;
	my $feels_like = '';
	my $results = $self->{results};

	if ($results->{heat} ne 'N/A') {
		$heat_c = sprintf("%0.0f", 5/9 * ($results->{heat} - 32));
		$feels_like = "(Feels Like: $results->{heat}° F/$heat_c° C)";
	}


	$output = <
	{report_hdr_color}\">
		$results->{city}, $results->{state}


	{url}\">{pic}\" border=0>

		$results->{cond}



	 




245




 





 





 





 





 





 



 		 




246




 





 





 





 





 





 



 		 Temperature: 




247




 





 





 





 





 





 



 		  




248




 





 





 





 





 





 



 		  $results->{temp}° F/$results->{temp_c}° C   $feels_like 




249




 





 





 





 





 





 



 		  




250




 





 





 





 





 





 



 		 




251




 





 





 





 





 





 



   




252




 





 





 





 





 





 



 REPORT_START 




253




 





 





 





 





 





 



   




254




0




  
  0
  




 





 





 





 



 	if ($results->{wind}) { 




255




0





 





 





 





 





 



 		$output .= <




256




 





 





 





 





 





 



 		 




257




 





 





 





 





 





 



 		 Wind: 




258




 





 





 





 





 





 



 		  




259




 





 





 





 





 





 



 		  $results->{wind} 




260




 





 





 





 





 





 



 		  




261




 





 





 





 





 





 



 		 




262




 





 





 





 





 





 



   




263




 





 





 





 





 





 



 REPORT_WIND 




264




 





 





 





 





 





 



 	} 




265




 





 





 





 





 





 



   




266




0





 





 





 





 





 



 	$output .= <




267




 





 





 





 





 





 



 		 




268




 





 





 





 





 





 



 		 Dew Point: 




269




 





 





 





 





 





 



 		  




270




 





 





 





 





 





 



 		  $results->{dewp}° F/$results->{dewp_c}° C 




271




 





 





 





 





 





 



 		  




272




 





 





 





 





 





 



 		 




273




 





 





 





 





 





 



 		 




274




 





 





 





 





 





 



 		 Rel. Humidity: 




275




 





 





 





 





 





 



 		  




276




 





 





 





 





 





 



 		  $results->{humi} % 




277




 





 





 





 





 





 



 		  




278




 





 





 





 





 





 



 		 




279




 





 





 





 





 





 



 		 




280




 





 





 





 





 





 



 		 Visibility: 




281




 





 





 





 





 





 



 		  




282




 





 





 





 





 





 



 		  $results->{visb} 




283




 





 





 





 





 





 



 		  




284




 





 





 





 





 





 



 		 




285




 





 





 





 





 





 



   




286




 





 





 





 





 





 



 REPORT_MID 




287




 





 





 





 





 





 



   




288




0




  
  0
  




 





 





 





 



 	if ($results->{baro}) { 




289




0





 





 





 





 





 



 		$output .= <




290




 





 





 





 





 





 



 		 




291




 





 





 





 





 





 



 		 Barometer: 




292




 





 





 





 





 





 



 		  




293




 





 





 





 





 





 



 		  $results->{baro} 




294




 





 





 





 





 





 



 		   




295




 





 





 





 





 





 



 		 




296




 





 





 





 





 





 



   




297




 





 





 





 





 





 



 REPORT_BARO 




298




 





 





 





 





 





 



 	} 




299




 





 





 





 





 





 



   




300




0




  
  0
  




 





 





 





 



 	if ($results->{baro}) { 




301




0





 





 





 





 





 



 		$output .= <




302




 





 





 





 





 





 



 		 




303




 





 





 





 





 





 



 		 UV Index: 




304




 





 





 





 





 





 



 		  




305




 





 





 





 





 





 



 		  $results->{uv} 




306




 





 





 





 





 





 



 		  




307




 





 





 





 





 





 



 		 




308




 





 





 





 





 





 



   




309




 





 





 





 





 





 



 REPORT_UV 




310




 





 





 





 





 





 



 	} 




311




 





 





 





 





 





 



   




312




0





 





 





 





 





 



 	$output .= "\n";



		  $results->{temp}° F/$results->{temp_c}° C   $feels_like



REPORT_START

	if ($results->{wind}) {
		$output .= <



		  $results->{wind}



REPORT_WIND
	}

	$output .= <



		  $results->{dewp}° F/$results->{dewp_c}° C





		  $results->{humi} %





		  $results->{visb}



REPORT_MID

	if ($results->{baro}) {
		$output .= <



		  $results->{baro}



REPORT_BARO
	}

	if ($results->{baro}) {
		$output .= <



		  $results->{uv}



REPORT_UV
	}

	$output .= "

	return $output;
}

sub report_forecast {
	my $self = shift;
	my $table_size = shift;
	my $url = 'http://' . $self->{forecast_server} . $self->{forecast_base} . $self->{location_code};
	my $output;

	return $ERROR_QUERY unless $self->{results};

	$self->{forecast_table_size} = $table_size if (defined($table_size) && length($table_size) > 0);

	my @forecast = $self->lookup_forecast($url);
	print STDERR __LINE__, ": Geo::Weather: Forecast size " . $#forecast . "\n" if $self->{debug} > 3;

	$output = <

	$self->{city}, $self->{state}


	Ten Day Forecast


REPORT_START

	#--- Reformat Data
	my $strip = 0;
	my $weather_href = "href=\"http://www.weather.com";
	foreach (@forecast) {
			s/HREF="/$weather_href/ig; #convert relative links
			s/bgcolor=\"#ffffff\"\s+//ig; #remove white background from table cell
			s/>/ target=\"_blank\">/ if (/href/ig); #open links in new window
			if (/
				s/BGCOLOR="#\w*">/>/i;
			} elsif (/<\/TABLE>/i) {
				$strip = 0;
			}
		if (//) {
			$strip = 1;
			$output .= <
				 




356




 





 





 





 





 





 



 					 




357




 





 





 





 





 





 



          		   




358




 





 





 





 





 





 



           		 High / Low (°F) 




359




 





 





 





 





 





 



           		 Precip. % 




360




 





 





 





 





 





 



         			 




361




 





 





 





 





 





 



   




362




 





 





 





 





 





 



 FORECAST 




363




 





 





 





 





 





 



   




364




 





 





 





 





 





 



 		} elsif ($strip) { 




365




 





 





 





 





 





 



 			# forecast content 




366




0





 





 





 





 





 



 			$output .= "$_\n"; 




367




 





 





 





 





 





 



 		} else { 




368




 





 





 





 





 





 



 			# unwanted content 




369




 





 





 





 





 





 



 		} 




370




 





 





 





 





 





 



 	} 




371




0





 





 





 





 





 



 	$output .= "\n\n";






FORECAST

		} elsif ($strip) {
			# forecast content
			$output .= "$_\n";
		} else {
			# unwanted content
		}
	}
	$output .= "

	return $output;
}

sub lookup {
	my $self = shift;
	my $page = shift || '';
	my $mode = shift || 'raw';

	my $rh_cnt = 0;
	my $dew_cnt = 0;
	my $vis_cnt = 0;
	my $baro_cnt = 0;
	my $uv_cnt = 0;
	my $wind_cnt = 0;

	return $ERROR_PAGE_INVALID unless $page;

	my %results = ();

	$results{url} = "http://$self->{server_zip}" if ($mode eq 'zip');
	$results{url} = "http://$self->{server_cst}" if ($mode eq 'cst');
	$results{url} .= ":$self->{port}" unless $self->{port} eq '80';
	$results{url} .= $page;
	$results{page} = $page;

	my $not_found_marker = 'not found';
	my $end_report_marker = '';
	my $line = '';

	print STDERR __LINE__, ": Geo::Weather: Attempting to GET current weather at $results{url}\n" if $self->{debug};
	my $ua = new LWP::UserAgent;
	my $request = new HTTP::Request('GET',$results{url});
	my $proxy_user = $self->{proxy_user} || $ENV{HTTP_PROXY_USER} || '';
	my $proxy_pass = $self->{proxy_pass} || $ENV{HTTP_PROXY_PASS} || '';
	$request->proxy_authorization_basic($proxy_user, $proxy_pass) if $self->{proxy} && $proxy_user;

	$ua->timeout($self->{timeout}) if $self->{timeout};

	$ua->agent($self->{agent_string});
	$ua->proxy(['http'], $self->{proxy}) if $self->{proxy};


	my $response = $ua->request($request);
	unless ($response->is_success) {
		print STDERR __LINE__, ": Geo::Weather: GET Failed for current weather " . $response->status_line . "\n" if $self->{debug};
		return $ERROR_TIMEOUT;
	}
	my $content = $response->content();
	my @lines = split(/\n/, $content);

	#--- Parse out City, State URL
	if ($mode eq 'cst') {
		for (my $i = 0; $i < @lines; $i++) {
			my $line = $lines[$i];
			next if ($line eq '');

			#--- Recursive look up of weather page
			if ($line =~ s/.+URL=.+\/(.+)">/$1/) {
				$self->{location_code} = $line;
				print STDERR __LINE__, ": CST Location Code: $self->{location_code}\n" if $self->{debug} > 2;
				my $url = 'http://' . $self->{server_zip} . $self->{base_zip} . $self->{location_code};
				$self->{results} = $self->lookup($url);
				return $self->{results};
			}
		}
	}

	for (my $i = 0; $i < @lines; $i++) {
		my $line = $lines[$i];
		next if ($line eq '');
		print STDERR "tagline: $line\n" if ($line =~ /