Sub::AutoでDBICにfindByほげほげを生やしてみた

Perl DBIC

が面白そうだったのでDBIC::ResultSetにfindBy〜を生やしてみた。

perldoc見ても$selfがどこに入ってくるのか分からんかったけど、@_に関数名のマッチが入って、その次に来るみたい。

#!/usr/bin/perl
use strict;
use warnings;

package DBIx::Class::ResultSet;
use Sub::Auto;

autosub /^findBy(\w+)$/ {
    my ( $method, $self, $value ) = @_;
    $method = lc $method;
    return undef unless grep /^$method$/, $self->result_source->columns;
    $self->single( { $method => $value } );
}

autosub /^findAllBy(\w+)$/ {
    my ( $method, $self, $value ) = @_;
    $method = lc $method;
    return undef unless grep /^$method$/, $self->result_source->columns;
    $self->search( { $method => $value } )->all;
}

package main;
use MyApp::Schema;
use Test::More tests => 13;

my $schema = MyApp::Schema->connect('dbi:mysql:dbname', 'username', 'password');
my $u = $schema->resultset('Users');
my ( $user, @users );

$user = $u->findByName('taro');
isa_ok $user, 'MyApp::Schema::Users';
is $user->name, 'taro';

$user = $u->findById(2);
isa_ok $user, 'MyApp::Schema::Users';
is $user->name, 'jiro';

is $u->findByName('hanako'), undef, 'no results';
is $u->findByHoge('hoge'), undef, 'find by unknown column';

@users = $u->findAllByName('taro');
is @users, 1;
is $users[0]->name, 'taro';

@users = $u->findAllByPref('tokyo');
is @users, 2;
is $users[0]->name, 'taro';
is $users[1]->name, 'saburo';

is $u->findAllByPref('kyoto'), 0, 'no results';
is $u->findAllByHoge('hoge'), undef, 'find all by unknown column';