Geo-Weather
view release on metacpan or search on metacpan
s/bgcolor=\"#ffffff\"\s+//ig; #remove white background from table cell
s/>/ target=\"_blank\">/ if (/href/ig); #open links in new window
if (/<td/i) {
s/BGCOLOR="#\w*">/>/i;
} elsif (/<\/TABLE>/i) {
$strip = 0;
}
if (/<!-- begin loop -->/) {
$strip = 1;
$output .= <<FORECAST;
<table border="0" width="$self->{forecast_table_size}%">
<tr>
<td colspan="3"> </td>
<th valign="middle">High /<br> Low (°F)</th>
<th valign="middle">Precip. %</th>
</tr>
FORECAST
} elsif ($strip) {
# forecast content
$output .= "$_\n";
} else {
# unwanted content
}
}
$output .= "</table>\n<!-- End Forecast Data -->\n";
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 = '<!-- vertical outlet #1 -->';
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 =~ /<!-- insert/ && $self->{debug} > 2);
print STDERR "line: $line\n" if $self->{debug} > 3;
return $ERROR_NOT_FOUND if ($line =~ /$not_found_marker/i);
if ($line =~ /<title>.*Severe Weather Mode Index.*/i) {
return $ERROR_BUSY;
}
#Parse - City, State, Zip
if ($line =~ /<b>Local Forecast for (.*?)<\/b>/i || $line =~ /<b>Travel Forecast for (.*?)<\/b>/i) {
my ($city, $state) = split(/\,[\s+]/, $1);
$results{city} = $city;
$self->{city} = $city;
if ($state =~ /(.*)\s+\((.*)\)/) {
$results{state} = $1;
$results{zip} = $2;
$self->{state} = $results{state};
} else {
$results{state} = $state;
$self->{state} = $results{state};
}
}
$results{humi} = $1;
}
}
#Parse - Visability
if (!$results{visb}) {
if ($line =~ /Visibility:/) {
$vis_cnt = 1;
} elsif ($vis_cnt > 0) {
$vis_cnt++;
}
if ($vis_cnt == 2 && $line =~ /obsInfo2>\s*(.*)\s*</) {
$results{visb} = $1;
}
}
#Parse - Barometer
if (!$results{baro}) {
if ($line =~ /Pressure:/) {
$baro_cnt = 1;
} elsif ($baro_cnt > 0) {
$baro_cnt++;
}
if ($baro_cnt == 2 && $line =~ /obsInfo2>\s*(.*)\s*</) {
$results{baro} = $1;
}
}
if ($line =~ /$end_report_marker/) {
last;
}
}
if (!($results{visb})) {
$results{visb} = 'Not Available';
}
#Celcius Conversions
$results{temp_c} = sprintf("%0.0f", 5/9 * ($results{temp} - 32));
$results{dewp} =~ s/(\d+)(.+)/$1/;
$results{dewp_c} = sprintf("%0.0f", 5/9 * ($results{dewp} - 32));
return \%results;
}
sub lookup_forecast {
my $self = shift;
my $url = shift;
my @forecast;
return $ERROR_QUERY unless $url;
print STDERR __LINE__, ": Geo::Weather: Attempting to GET forecast at $url\n" if $self->{debug};
my $ua = new LWP::UserAgent;
my $request = new HTTP::Request('GET', $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 forecast " . $response->status_line . "\n" if $self->{debug};
return $ERROR_TIMEOUT;
}
print STDERR __LINE__, ": Geo::Weather: GET Succeeded for forecast at $url\n" if $self->{debug};
my $content = $response->content();
my @raw_content = split(/\n/, $content);
foreach my $line (@raw_content) {
next if ($line eq '');
chomp $line;
$line =~ s/</~~~</g; #prepend "~~~" before each <tag>
push(@forecast, split /~~~/, $line); #Split on "~~~" to create a semi-manageable format to search
}
print STDERR "forecast_lookup Sizes:" . $#raw_content . ' ~ ' . $#forecast . "\n" if $self->{debug} > 3;
return @forecast;
}
1;
__END__
=head1 NAME
Geo::Weather - Weather retrieval module
=head1 SYNOPSIS
use Geo::Weather;
my $weather = new Geo::Weather;
$weather->get_weather('Folsom','CA');
print $weather->report();
-or-
use Geo::Weather;
my $weather = new Geo::Weather;
$weather->{timeout} = 5; # set timeout to 5 seconds instead of the default of 10
my $current = $weather->get_weather('95630');
print "The current temperature is $current->{temp} degrees\n";
=head1 DESCRIPTION
=over 4
=item * B<lookup>
Gets current weather given a full weather.com URL
B<Sample Code>
my $current = $weather->lookup('http://www.weather.com/search/search?where=95630');
B<Returns>
On sucess, lookup returns a hashref with the same keys as the get_weather function.
On error, lookup returns the same errors defined for get_weather.
=back
=over 4
=item * B<lookup_forecast>
Gets the ten day forecast page given a full weather.com URL. Not intended to be called directly, but used by report_forecast.
B<Sample Code>
my $raw_forecast = $weather->lookup_forecast('http://www.w3.weather.com/weather/print/95630');
B<Returns>
On sucess, lookup_forecast returns an array containing the weather.com ten day forecast page data.
On error, lookup_forecast returns the same errors defined for get_weather.
=back
=head1 OBJECT KEYS
There are several object hash keys that can be set to manipulate how B<Geo::Weather> works. The hash keys
should be set directly following C<new>.
Below is a list of each key and what it does:
=item * B<debug>
Enable debug output of the connection attempts to weather.com Valid values are 0 to 4, increasing debugging respectivley.
=item * B<timeout>
Controls the timeout, in seconds, when trying to connect to or get data from weather.com. Default timeout
is 10 seconds. Set to 0 to disable timeouts.
=item * B<proxy>
Use HTTP proxy for the request. Format is http://proxy.server:port/. Default is no proxy.
=item * B<proxy_user>
Sets the username to use for proxying. Defaults to the HTTP_PROXY_USER environment variable, if set, or don't use authentication if blank.
=item * B<proxy_pass>
Sets the password to use for proxying. Defaults to the HTTP_PROXY_PASS environment variable, if set.
=item *B<agent_string>
HTTP User-Agent header for request. Default is Geo::Weather/$VERSION.
=head1 AUTHOR
Geo::Weather was wrtten by Mike Machado I<E<lt>mike@innercite.comE<gt>>
=cut
( run in 0.453 second using v1.01-cache-2.11-cpan-71847e10f99 )