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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
use strict;
use warnings;
use Test::More;
use DBI::Const::GetInfoType;
use vars qw($mdriver $dbdriver $childPid $test_dsn $test_user $test_password);
$| = 1; # flush stdout asap to keep in sync with stderr
#
# Driver names; EDIT THIS!
#
$mdriver = 'mysql';
$dbdriver = $mdriver; # $dbdriver is usually just the same as $mdriver.
# The exception is DBD::pNET where we have to
# to separate between local driver (pNET) and
# the remote driver ($dbdriver)
#
# DSN being used; do not edit this, edit "$dbdriver.dbtest" instead
#
$::COL_NULLABLE = 1;
$::COL_KEY = 2;
my $file;
if (-f ($file = "t/$dbdriver.dbtest") ||
-f ($file = "$dbdriver.dbtest") ||
-f ($file = "../tests/$dbdriver.dbtest") ||
-f ($file = "tests/$dbdriver.dbtest")) {
eval { require $file; };
if ($@) {
print STDERR "Cannot execute $file: $@.\n";
print "1..0\n";
exit 0;
}
$::test_dsn = $::test_dsn || $ENV{'DBI_DSN'} || 'DBI:mysql:database=test';
$::test_user = $::test_user|| $ENV{'DBI_USER'} || '';
$::test_password = $::test_password || $ENV{'DBI_PASS'} || '';
}
if (-f ($file = "t/$mdriver.mtest") ||
-f ($file = "$mdriver.mtest") ||
-f ($file = "../tests/$mdriver.mtest") ||
-f ($file = "tests/$mdriver.mtest")) {
eval { require $file; };
if ($@) {
print STDERR "Cannot execute $file: $@.\n";
print "1..0\n";
exit 0;
}
}
sub DbiTestConnect {
return (eval { DBI->connect(@_) } or do {
my $err;
if ( $@ ) {
$err = $@;
$err =~ s/ at \S+ line \d+\s*$//;
}
if ( not $err ) {
$err = $DBI::errstr;
$err = "unknown error" unless $err;
my $user = $_[1];
my $dsn = $_[0];
$dsn =~ s/^DBI:mysql://;
$err = "DBI connect('$dsn','$user',...) failed: $err";
}
if ( $ENV{CONNECTION_TESTING} ) {
BAIL_OUT "no database connection: $err";
} else {
plan skip_all => "no database connection: $err";
}
});
}
#
# Print a DBI error message
#
# TODO - This is on the chopping block
sub DbiError ($$) {
my ($rc, $err) = @_;
$rc ||= 0;
$err ||= '';
$::numTests ||= 0;
print "Test $::numTests: DBI error $rc, $err\n";
}
sub connection_id {
my $dbh = shift;
return 0 unless $dbh;
# Paul DuBois says the following is more reliable than
# $dbh->{'mysql_thread_id'};
my @row = $dbh->selectrow_array("SELECT CONNECTION_ID()");
return $row[0];
}
# nice function I saw in DBD::Pg test code
sub byte_string {
my $ret = join( "|" ,unpack( "C*" ,$_[0] ) );
return $ret;
}
sub SQL_VARCHAR { 12 };
sub SQL_INTEGER { 4 };
=item CheckRoutinePerms()
Check if the current user of the DBH has permissions to create/drop procedures
if (!CheckRoutinePerms($dbh)) {
plan skip_all =>
"Your test user does not have ALTER_ROUTINE privileges.";
}
=cut
sub CheckRoutinePerms {
my $dbh = shift @_;
# check for necessary privs
local $dbh->{PrintError} = 0;
eval { $dbh->do('DROP PROCEDURE IF EXISTS testproc') };
return if $@ =~ qr/alter routine command denied to user/;
return 1;
};
=item MinimumVersion()
Check to see if the database where the test run against is
of a certain minimum version
if (!MinimumVersion($dbh, '5.0')) {
plan skip_all =>
"You must have MySQL version 5.0 and greater for this test to run";
}
=cut
sub MinimumVersion {
my $dbh = shift @_;
my $version = shift @_;
my ($major, $minor) = split (/\./, $version);
if ( $dbh->get_info($GetInfoType{SQL_DBMS_VER}) =~ /(^\d+)\.(\d+)\./ ) {
# major version higher than requested
return 1 if $1 > $major;
# major version too low
return if $1 < $major;
# check minor version
return 1 if $2 >= $minor;
}
return;
}
1;
|
