/usr/share/perl5/DBD/Mock/dr.pm is in libdbd-mock-perl 1.45-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | package DBD::Mock::dr;
use strict;
use warnings;
our $imp_data_size = 0;
sub connect {
my ( $drh, $dbname, $user, $auth, $attributes ) = @_;
if ( $drh->{'mock_connect_fail'} == 1 ) {
$drh->set_err( 1, "Could not connect to mock database" );
return;
}
$attributes ||= {};
if ( $dbname && $DBD::Mock::AttributeAliasing ) {
# this is the DB we are mocking
$attributes->{mock_attribute_aliases} =
DBD::Mock::_get_mock_attribute_aliases($dbname);
$attributes->{mock_database_name} = $dbname;
}
# holds statement parsing coderefs/objects
$attributes->{mock_parser} = [];
# holds all statements applied to handle until manually cleared
$attributes->{mock_statement_history} = [];
# ability to fake a failed DB connection
$attributes->{mock_can_connect} = 1;
# ability to make other things fail :)
$attributes->{mock_can_prepare} = 1;
$attributes->{mock_can_execute} = 1;
$attributes->{mock_can_fetch} = 1;
my $dbh = DBI::_new_dbh( $drh, { Name => $dbname } )
|| return;
return $dbh;
}
sub FETCH {
my ( $drh, $attr ) = @_;
if ( $attr =~ /^mock_/ ) {
if ( $attr eq 'mock_connect_fail' ) {
return $drh->{'mock_connect_fail'};
}
elsif ( $attr eq 'mock_data_sources' ) {
unless ( defined $drh->{'mock_data_sources'} ) {
$drh->{'mock_data_sources'} = ['DBI:Mock:'];
}
return $drh->{'mock_data_sources'};
}
else {
return $drh->SUPER::FETCH($attr);
}
}
else {
return $drh->SUPER::FETCH($attr);
}
}
sub STORE {
my ( $drh, $attr, $value ) = @_;
if ( $attr =~ /^mock_/ ) {
if ( $attr eq 'mock_connect_fail' ) {
return $drh->{'mock_connect_fail'} = $value ? 1 : 0;
}
elsif ( $attr eq 'mock_data_sources' ) {
if ( ref($value) ne 'ARRAY' ) {
$drh->set_err( 1,
"You must pass an array ref of data sources" );
return;
}
return $drh->{'mock_data_sources'} = $value;
}
elsif ( $attr eq 'mock_add_data_sources' ) {
return push @{ $drh->{'mock_data_sources'} } => $value;
}
}
else {
return $drh->SUPER::STORE( $attr, $value );
}
}
sub data_sources {
my $drh = shift;
return
map { (/^DBI\:Mock\:/i) ? $_ : "DBI:Mock:$_" }
@{ $drh->FETCH('mock_data_sources') };
}
# Necessary to support DBI < 1.34
# from CPAN RT bug #7057
sub disconnect_all {
# no-op
}
sub DESTROY { undef }
1;
|