view release on metacpan or  search on metacpan

lib/DBIx/Class/StorageReadOnly/TT.pm  view on Meta::CPAN

our $VERSION = '0.05';
use DBIx::Class::Storage::DBI;
{
    package DBIx::Class::Storage::DBI;
    use tt (subs => [qw/insert update delete/]);
    [% FOR sub IN subs %]
    {
        no warnings 'redefine';
        no strict 'refs'; ## no critic
        my $[%- sub -%]_code_org = DBIx::Class::Storage::DBI->can('[%- sub -%]');
        *{"DBIx\::Class\::Storage\::DBI\::[%- sub -%]"} = sub {
            my $self = shift;
            if ($self->_search_readonly_info) {
                croak("This connection is read only. Can't [%- sub -%].");
            }
            return $self->$[%- sub -%]_code_org(@_);
        };
    }
    [% END %]
    no tt;

    sub _search_readonly_info {
        my $self = shift;
        for my $info ( @{$self->connect_info} ) {
            if (ref $info eq 'HASH' ) {
                return 1 if $info->{read_only} == 1;