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
167
168
169
170
171
172
173
174
175
176
177
|
#!/usr/bin/perl
# This script checks which style of WHERE clause(s) will support both
# null and non-null values. Refer to the NULL Values sub-section
# of the "Placeholders and Bind Values" section in the DBI
# documention for more information on this issue. The clause styles
# and their numbering (0-6) map directly to the examples in the
# documentation.
#
# To use this script:
#
# 1) If you are not using the DBI_DSN env variable, then update the
# connect method arguments to support your database engine and
# database, and remove the nearby check for DBI_DSN.
# 2) Set PrintError to 1 in the connect method if you want see the
# engine's reason WHY your engine won't support a particular
# style.
# 3) If your database does not support NULL columns by default
# (e.g. Sybase) find and edit the CREATE TABLE statement
# accordingly.
# 4) To properly test style #5, you need the capability to create the
# stored procedure SP_ISNULL that acts as a function: it tests its
# argument and returns 1 if it is null, 0 otherwise. For example,
# using Informix IDS engine, a definition would look like:
#
# CREATE PROCEDURE SP_ISNULL (arg VARCHAR(32)) RETURNING INTEGER;
# IF arg IS NULL THEN RETURN 1;
# ELSE RETURN 0;
# END IF;
# END PROCEDURE;
#
# Warning: This script will attempt to create a table named by the
# $tablename variable (default dbi__null_test_tmp) and WILL DESTROY
# any pre-existing table so named.
use strict;
use warnings;
use DBI;
# The array represents the values that will be stored in the char column of our table.
# One array element per row.
# We expect the non-null test to return row 3 (Marge)
# and the null test to return rows 2 and 4 (the undefs).
my $homer = "Homer";
my $marge = "Marge";
my @char_column_values = (
$homer, # 1
undef, # 2
$marge, # 3
undef, # 4
);
# Define the SQL statements with the various WHERE clause styles we want to test
# and the parameters we'll substitute.
my @select_clauses =
(
{clause=>qq{WHERE mycol = ?}, nonnull=>[$marge], null=>[undef]},
{clause=>qq{WHERE NVL(mycol, '-') = NVL(?, '-')}, nonnull=>[$marge], null=>[undef]},
{clause=>qq{WHERE ISNULL(mycol, '-') = ISNULL(?, '-')}, nonnull=>[$marge], null=>[undef]},
{clause=>qq{WHERE DECODE(mycol, ?, 1, 0) = 1}, nonnull=>[$marge], null=>[undef]},
{clause=>qq{WHERE mycol = ? OR (mycol IS NULL AND ? IS NULL)}, nonnull=>[$marge,$marge], null=>[undef,undef]},
{clause=>qq{WHERE mycol = ? OR (mycol IS NULL AND SP_ISNULL(?) = 1)}, nonnull=>[$marge,$marge], null=>[undef,undef]},
{clause=>qq{WHERE mycol = ? OR (mycol IS NULL AND ? = 1)}, nonnull=>[$marge,0], null=>[undef,1]},
);
# This is the table we'll create and use for these tests.
# If it exists, we'll DESTROY it too. So the name must be obscure.
my $tablename = "dbi__null_test_tmp";
# Remove this if you are not using the DBI_DSN env variable,
# and update the connect statement below.
die "DBI_DSN environment variable not defined"
unless $ENV{DBI_DSN};
my $dbh = DBI->connect(undef, undef, undef,
{
RaiseError => 0,
PrintError => 1
}
) || die DBI->errstr;
printf "Using %s, db version: %s\n", $ENV{DBI_DSN} || "connect arguments", $dbh->get_info(18) || "(unknown)";
my $sth;
my @ok;
print "=> Drop table '$tablename', if it already exists...\n";
do { local $dbh->{PrintError}=0; $dbh->do("DROP TABLE $tablename"); };
print "=> Create table '$tablename'...\n";
$dbh->do("CREATE TABLE $tablename (myid int NOT NULL, mycol char(5))");
# Use this if your database does not support NULL columns by default:
#$dbh->do("CREATE TABLE $tablename (myid int NOT NULL, mycol char(5) NULL)");
print "=> Insert 4 rows into the table...\n";
$sth = $dbh->prepare("INSERT INTO $tablename (myid, mycol) VALUES (?,?)");
for my $i (0..$#char_column_values)
{
my $val = $char_column_values[$i];
printf " Inserting values (%d, %s)\n", $i+1, $dbh->quote($val);
$sth->execute($i+1, $val);
}
print "(Driver bug: statement handle should not be Active after an INSERT.)\n"
if $sth->{Active};
# Run the tests...
for my $i (0..$#select_clauses)
{
my $sel = $select_clauses[$i];
print "\n=> Testing clause style $i: ".$sel->{clause}."...\n";
$sth = $dbh->prepare("SELECT myid,mycol FROM $tablename ".$sel->{clause})
or next;
print " Selecting row with $marge\n";
$sth->execute(@{$sel->{nonnull}})
or next;
my $r1 = $sth->fetchall_arrayref();
my $n1_rows = $sth->rows;
my $n1 = @$r1;
print " Selecting rows with NULL\n";
$sth->execute(@{$sel->{null}})
or next;
my $r2 = $sth->fetchall_arrayref();
my $n2_rows = $sth->rows;
my $n2 = @$r2;
# Complain a bit...
print "\n=>Your DBD driver doesn't support the 'rows' method very well.\n\n"
unless ($n1_rows == $n1 && $n2_rows == $n2);
# Did we get back the expected "n"umber of rows?
# Did we get back the specific "r"ows we expected as identifed by the myid column?
if ( $n1 == 1 # one row for Marge
&& $n2 == 2 # two rows for nulls
&& $r1->[0][0] == 3 # Marge is myid 3
&& $r2->[0][0] == 2 # NULL for myid 2
&& $r2->[1][0] == 4 # NULL for myid 4
) {
print "=> WHERE clause style $i is supported.\n";
push @ok, "\tStyle $i: ".$sel->{clause};
}
else
{
print "=> WHERE clause style $i returned incorrect results.\n";
if ($n1 > 0 || $n2 > 0)
{
print " Non-NULL test rows returned these row ids: ".
join(", ", map { $r1->[$_][0] } (0..$#{$r1}))."\n";
print " The NULL test rows returned these row ids: ".
join(", ", map { $r2->[$_][0] } (0..$#{$r2}))."\n";
}
}
}
$dbh->disconnect();
print "\n";
print "-" x 72, "\n";
printf "%d styles are supported:\n", scalar @ok;
print "$_\n" for @ok;
print "-" x 72, "\n";
print "\n";
print "If these results don't match what's in the 'Placeholders and Bind Values'\n";
print "section of the DBI documentation, or are for a database that not already\n";
print "listed, please email the results to dbi-users\@perl.org. Thank you.\n";
exit 0;
|
