File Coverage

blib/lib/Weather/Google.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Weather::Google;

use strict;
use warnings;
use LWP::Simple qw/get/;
use XML::Simple;
use Carp;

our $ENCODE;
$ENCODE = 1 if eval { require Encode };

our $ENCODING = 'utf-8';

our $VERSION = 0.06;
our $AUTOLOAD;
use constant GAPI => 'http://www.google.com/ig/api?weather=';

# Mapping of current supported encodings
my %DEFAULT_ENCODINGS = (
    en      => 'latin1',
    da      => 'latin1',
    de      => 'latin1',
    es      => 'latin1',
    fi      => 'latin1',
    fr      => 'latin1',
    it      => 'latin1',
    ja      => 'utf-8',
    ko      => 'utf-8',
    nl      => 'latin1',
    no      => 'latin1',
    'pt-BR' => 'latin1',
    ru      => 'utf-8',
    sv      => 'latin1',
    'zh-CN' => 'utf-8',
    'zh-TW' => 'utf-8',
);

sub new {
	my ( $class, $area, $opt ) = @_;
    carp "Weather::Google is deprecated.  Please use a different weather provider.";
    my $self = {};
	bless ($self,$class);

	$self->{xs} = XML::Simple->new;

	$self->language($opt->{language}) if defined $opt->{language};
    $self->encoding($opt->{encoding}) if defined $opt->{encoding};

	return $self unless $area;

	if ( $area =~ /^\d{5}?$/ ) {
		$self->zip($area);
		return $self;
	}

	$self->city($area);
	return $self;
}

sub _location_url {
    my ( $self, $loc ) = @_;
    warn "Weather::Google is deprecated.";
    return "";
    # TODO This should be modified to support, i.e., a hash of parameters.
    my $url = GAPI . $loc;
    my $lang = $self->language;
    $url .= "&hl=$lang" if $lang;
    return $url;
}

sub zip {
    my $self = shift;
    my $zip  = shift;
    unless ( $zip =~ /\d{5}?$/ ) {
        $self->err("Not a zip code");
        return;
    }

    my $xml = $self->_decode( get( $self->_location_url($zip) ) );
    my $w = $self->{xs}->xml_in($xml) or return;

    $self->_parse($w);
    return 1;
}

sub city {
    my $self = shift;
    my $loc  = shift;

    # Encode the location for URL
    $loc =~ s/([^\w()’*~!.-])/sprintf '%%%02x', ord $1/eg;

    my $xml = $self->_decode( get( $self->_location_url($loc) ) );
    my $w = $self->{xs}->xml_in($xml) or return;

    $self->_parse($w);
    return 1;
}

sub language {
	my $self = shift;

	return $self->{lang} unless @_;
    my $lang = shift;

	# List of supported languages according to
	# http://toolbar.google.com/buttons/apis/howto_guide.html#multiplelanguages
	my %languages = map { $_ => 1 } qw/
	    en da de es fi fr it ja ko nl no pt-BR ru sv zh-CN zh-TW
	/;

	unless (defined $languages{$lang}) {
	    warn qq|"$lang" is not a supported ISO language code.\n|;
	    return $self->{lang};
	}

	$self->{lang} = $lang;
    $self->{encoding} ||= $DEFAULT_ENCODINGS{$lang};
}

sub encoding {
	my $self = shift;

	return ( $self->{encoding} ||= $ENCODING ) unless @_;
    my $encoding = shift;

    # TODO Check valid encoding

	$self->{encoding} = $encoding;
}

sub current_conditions {
	my $self = shift;
	return $self->{current} unless @_;
	my @conds = @_;
	my @out;
	foreach my $cond (@conds) {
		if (defined($self->{current}->{$cond})) {
			push (@out, $self->{current}->{$cond});
		} else {
			$self->err("No current condition $cond");
			push (@out, undef);
		}
	}
	return $out[0] unless $#out;
	return @out;
}

sub forecast_conditions {
	my $self = shift;
	return $self->{forecast} unless @_;
	my $day = shift;

	$day = 0 if $day =~ /today/i;
	$day = 1 if $day =~ /tomorrow/i;
	unless ($day =~ /^\d+$/) {
		# Only take the first three letters
		if ($day =~ /^(\w{3})\w*day$/i) {
			$day = $1;
		}
		# Check to see if we have a day that matches
		for ( my $i = 0; $i <= $#{ $self->{forecast} }; $i++ ) {
			if ($self->{forecast}->[$i]->{day_of_week} =~ /^$day/i) {
				$day = $i;
				last;
			}
		}
		unless ($day =~ /^\d+$/) {
			# Give up...
			$self->err("Can't find info for the day $day");
			return;
		}
	}
	return $self->{forecast}->[$day] unless @_;
	my @conds = @_;
	my @out;
	foreach my $cond (@conds) {
		if (defined($self->{forecast}->[$day]->{$cond})) {
			push (@out, $self->{forecast}->[$day]->{$cond});
		} else {
			$self->err("No forecast condition $cond for day $day");
			push (@out, undef);
		}
	}
	return $out[0] unless $#out;
	return @out;
}

sub forecast_information {
	my $self = shift;
	return $self->{info} unless @_;
	my @conds = @_;

	my @out;
	foreach my $cond (@conds) {
		if (defined($self->{info}->{$cond})) {
			push (@out, $self->{info}->{$cond});
		} else {
			$self->err("No info condition $cond");
			push (@out, undef);
		}
	}
	return $out[0] unless $#out;
	return @out;
}

sub err {
	my $self = shift;
	$self->{ERR} = shift if @_;
	return $self->{ERR};
}

sub _decode {
    my ( $self, $xml ) = @_;
    if ($ENCODE) {
        if ( Encode::is_utf8($xml) ) {
            $xml = Encode::decode_utf8( $xml, $Encode::FB_DEFAULT );
        }
        else {
            $xml = Encode::decode( $self->encoding, $xml, $Encode::FB_DEFAULT );
        }
    }
    else {
        $xml =~ s/[01[:^ascii:]%]//g;
    }
    return $xml;
}

sub _parse {
	my $self = shift;
	my $w = shift;

	$self->{version} = $w->{version};
	$w = $w->{weather};

	$self->{current} = $w->{current_conditions};
	$self->{forecast} = $w->{forecast_conditions};
	$self->{info} = $w->{forecast_information};

	# Make these a bit more readable:
	foreach my $key ( keys ( %{ $self->{current} } ) ) {
		$self->{current}->{$key} = $self->{current}->{$key}->{data};
	}
	foreach my $key ( keys ( %{ $self->{info} } ) ) {
		$self->{info}->{$key} = $self->{info}->{$key}->{data};
	}
	foreach my $day ( @{ $self->{forecast} } ) {
		foreach my $key ( keys ( %{ $day } ) ) {
			$day->{$key} = $day->{$key}->{data};
		}
	}
}

sub DESTROY {
}

sub AUTOLOAD {
	my $self = shift;

	# Alias some things

	my $name = $AUTOLOAD;
	$name =~ s/.+:://;

	# This should prevent warnings of undefined @_
	@_ = () unless @_;

	return $self->current_conditions(@_) if $name eq 'current';
	return $self->forecast_conditions(@_) if $name eq 'forecast';
	return $self->forecast_information(@_) if $name eq 'info';

	# Day of week shortcut
	return $self->forecast_conditions($name,@_) if
		$name =~ /^(Today|Tomorrow)|((Mon|Tue|Wed|Thu|Fri|Sat|Sun)(\w*day)?)$/i;

	# Others are considered access methods to current_conditions
	return $self->current($name);
}

1;

__END__