perl_dbi_nulls_test.pl [plain text]
use strict;
use DBI;
my $homer = "Homer ";
my $marge = "Marge ";
my @char_column_values = (
$homer,
undef,
$marge,
undef
);
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]},
);
my $tablename = "dbi__null_test_tmp";
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";
$sth = $dbh->do("DROP TABLE $tablename");
print "=> Create table '$tablename'...\n";
$sth = $dbh->prepare("CREATE TABLE $tablename (myid int NOT NULL, mycol char(8))");
$sth->execute()
|| $sth->errstr;
print "=> Insert 4 rows into the table...\n";
$sth = $dbh->prepare("INSERT INTO $tablename (myid, mycol) VALUES (?,?)");
for my $i (0..${
my $val = $char_column_values[$i];
printf "Values %d %s\n", $i+1, defined($val)? $val : "";
$sth->execute($i+1, $val)
|| $sth->errstr;
}
for my $i (0..${
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;
$sth->execute(@{$sel->{nonnull}})
or next;
my $r1 = $sth->fetchall_arrayref();
my $n1r = $sth->rows;
my $n1 = @$r1;
$sth->execute(@{$sel->{null}})
or next;
my $r2 = $sth->fetchall_arrayref();
my $n2r = $sth->rows;
my $n2 = @$r2;
print "\n=>Your DBD driver doesn't support the 'rows' method very well.\n\n"
unless ($n1r == $n1 && $n2r == $n2);
if ( $n1 == 1
&& $n2 == 2
&& $r1->[0][0] == 3
&& $r2->[0][0] == 2
&& $r2->[1][0] == 4)
{
print "=> WHERE clause style $i is supported.\n";
push @ok, "$i: ".$sel->{clause};
}
else
{
print "=> WHERE clause style $i returned incorrect results.\n";
if ($n1 > 0 || $n2 > 0)
{
print " Non-Null test rows returned: ";
print " ", $r1->[$_][0] for (0..$ print "\n";
print " Null test rows returned: ";
print " ", $r2->[$_][0] for (0..$ print "\n";
}
}
}
$dbh->disconnect();
printf "\n%d styles are supported\n", scalar @ok;
print "$_\n" for @ok;
print "\n";