package Parse::JapanesePostalCode::Row;
use strict;
use warnings;
use utf8;
use Lingua::JA::Regular::Unicode qw/ katakana_h2z /;
sub alnum_z2h {
my $str = shift;
$str = Lingua::JA::Regular::Unicode::alnum_z2h($str);
$str =~ tr/~−/〜-/;
$str;
}
my @COLUMNS = qw/
region_id old_zip zip
pref_kana region_kana town_kana pref region town
is_multi_zip has_koaza_banchi has_chome is_multi_town
update_status update_reason
/;
my @METHODS = (@COLUMNS, qw/
district district_kana city city_kana ward ward_kana
subtown_kana subtown
build build_kana floor
/);
for my $name (@METHODS) {
my $sub = sub { $_[0]->{columns}{$name} };
no strict 'refs';
*{$name} = $sub;
}
sub columns { @COLUMNS }
sub has_subtown { !! $_[0]->subtown }
sub new {
my($class, %opts) = @_;
my $columns = {};
for my $column (@COLUMNS) {
$columns->{$column} = delete $opts{$column} if defined $opts{$column};
}
my $self = bless {
katakana_h2z => 1,
alnum_z2h => 1,
build_town => '',
build_town_kana => '',
%opts,
columns => $columns,
}, $class;
$self->fix_region;
$self->fix_town;
$self->fix_build;
$self->fix_subtown unless $self->build;
$self->fix_kana_alnum;
$self;
}
sub fix_region {
my $self = shift;
my $columns = $self->{columns};
$columns->{district} = undef;
$columns->{district_kana} = undef;
$columns->{city} = undef;
$columns->{city_kana} = undef;
$columns->{ward} = undef;
$columns->{ward_kana} = undef;
# district
my($district, $town_village) = $self->region =~ /^(.+?郡)(.+[町村])$/;
if ($district && $town_village) {
my($district_kana, $town_village_kana) = $self->region_kana =~ /^((?:キタグンマ|.+?)グン)(.+)$/;
$columns->{district} = $district;
$columns->{district_kana} = $district_kana;
$columns->{city} = $town_village;
$columns->{city_kana} = $town_village_kana;
} else {
my($city, $ward) = $self->region =~ /^(.+市)(.+区)$/;
if ($city && $ward) {
my($city_kana, $ward_kana) = $self->region_kana =~ /^((?:ヒロシマ|キタキュウシュウ|.+?)シ)(.+)$/;
$columns->{city} = $city;
$columns->{city_kana} = $city_kana;
$columns->{ward} = $ward;
$columns->{ward_kana} = $ward_kana;
} elsif ($self->region =~ /区$/) {
$columns->{ward} = $self->region;
$columns->{ward_kana} = $self->region_kana;
} else {
$columns->{city} = $self->region;
$columns->{city_kana} = $self->region_kana;
}
}
}
sub fix_town {
my $self = shift;
my $columns = $self->{columns};
if ($columns->{town} eq '以下に掲載がない場合') {
$columns->{town_kana} = undef;
$columns->{town} = undef;
} elsif ($columns->{town} =~ /^(.+)の次に番地がくる場合/) {
my $name = $1;
if ($columns->{city} eq $name || $columns->{city} =~ /郡\Q$name\E$/) {
$columns->{town_kana} = undef;
$columns->{town} = undef;
}
} elsif ($columns->{town} =~ s/(その他)$//) {
$columns->{town_kana} =~ s/\(ソノタ\)$//;
} elsif ($columns->{town} =~ /^(.+[町村])一円$/) {
my $name = $1;
if ($columns->{city} eq $name) {
$columns->{town_kana} = undef;
$columns->{town} = undef;
}
}
$columns->{town} =~ s/[〜~]/〜/g if $columns->{town};
}
sub fix_subtown {
my $self = shift;
my $columns = $self->{columns};
return unless $columns->{town};
my @subtown;
my @subtown_kana;
# chome
if ($columns->{town} =~ s/(([\d〜、]+)丁目)$//) {
my $num = alnum_z2h($1);
my @nums = map {
if (/^(\d+)〜(\d+)$/) {
($1..$2);
} else {
$_
}
} map { alnum_z2h($_) } split /、/, $1;
@subtown = map { $_ . '丁目' } @nums;
@subtown_kana = map { $_ . 'チョウメ' } @nums;
$columns->{town_kana} =~ s/\([\d\-、]+チョウメ\)$//;
}
# chiwari
elsif ($columns->{town} =~ /^[^\(]+地割/) {
my($prefix, $koaza) = $columns->{town} =~ /^(.+\d+地割)(?:((.+)))?$/;
my($prefix_kana, $koaza_kana) = $columns->{town_kana} =~ /^(.+\d+チワリ)(?:\((.+)\))?$/;
my($aza, $chiwari) = $prefix =~ /^(.+?)第?(\d+地割.*)$/;
my($aza_kana, $chiwari_kana) = $prefix_kana =~ /^(.+?)(?:ダイ)?(\d+チワリ.*)$/;
if ($chiwari =~ /〜/) {
my @tmp = map {
if (/\d+地割$/) {
my $str = $_;
$str =~ s/^\Q$aza\E//;
$str =~ s/^第//;
"第$str";
} else {
$_;
}
} split /〜/, $chiwari;
$chiwari = join '〜', @tmp;
}
if ($chiwari_kana =~ /-/) {
my @tmp = map {
if (/\d+チワリ$/) {
my $str = $_;
$str =~ s/^\Q$aza_kana\E//;
$str =~ s/^ダイ//;
"ダイ$str";
} else {
$_;
}
} split /-/, $chiwari_kana;
$chiwari_kana = join '-', @tmp;
}
@subtown = map {
if (/\d+地割$/) {
my $str = $_;
$str =~ s/^\Q$aza\E//;
$str =~ s/^第//;
"第$str";
} else {
$_;
}
} split /、/, $chiwari;
@subtown_kana = map {
if (/\d+チワリ$/) {
my $str = $_;
$str =~ s/^\Q$aza_kana\E//;
$str =~ s/^ダイ//;
"ダイ$str";
} else {
$_;
}
} split /、/, $chiwari_kana;
if ($koaza) {
@subtown = map {
my $str = $_;
map {
"$str $_";
} split /、/, $koaza;
} @subtown;
}
if ($koaza_kana) {
@subtown_kana = map {
my $str = $_;
map {
"$str $_";
} split /、/, $koaza_kana;
} @subtown_kana;
}
$columns->{town} = $aza;
$columns->{town_kana} = $aza_kana;
}
# other
elsif ($columns->{town} =~ s/((.+?))$//) {
my $town = $1;
$town =~ s{「([^\」]+)」}{
my $str = $1;
$str =~ s/、/_____COMMNA_____/g;
"「${str}」";
}ge;
@subtown = map {
my $str = $_;
$str =~ s/_____COMMNA_____/、/g;
$str;
} split /、/, $town;
if ($columns->{town_kana} =~ s/\((.+?)\)$//) {
my $kana = $1;
$kana =~ s{<([^>]+)>}{
my $str = $1;
$str =~ s/、/_____COMMNA_____/g;
"<${str}>";
}ge;
@subtown_kana = map {
my $str = $_;
$str =~ s/_____COMMNA_____/,/g;
$str;
} split /、/, $kana;
}
}
if (@subtown) {
$columns->{subtown} = \@subtown;
$columns->{subtown_kana} = \@subtown_kana;
}
}
sub fix_build {
my $self = shift;
my $columns = $self->{columns};
unless ($self->{build_town}) {
unless ($columns->{town} && $columns->{town} =~ /(.+?階.*?)$/) {
return;
}
}
my $build_town = $self->{build_town};
my $build_town_kana = $self->{build_town_kana};
$columns->{town} =~ s/(高層棟)//;
$columns->{town_kana} =~ s/\(コウソウトウ\)//;
if ($columns->{town} =~ s/(次のビルを除く)$//) {
$columns->{town_kana} =~ s/\(ツギノビルヲノゾク\)$//;
} elsif ($columns->{town} =~ /^\Q$build_town\E(.+)((.+))$/) {
my $floor = $2;
$columns->{build} = $1;
if ($floor =~ /(\d+)階/) {
$columns->{floor} = alnum_z2h($1);
}
$columns->{town_kana} =~ /^\Q$build_town_kana\E(.+)\(.+$/;
$columns->{build_kana} = $1;
$columns->{town} = $build_town;
$columns->{town_kana} = $build_town_kana;
}
}
sub fix_kana_alnum {
my $self = shift;
return unless $self->{katakana_h2z} || $self->{alnum_z2h};
for my $name (qw/ pref_kana region_kana district_kana city_kana ward_kana town_kana build_kana pref region district city ward town build /) {
next unless defined $self->{columns}{$name};
$self->{columns}{$name} = katakana_h2z($self->{columns}{$name}) if $self->{katakana_h2z};
$self->{columns}{$name} = alnum_z2h($self->{columns}{$name}) if $self->{alnum_z2h};
}
if ($self->has_subtown) {
for my $i (0..(scalar(@{ $self->subtown }) - 1)) {
$self->subtown->[$i] = katakana_h2z($self->subtown->[$i]) if $self->{katakana_h2z};
$self->subtown->[$i] = alnum_z2h($self->subtown->[$i]) if $self->{alnum_z2h};
}
for my $i (0..(scalar(@{ $self->subtown_kana }) - 1)) {
$self->subtown_kana->[$i] = katakana_h2z($self->subtown_kana->[$i]) if $self->{katakana_h2z};
$self->subtown_kana->[$i] = alnum_z2h($self->subtown_kana->[$i]) if $self->{alnum_z2h};
}
}
}
1;
__END__
=encoding utf8
=head1 NAME
Parse::JapanesePostalCode::Row - Object of Japanese PostalCode
=head1 METHODS
=head2 new
instance method.
=head2 region_id
全国地方公共団体コード(JIS X0401、X0402) を返します。
=head2 old_zip
(旧)郵便番号(5桁) を返します。
=head2 zip
郵便番号(7桁) を返します。
=head2 pref
都道府県名 を返します。
=head2 region
市区町村名 を返します。町村の場合には郡を含み、政令指定都市の場合には区を含みます。
=head2 district
region から、郡名を抜き出した物を返します。なければ undef が返ります。
=head2 city
region から、市名を抜き出した物を返します。なければ undef が返ります。
=head2 ward
region から、区名を抜き出した物を返します。なければ undef が返ります。
=head2 town
町域名 を返します。小字、丁目、番地,号、ビル名等は含まれません。基本的に大字と同等の町域名が入ります。
実質町域を指定していない物では undef が返ります。
=head2 build
ビル名が入ります。なければ undef が返ります。
=head2 floor
ビルの階が入ります。地階、不明階やビルでない場合には undef が返ります。
=head2 has_subtown
小字、丁目、番地,号がある場合には真が返ります。
=head2 subtown
小字、丁目、番地,号等が ARRAY ref で返ります。
=head2 pref
都道府県名 を返します。
=head2 region_kana
カタカナが返ります。
=head2 district_kana
カタカナが返ります。
=head2 city_kana
カタカナが返ります。
=head2 ward_kana
カタカナが返ります。
=head2 town_kana
カタカナが返ります。
=head2 build_kana
カタカナが返ります。
=head2 subtown_kana
カタカナが返ります。
=head2 is_multi_zip
一町域が二以上の郵便番号で表される場合の表示 が返ります。
=head2 has_koaza_banchi
小字毎に番地が起番されている町域の表示 が返ります。
=head2 has_chome
丁目を有する町域の場合の表示 が返ります。
=head2 is_multi_town
一つの郵便番号で二以上の町域を表す場合の表示 が返ります。
=head2 update_status
更新の表示 が返ります。
=head2 update_reason
変更理由 が返ります。
=head1 AUTHOR
Kazuhiro Osawa E<lt>yappo {at} shibuya {dot} plE<gt>
=head1 SEE ALSO
L<Parse::JapanesePostalCode>,
L<http://www.post.japanpost.jp/zipcode/download.html>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut