File Coverage

blib/lib/Number/ZipCode/JP.pm

Criterion	Covered	Total	%
statement	64	73	87.6
branch	12	20	60.0
condition	5	11	45.4
subroutine	13	13	100.0
pod	3	3	100.0
total	97	120	80.8

package Number::ZipCode::JP;

use strict;
use warnings;
use 5.008_001;
use Carp;
use UNIVERSAL::require;

our $VERSION = '0.20260630';
our %ZIP_TABLE = ();

sub import {
    my $self = shift;
    %ZIP_TABLE = ();
    if (@_) {
        my @packages = ();
        for my $subclass (@_) {
            push @packages,
                sprintf('%s::Table::%s', __PACKAGE__, ucfirst(lc($subclass)));
        }
        %ZIP_TABLE = _merge_table(@packages);
    }
    else {
        require Number::ZipCode::JP::Table;
        import  Number::ZipCode::JP::Table;
    }
    return $self;
}

sub _merge_table {
    my %table = ();
    for my $pkg (@_) {
        $pkg->require or croak $@;
        {
            no strict 'refs';
            while (my($k, $v) = each %{"$pkg\::ZIP_TABLE"}) {
                $table{$k} ||= [];
                push @{$table{$k}}, $v;
            }
        }
    }
    return %table;
}

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    $self->set_number(@_) if @_;
    return $self;
}

sub set_number {
    my $self   = shift;
    my $number = shift;
    if (ref($number) eq 'ARRAY') {
        $self->_prefix = shift @$number;
        $self->_suffix = shift @$number;
    }
    elsif (defined $_[0]) {
        $self->_prefix = $number;
        $self->_suffix = $_[0];
    }
    elsif ($number =~ /^(\d{3})(?:\D)?(\d{4})$/) {
        my $pref = $1;
        my $suff = $2;
        $self->_prefix = $pref;
        $self->_suffix = $suff;
    }
    else {
        carp "The number is invalid zip-code.";
        $self->_prefix = ();
        $self->_suffix = ();
    }
    return $self;
}

sub is_valid_number {
    my $self = shift;
    my $pref = $self->_prefix;
    my $suff = $self->_suffix;
    unless ($pref || $suff) {
        carp "Any number was not set";
        return;
    }
    return unless $pref =~ /^\d{3}$/ && $suff =~ /^\d{4}$/;
    my $re_ref = $ZIP_TABLE{$pref};
    return unless defined $re_ref && ref($re_ref) eq 'ARRAY';
    my $matched;
    for my $re (@$re_ref) {
        if ($suff =~ /^$re$/) {
            $matched = 1;
            last;
        }
    }
    return $matched;
}

sub _prefix : lvalue { shift->{_prefix} }
sub _suffix : lvalue { shift->{_suffix} }

1;
__END__