Geography::JapanesePrefectures::Walker

こんな感じでおさまりそう。
文字コードもこれでいい感じに。

package Geography::JapanesePrefectures::Walker;

use strict;

use warnings;

use Carp;

use Scalar::Util qw(blessed);

use UNIVERSAL;

use Encode;

use List::MoreUtils qw/uniq firstval/;

use Geography::JapanesePrefectures;
sub new {

    my $class = shift;

    my $encoding = shift || 'utf8';

    my $param = {

        encoding => $encoding,

    };

    bless $param, $class;

}
 *isa = \&UNIVERSAL::isa;
sub prefectures_infos {

    my $self = shift;

    $self->encode_to(Geography::JapanesePrefectures->prefectures_infos);

}
sub encode_to {

    my($self, $stuff) = @_;

    $self->apply(

        sub {

            my $val = shift;

            Encode::from_to($val,'utf-8',$self->{encoding});

            $val;

        }

    )->($stuff);

}
sub apply { ## no critic

    my $self = shift;

    my $code = shift;
    my $keyapp = sub { $code->(shift) };
    my $curry; # recursive so can't init

    $curry = sub {

        my @retval;

        for my $arg (@_){

            my $class = ref $arg;

            croak 'blessed reference forbidden'

                if  !$self->{apply_blessed} and blessed $arg;

                my $val =

                    !$class ?

                        $code->($arg) :

                    isa($arg, 'ARRAY') ?

                        [ $curry->(@$arg) ] :

                    isa($arg, 'HASH') ?

                        {

                        map { $keyapp->($_)

                                => $curry->($arg->{$_}) } keys %$arg

                        } :

                    isa($arg, 'SCALAR') ?

                        \do{ $curry->($$arg) } :

                    isa($arg, 'REF') && $self->{apply_ref} ?

                        \do{ $curry->($$arg) } :

                    isa($arg, 'GLOB')  ?

                        *{ $curry->(*$arg) } :

                    isa($arg, 'CODE') && $self->{apply_code} ?

                        $code->($arg) :

                    croak "I don't know how to apply to $class" ;

                bless $val, $class if blessed $arg;

                push @retval, $val;

        }

        return wantarray ? @retval : $retval[0];

    };

}
sub prefectures {

    my ($self, $args) = @_;
    my $prefs = $self->prefectures_infos;

    return [ map { {

                    id     => $_->{id} ,

                    name   => $_->{name},

                    region => $_->{region},

                   } } @$prefs ];

}
sub prefectures_name_for_id {

    my ($self, $args) = @_;
    my $prefs = $self->prefectures_infos;

    my $pref = firstval { $_->{id} } grep { $_->{id} eq $args->{id} } @$prefs;

    return $pref->{name};

}
sub prefectures_name {

    my ($self, $args) = @_;
    my $prefs = $self->prefectures_infos;

    return map { $_->{name} } @$prefs;

}
sub prefectures_regions {

    my ($self, $args) = @_;
    my $prefs = $self->prefectures_infos;

    return uniq map { $_->{region} } @$prefs;

}
sub prefectures_name_for_region {

    my ($self, $args) = @_;
    my $prefs = $self->prefectures_infos;

    return map { $_->{name} }

           grep { $_->{region} eq $args->{region} }

           @$prefs;

}
sub prefectures_id_for_name {

    my ($self, $args) = @_;
    my $prefs = $self->prefectures_infos;

    my $pref = firstval { $_->{id} } grep { $_->{name} eq $args->{name} } @$prefs;

    return $pref->{id};

}
1;