File Coverage

blib/lib/DBD/BlackHole.pm

Criterion	Covered	Total	%
statement	69	72	95.8
branch	7	10	70.0
condition	3	8	37.5
subroutine	29	33	87.8
pod	0	1	0.0
total	108	124	87.1

package DBD::BlackHole;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.03";

use DBI;

our $drh    = undef;
our $err    = '';
our $errstr = '';

sub driver {
    my ($class, $attr) = @_;
    return $drh ||= DBI::_new_drh("${class}::dr", {
        Name        => 'BlackHole',
        Version     => $VERSION,
        Attribution => 'BlackHole DBD driver',
        Err         => \$err,
	Errstr      => \$errstr,
    });
}

sub CLONE {
    undef $drh;
}

package DBD::BlackHole::dr;
use strict;
use warnings;

our $imp_data_size = 0;

sub connect {
    my $dbh = shift->SUPER::connect(@_)
        or return;
    $dbh->STORE(Active => 1);
    return $dbh;
}

sub data_sources { qw/dbi:BlackHole:/ }

package DBD::BlackHole::db;
use strict;
use warnings;

use Carp qw/croak/;

use constant DEFAULT_IDENTIFIER => '`';

our $imp_data_size = 0;

sub get_info {
    my ($dbh, $type) = @_;
    # identifier quote
    return $dbh->FETCH('blackhole_identifier') || DEFAULT_IDENTIFIER if $type == 29;
    return;
}

sub prepare {
    my ($dbh, $statement) = @_;

    my $sth = DBI::_new_sth($dbh, {
        Statement     => $statement,
	NAME          => ['dummy'],
        NUM_OF_FIELDS => -1,
    });

    return $sth;
}

sub ping { shift->FETCH('Active') }

sub disconnect { shift->STORE(Active => 0) }

sub begin_work { 1 }
sub commit { 1 }
sub rollback { 1 }
sub tables {}

sub FETCH {
    my $dbh = shift;
    my $key = shift;
    return 1 if $key eq 'AutoCommit';
    return $dbh->SUPER::FETCH($key);
}

sub STORE {
    my $dbh = shift;
    my ($key, $value) = @_;

    if ($key eq 'AutoCommit') {
        croak 'Cannot disable AutoCommit' if !$value && $dbh->FETCH('AutoCommit');
        return $value;
    }
    return $dbh->SUPER::STORE($key, $value);
}

sub DESTROY { shift->disconnect }

package DBD::BlackHole::st;
use strict;
use warnings;

our $imp_data_size = 0;

sub bind_col { 1 }
sub bind_param { 1 }

sub execute {
    my $sth = shift;
    $sth->STORE(NUM_OF_FIELDS => 1);
    $sth->STORE(NUM_OF_PARAMS => 0);
    1;
}

sub rows { 0 }

sub fetch {}

sub fetchall_hashref { +{} }

1;
__END__