File Coverage

blib/lib/Number/Phone/JP/AreaCode.pm

Criterion	Covered	Total	%
statement	85	85	100.0
branch	12	12	100.0
condition	5	6	83.3
subroutine	17	17	100.0
pod	4	4	100.0
total	123	124	99.1

package Number::Phone::JP::AreaCode;
use 5.008005;
use strict;
use warnings;
use utf8;
use parent qw/Exporter/;
use Encode;
use Lingua::JA::Numbers;
use Lingua::JA::Regular::Unicode qw/alnum_h2z/;
use Number::Phone::JP::AreaCode::Data::Address2AreaCode;
use Number::Phone::JP::AreaCode::Data::AreaCode2Address;

our $VERSION   = "20131201.2";
our @EXPORT_OK = qw/
    area_code_by_address
    area_code_by_address_prefix_match
    area_code_by_address_fuzzy
    address_by_area_code
/;

sub area_code_by_address {
    my ($address) = @_;

    my ($prefecture, $town) = _separate_address($address);
    return get_address2areacode_map()->{$prefecture}->{$town};
}

sub area_code_by_address_prefix_match {
    my ($address) = @_;

    my ($prefecture, $town) = _separate_address($address);
    my $pref_map = get_address2areacode_map()->{$prefecture};
    return _search_area_code_by_address_recursive($pref_map, $town);
}

sub area_code_by_address_fuzzy {
    my ($address) = @_;

    my ($prefecture, $town) = _separate_address($address);
    my $pref_map = get_address2areacode_map()->{$prefecture};

    if (exists $pref_map->{$town}) {
        return {"$prefecture$town" => $pref_map->{$town}};
    }

    my $hits = {};
    for my $key (keys %$pref_map) {
        if ($town =~ $key || $key =~ $town) {
            $hits->{"$prefecture$key"} = $pref_map->{$key};
        }
    }
    return $hits;
}

sub address_by_area_code {
    my ($area_code) = @_;

    $area_code =~ s/\A0//;
    return get_areacode2address_map()->{$area_code};
}

sub _search_area_code_by_address_recursive {
    my ($pref_map, $town) = @_;

    if (exists $pref_map->{$town}) {
        return $pref_map->{$town};
    }

    $town = _minimum_substitute_by_municipality($town);

    # One character or less (e.g. "町")
    if (!$town || length $town <= 1) {
        return;
    }

    return _search_area_code_by_address_recursive($pref_map, $town);
}

sub _separate_address {
    my ($address) = @_;

    eval { $address = Encode::decode_utf8($address) }; # decode (but not twice)

    my ($prefecture, $town) = $address =~ /\A(京都府|東京都|大阪府|北海道|.+?県)(.*)/;
    $town =~ s/大字//g; # XXX ignore "大字"

    # Support numerical number (hankaku / zenkaku)
    for my $num (0..9) {
        my $kanji_num   = num2ja($num);
        my $zenkaku_num = alnum_h2z($num);
        $town =~ s/(:?$num|$zenkaku_num)/$kanji_num/g;
    }

    return ($prefecture, $town);
}

sub _minimum_substitute_by_municipality {
    my ($town) = @_;

    my @substitutes;
    (my $block   = $town) =~ s/区.*?\Z/区/; push @substitutes, $block;
    (my $city    = $town) =~ s/市.*?\Z/市/; push @substitutes, $city;
    (my $group   = $town) =~ s/郡.*?\Z/郡/; push @substitutes, $group;
    (my $cho     = $town) =~ s/町.*?\Z/町/; push @substitutes, $cho;
    (my $village = $town) =~ s/村.*?\Z/村/; push @substitutes, $village;

    my $minimum_substituted = '';
    for my $substituted (@substitutes) {
        next if $substituted eq $town;
        if (length $substituted > length $minimum_substituted) {
            $minimum_substituted = $substituted;
        }
    }

    return $minimum_substituted;
}

1;
__END__