DBIx::Class::Resultにis_*をいい感じに追加したい。

たとえばカードゲームでは、ほぼ確実にカードによってタイプが決まっている。
アイドルマスター シンデレラなんちゃらだったら、キュートだとかクールだとかそんなの。
そういうのが作る度に $result->is_cool だとかis_cuteだとか作るのだるくなってきたので、自動で生やせるようにしたかった。
あとMyApp::Constにcool => 1, cute => 2とか書くのも疲れたのでenumっぽい感じにしたかった。

# package MyApp::Schema::Result::Card;
use parent "MyApp::Schema::Result";

__PACKAGE__->add_columns(
    ...,
    type => {type => "Card", ... },
    ...,
);

# MyApp::Schema::Result
sub register_column {
    my ($class, $column, $info, @rest) = @_;

    $class->next::method($column, $info, @rest);

    return if !$info->{type};
    my $type = $info->{type};

    my $klass = MyApp::Util::load_class($type, "MyApp::Type");

    $klass->install_methods_for($class, $column);
}

package MyApp::Role::Type;
use 5.10.1;
use utf8;

use Mouse::Role;
use Mouse::Util;
use MyApp::Exception;

requires qw(specs);

no Mouse::Role;

sub builded_specs {
    my ($class) = @_;
    my $builded_specs = do {
        my $specs = $class->specs;

        my %result;
        my $i = 1;
        for my $name (@$specs) {
            $result{$name} = $i;
            $i++;
        }

        \%result;
    };
}

sub find_by_name {
    my ($self, $name) = @_;
    my $builded_specs = $self->builded_specs;
    if (my $spec = $builded_specs->{$name}) {
        return $spec;
    }
    die "fuck";
}

sub find_by_number {
    my ($self, $number) = @_;
    my $builded_specs = $self->builded_specs;

    if (my $spec = {reverse %$builded_specs}->{$number}) {
        return $spec;
    }
    die "fuck";
}

sub install_methods_for {
    my ($self, $result, $column) = @_;

    my $specs   = $self->specs;
    my %methods = map {
        my $name = $_;
        (
            "is_$name" => sub {
                $_[0]->$column == $self->find_by_name($name)
            },
        )
    } @$specs;

    Mouse::Util::install_subroutines($result, %methods);
}

1;

package MyApp::Type::Card;
use utf8;
use Mouse;
with "MyApp::Role::Type";

no Mouse;

sub specs {
    [qw(cool cute)];
}

1;

で、作って気づいたけど、素直に述語メソッド書いた方が早かった。