File Coverage

blib/lib/WebService/StreetMapLink/Google.pm

Criterion	Covered	Total	%
statement	25	26	96.1
branch	3	6	50.0
condition	2	6	33.3
subroutine	6	7	85.7
pod	3	4	75.0
total	39	49	79.5

package WebService::StreetMapLink::Google;

use strict;

use Geography::States;

use base 'WebService::StreetMapLink';
__PACKAGE__->RegisterSubclass(99);


my @Accents = ( [ qr/[\xE0-\xE2]/ => 'a' ],
                [ qr/[\xE8-\xEA]/ => 'e' ],
                [ qr/\xE7/        => 'c' ],
                [ qr/\xF4/        => 'o' ],
              );

sub Countries
{
    return ( qw( australia austria belgium
                 canada denmark
                 france germany hungary
                 italy netherlands
                 singapore spain
                 sweden switzerland
                 uk usa
              ),
             'czech republic',
             'puerto rico'
           );
}

sub Priority { 99 }

sub new
{
    my $class = shift;
    my %p = @_;

    local $_;
    # remove accents from state names like Quebec or google gets upset
    for ( grep { defined } values %p )
    {
        foreach my $p (@Accents)
        {
            s/$p->[0]/$p->[1]/g;
        }
    }

    return
        unless ( defined $p{address}
                 &&
                 ( ( defined $p{city}
                     && ( defined $p{state} || $p{country} ne 'usa' )
                   )
                   ||
                   defined $p{postal_code}
                 )
               );

    return if $p{address} =~ /p\.?o\.\s+box/i;

    $p{postal_code} =~ s/-\d{4}$//
        if defined $p{postal_code};

    my $q =
        ( join ',',
          grep { defined }
          map { $p{$_} } qw( address city state postal_code country )
        );

    return bless { host  => 'maps.google.com',
                   path  => '/maps',
                   query => { q => $q }
                 }, $class;
}

sub service_name { 'Google Maps' }


1;

__END__