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;
|
