diff options
Diffstat (limited to 'ex/perl_dbi_nulls_test.pl')
| -rw-r--r-- | ex/perl_dbi_nulls_test.pl | 176 |
1 files changed, 176 insertions, 0 deletions
diff --git a/ex/perl_dbi_nulls_test.pl b/ex/perl_dbi_nulls_test.pl new file mode 100644 index 0000000..fbef238 --- /dev/null +++ b/ex/perl_dbi_nulls_test.pl @@ -0,0 +1,176 @@ +#! /usr/bin/perl -w + +# 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 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; |