http://blog.eorzea.asia/2010/12/post_94.html

Active Record パターンでは Single Table Inheritance パターンがつかえないというのは誤りです。件の記事にかいてある Active Record だからー、ってかいてあるのは単に DBIC の問題か DBIC のつかいかたの問題じゃないかとおもいます。

実際に僕は DBIC で Single Table Inheritance つかってましたし。なので、それを紹介しようとおもったものの、すっかりわすれてしまっている上に DBIC のつかいかたもおもいだせないので、Skinny で example code をおこしました。

以下のコードではつかって若干トリッキーなことをやってる風にみえますが、本質的にはごく普通のことをしています。

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

package MyApp::DB;
use DBIx::Skinny;
use Class::Load ();

# BK
no warnings 'redefine';
sub DBIx::Skinny::load_class {
    my ($mod) = @_;
    return $mod if Class::Load::is_class_loaded($mod);
    return $mod if Class::Load::try_load_class($mod);
    return undef;
}

package MyApp::DB::Schema;
use DBIx::Skinny::Schema;

install_table 'player' => sub {
    pk 'id';
    columns qw/id name club batting_avarage bowling_avarage type/;
};

package MyApp::DB::Row::Player;
use parent qw/DBIx::Skinny::Row/;
use Carp;

sub new {
    my ( $class, $args ) = @_;
    for ( $args->{row_data}->{type} ) {
        return MyApp::DB::Row::Cricketer->SUPER::new($args)  if $_ eq 'cricketer';
        return MyApp::DB::Row::Bowler->SUPER::new($args)     if $_ eq 'bowler';
        return MyApp::DB::Row::Footballer->SUPER::new($args) if $_ eq 'footballer';
        croak("unknown class type: $_");
    }
}

sub salute { }

package MyApp::DB::Row::Cricketer;
use parent -norequire, qw/MyApp::DB::Row::Player/;

sub bat { }

package MyApp::DB::Row::Bowler;
use parent -norequire, qw/MyApp::DB::Row::Cricketer/;

sub bowl { }

package MyApp::DB::Row::Footballer;
use parent -norequire, qw/MyApp::DB::Row::Player/;

sub kick { }

package main;
use Test::More;
use Data::Dumper;

my $dbh = DBI->connect('dbi:SQLite:');
$dbh->do(q{create table player (id INTEGER PRIMARY KEY, name, club, batting_avarage, bowling_avarage, type)});
my $db = MyApp::DB->new({dbh => $dbh});
$db->bulk_insert(
    player => [
        {
            name => 'kurikan',
            type => 'cricketer',
        },
        {
            name => 'bobobo',
            type => 'bowler',
        },
        {
            name => 'football hour',
            type => 'footballer',
        },
    ]
);

my $cricketer = $db->single(player => { name => 'kurikan' });
isa_ok $cricketer, 'MyApp::DB::Row::Cricketer';
isa_ok $cricketer, 'MyApp::DB::Row::Player';
is $cricketer->type, 'cricketer';
can_ok $cricketer, qw/salute bat/;

my $footballer = $db->single(player => { name => 'football hour' });
isa_ok $footballer, 'MyApp::DB::Row::Footballer';
isa_ok $footballer, 'MyApp::DB::Row::Player';
is $footballer->type, 'footballer';
can_ok $footballer, qw/salute kick/;

my $bowler = $db->single(player => { name => 'bobobo' });
isa_ok $bowler, 'MyApp::DB::Row::Bowler';
isa_ok $bowler, 'MyApp::DB::Row::Cricketer';
isa_ok $bowler, 'MyApp::DB::Row::Player';
is $bowler->type, 'bowler';
can_ok $bowler, qw/salute bat bowl/;
$bowler->set(+{club => 'Nintendo'});
$bowler->update;
$bowler = $db->single(player => { name => 'bobobo' });
is $bowler->club, 'Nintendo';

done_testing;