DBIx::Classでスレーブに接続する

レプリケーション環境で、更新系クエリはマスター、参照系クエリはスレーブに振り分けるというのはよくあることだと思います。

PerlのO/RマッパーであるDBIx::ClassにはDBIx::Class::Storage::DBI::Replicationというのがあって、これを使うと利用側で接続先を意識することなくクエリを振り分けることができそうです。しかし、どうやら参照系は必ずスレーブへ振り分けてしまうようなので、トランザクションの中ではマスターを参照したいといった場合に対応できないんじゃないかと思いました。

そこで、明示的にスレーブの接続を取得する方法がないかなーと思ったんですが見当たらなかったので書いてみました。
実装するにあたり以下のClass::DBI用に書かれたコードを参考にしてみました。

http://d.hatena.ne.jp/tokuhirom/20060713/1152780973

コードはCodeReposに上げようかと思ったんですが、いろんな意味で自信がなかったのでビビってしまってあげてません。
コードはCodeReposに上げました！（2008/04/18 追加）

package DBIx::Class::Slave;

use strict;
use warnings;

use base qw(DBIx::Class);
use Carp::Clan qw/^DBIx::Class/;

our $VERSION = '0.01';

__PACKAGE__->mk_group_accessors('simple' => qw(slave_dsns slave_connection_caches));

sub slave_connections {
    my ($self, @dsns) = @_;

    $self->slave_dsns(\@dsns);
    $self->slave_connection_caches({});
}

sub slave {
    my $self = shift;

    my $dsns = $self->slave_dsns;
    unless (@$dsns) {
        croak "No slave data sources.";
    }

    my $num = int(rand(@$dsns));
    my $key = "slave_$num";

    my $connections = $self->slave_connection_caches;
    if (defined $connections && $connections->{$key}) {
        return $self->slave_connection_caches->{$key};
    }
    else {
        my $slave = $self->connect(@{ $dsns->[$num] });
        $connections->{$key} = $slave;
        return $slave;
    }
}

1;

__END__

=head1 NAME

DBIx::Class::Slave - manage slave connections

=head1 SYNOPSIS

in your schema class.

    package Blog::Schema;
    use strict;
    use warnings;
    use base qw(DBIx::Class::Schema);

    __PACKAGE__->load_classes;
    __PACKAGE__->load_components(qw(Slave));

    1;

somewhere else.

    use Blog::Schema;

    my $schema = Test::Blog::Schema->connect("dbi:SQLite:$master");

    # set slave data sources.
    $schema->slave_connections(
        ["dbi:SQLite:$slave_1"],
        ["dbi:SQLite:$slave_2"],
    );

    # do something in slave connection.
    $schema->slave->resultset('Entry')->find(1);

コードはCodeReposからチェックアウトできます。

svn co http://svn.coderepos.org/share/lang/perl/DBIx-Class-Slave/trunk/ DBIx-Class-Slave

Catalystで使う場合。

http://trac.onot.in/public/changeset/652