File Coverage

blib/lib/WebService/StreetMapLink.pm

Criterion	Covered	Total	%
statement	71	73	97.2
branch	14	20	70.0
condition	3	5	60.0
subroutine	19	19	100.0
pod	4	5	80.0
total	111	122	90.9

package WebService::StreetMapLink;

use strict;

use vars qw($VERSION);

$VERSION = 0.21;

use Class::Factory::Util;
use URI;

use Params::Validate qw( validate_with SCALAR UNDEF );


my %CountryToClass;

sub RegisterSubclass
{
    my $class    = shift;
    my $priority = shift || 100;

    foreach my $country ( map { lc } $class->Countries )
    {
        push @{ $CountryToClass{$country} },
            { class    => $class,
              priority => $priority,
            };
    }
}

BEGIN
{
    for my $class ( map { __PACKAGE__ . '::' . $_ } __PACKAGE__->subclasses )
    {
        eval "use $class";
        die $@ if $@;
    }
}

use constant NEW_SPEC => { country     => { type => SCALAR },
                           address     => { type => UNDEF | SCALAR, optional => 1 },
                           city        => { type => UNDEF | SCALAR, optional => 1 },
                           state       => { type => UNDEF | SCALAR, optional => 1 },
                           postal_code => { type => UNDEF | SCALAR, optional => 1 },
                           subclass    => { type => UNDEF | SCALAR, optional => 1 },
                         };

sub new
{
    my $class = shift;
    my %p = validate_with( params => \@_,
                           spec   => NEW_SPEC,
                           allow_extra => 1,
                         );

    my $subclass;
    if ( $p{subclass} )
    {
        if ( $p{subclass} =~ /::/ )
        {
            $subclass = $p{subclass};
        }
        else
        {
            $subclass = __PACKAGE__  . '::' . $p{subclass};
        }

        delete $p{subclass};
    }

    unless ($subclass)
    {
        my $country = $class->_sanitize_country( $p{country} );

        return unless exists $CountryToClass{$country};

        my $entry =
            (sort { $a->{priority} <=> $b->{priority} } @{ $CountryToClass{$country} })[0];
        $subclass = $entry->{class};

        $p{country} = $country;
    }

    return $subclass->new(%p);
}

sub _sanitize_country
{
    shift;
    my $country = shift;

    if ( $country =~ /united\s+states|u\.s\.(?:a\.)?/i )
    {
        $country = 'usa';
    }

    if ( $country =~ /united\s+kingdom|u\.k\./i )
    {
        $country = 'uk';
    }

    return lc $country;
}

sub uri_object
{
    my $self = shift;

    my $uri = URI->new( '' );

    foreach my $k ( qw( scheme host path ) )
    {
        my $m = "_$k";
        $uri->$k( $self->$m() )
            if $self->can($m);
    }

    $uri->query_form( $self->_query )
        if $self->can('_query');

    return $uri->canonical;
}

sub uri
{
    $_[0]->uri_object->as_string;
}

sub _scheme { $_[0]->{scheme} ? $_[0]->{scheme} : 'http' }

sub _host  { $_[0]->{host} }
sub _path  { $_[0]->{path} }
sub _query { $_[0]->{query} }

sub service_name
{
    my $self = shift;

    my $class = ref $self || $self;

    return ( split /::/, $class )[-1];
}


1;

__END__