view release on metacpan or  search on metacpan

t/datatypes.t  view on Meta::CPAN

# For each supported data type, we need to test
#
#   1. inserting into a table using a bind_param of that type as a value
#   2. selecting from a table a field with that type
#   3. selecting from a table using a bind_param of that type as a selector
#   4. inserting into a table using a null bind_param of that type as a value
#   5. selecting from a table a null field with that type
#
# For extra paranoia we undef the variable after binding but before
# executing to make sure we aren't core dumping due to referencing things
# without updating their reference counts.
#

my %testvals = (
    'SMALLINT'		=> 32511,
    'INTEGER'		=> 1234567,
    'MONEY'		=> 49711.39,
    'FLOAT'		=> 3.1415926,
    'DATE'		=> "1963-03-15 04:55:22",
    'DECIMAL'		=> 98,
    'VARCHAR'		=> "Apricot" x 3,
    'BYTE VARYING'	=> "Ab\0" x 10,
    'CHAR'		=> "AaBb",
    'BYTE'		=> "\3\0\2\1",
    'LONG VARCHAR'	=> "CcDd" x 4096,
    'LONG BYTE'		=> "Ee\0Ff\1Gg\2Hh\0" x 2048,
);

my $types = $dbh->type_info_all();

for (my $i=1; $i <= $#{$types}; ++$i) {
    my $name = $types->[$i]->[$types->[0]->{TYPE_NAME}];
    my $sqltype = $types->[$i]->[$types->[0]->{DATA_TYPE}];
    my $searchable = $types->[$i]->[$types->[0]->{SEARCHABLE}];
    my $nullable = $types->[$i]->[$types->[0]->{NULLABLE}];
    my $params = $types->[$i]->[$types->[0]->{CREATE_PARAMS}];
    my $val = $testvals{$name};

    unless ($val) {
	warn "No default value for type $name\n";
	next;
    }

    # Update the type based on the create params
    if ($params && $params =~ /max length/) {
	$name .= "(2000)";
    } elsif ($params && $params =~ /length/) {
	$name .= "(64)";
	$val = sprintf("%-64s", $val);
    } elsif ($params && $params =~ /size=/) {
	$params =~ s/.*size=([0-9,]*).*/$1/;
	my @sizes = split(/,/, $params);
	$name .= $sizes[-1];
    }

    # CREATE TABLE OF APPROPRIATE TYPE
    ok($dbh->do("CREATE TABLE $testtable (val $name)"),
	  "Create table ($name)");

    # INSERT BOUND VALUE
    ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
	  "Insert prepare ($name)");
    {
	# By allowing the bind param to go out of scope we make sure the driver
	# has either copied it or has all its ref counting on it right.
	my $destroyval = $val;
	ok($cursor->bind_param(1, $destroyval, { TYPE => $sqltype }),
	      "Insert bind param ($name)");
    }
    ok($cursor->execute,
	  "Insert execute ($name)");
    ok($cursor->finish,
	  "Insert finish ($name)");

    # SELECT VALUE
    ok($cursor = $dbh->prepare("SELECT val FROM $testtable"),
	  "Select prepare ($name)");
    ok($cursor->execute,
	  "Select execute ($name)");
    my $ar = $cursor->fetchrow_arrayref; 
    ok($ar && $ar->[0] eq $val,
	  "Select fetch ($name)")
	or print STDERR "Got '$ar->[0]', expected '$val'.\n";
    ok($cursor->finish,
	  "Select finish ($name)");

    # FETCH BOUND SELECTOR
    if ($searchable) {

	ok($cursor = $dbh->prepare("SELECT * FROM $testtable WHERE val = ?"),
	      "Select with bound selector prepare ($name)");
	my $destroyval = $val;
	ok($cursor->bind_param(1, $destroyval, { TYPE => $sqltype }),
	      "Select with bound selector bind_param ($name)");
	undef $destroyval;
	ok($cursor->execute,
	      "Select with bound selector execute ($name)");
	$ar = $cursor->fetchrow_arrayref; 
	ok($ar && "$ar->[0]" eq "$val",
	      "Select with bound selector fetch ($name)")
	    or print STDERR "Got '$ar->[0]', expected '$val'.\n";
	ok($cursor->finish,
	      "Select with bound selector finish ($name)");
    } else {
	# These dummies make it easier to set num_tests.  We have to skip
	# these tests because you can't select on some types.
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
    }

    # CLEAN UP FOR NULL STUFF
    $dbh->do("DELETE FROM $testtable");

    # INSERT NULL VALUE
    if ($nullable) {
	ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
	      "Insert null prepare ($name)");
	ok($cursor->bind_param(1, undef, { TYPE => $sqltype }),
	      "Insert null bind param ($name)");
	ok($cursor->execute,
	      "Insert null execute ($name)");
	ok($cursor->finish,
	      "Insert null finish ($name)");

	# SELECT NULL VALUE
	ok($cursor = $dbh->prepare("SELECT val FROM $testtable"),
	      "Select null prepare ($name)");
	ok($cursor->execute,
	      "Select null execute ($name)");
	ok(!defined ($cursor->fetchrow_arrayref->[0]),
	      "Select null fetch ($name)");
	ok($cursor->finish,
	      "Select null finish ($name)");
    } else {
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
	ok(1, "Dummy test.");
    }

    # DROP TABLE AGAIN
    ok($dbh->do("DROP TABLE $testtable"),
	  "Drop table ($name)");
}

$dbh and $dbh->commit;
$dbh and $dbh->disconnect;
	  
exit(0);