DBIx::Class::StorageReadOnly

Perl

とかいうのをでっち上げてみた。
スレーブにinsertとかupdateとかかけて死ねるのはイヤンなので。
まあ、開発環境のDBもちゃんと設定しておけば
こんなの使わなくても気づくのですが、保険です。



package DBIx::Class::StorageReadOnly;

use strict;

use warnings;

use base 'DBIx::Class';

use Carp::Clan qw/^DBIx::Class/;
sub insert {

    my $self = shift;
    if ($self->result_source->schema->{__READ_ONLY_CONNECTION}) {

        croak("This connection is read only. Can't insert.");

    }

    $self->next::method(@_);

}
sub update {

    my $self = shift;
    if ($self->result_source->schema->{__READ_ONLY_CONNECTION}) {

        croak("This connection is read only. Can't update.");

    }

    $self->next::method(@_);

}
1;

こんな感じにプラグインに。
DBIx::Class::Storage::DBIとかをもにゅもにゅするのは激しく面倒だったので。
たぶんたぶんClass::C3とかつかってるんだからこれでいいんじゃ根とか思ったりもしたり。

使い方はこんな感じで



__PACKAGE__->load_components(qw/

    StorageReadOnly

    DigestColumns::Lite

    AsFdat

    PK::Auto

    Core

/);

load_componentsして、



# インスタンス作る

my $schema = $schema_class->connect(@connection_info);

# フラグをセットする

$schema->{__READ_ONLY_CONNECTION} = 1; # set read only flag.

これだけ。

$schema->{__READ_ONLY_CONNECTION}をセットしたインスタンス経由で
insertとかupdateはできなくなります。
エラーで落とします。
まあ、テストで気づいてくれってことで。

(追記)

$self->next::method(@_);

この１文が無いと駄目ね。忘れてた。
しぬることのみ確認して満足してますたわ。

（追記２）

とりあえずらぼに上げてみた。
http://code.mfac.jp/trac/browser/CPAN/nekokak/DBIx-Class-StorageReadOnly/