The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w -I./t

use Test::More;

$| = 1;
my $has_test_nowarnings = 1;
eval "require Test::NoWarnings";
$has_test_nowarnings = undef if $@;
my $tests = 25;
$tests += 1 if $has_test_nowarnings;
plan tests => $tests;


# use_ok('DBI', qw(:sql_types));
# can't seem to get the imports right this way
use DBI qw(:sql_types);
use_ok('ODBCTEST');

BEGIN {
   if (!defined $ENV{DBI_DSN}) {
      plan skip_all => "DBI_DSN is undefined";
   }
}
END {
    Test::NoWarnings::had_no_warnings()
          if ($has_test_nowarnings);
}

my $dbh = DBI->connect();
unless($dbh) {
   BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n");
   exit 0;
}


$rc =
ok(ODBCTEST::tab_create($dbh), "Create tables");

my @data = (
	[ 1, 'foo', 'foo varchar', "1998-05-13", "1998-05-13 00:01:00" ],
	[ 2, 'bar', 'bar varchar', "1998-05-14", "1998-05-14 00:01:00" ],
	[ 3, 'bletch', 'bletch varchar', "1998-05-15", "1998-05-15 00:01:00" ],
	[ 4, 'bletch4', 'bletch varchar', "1998-05-15", "1998-05-15 00:01:00.1" ],
	[ 5, 'bletch5', undef, "1998-05-15", "1998-05-15 00:01:00.23" ],
	[ 6, '', '', "1998-05-15", "1998-05-15 00:01:00.233" ],
);
my $longstr = "This is a test of a string that is longer than 80 characters.  It will be checked for truncation and compared with itself.";
my $longstr2 = $longstr . "  " . $longstr;
my $longstr3 = $longstr2 . "  " . $longstr2;
my @data_long = (
	[ 10, 'foo2', $longstr, "2000-05-13", "2000-05-13 00:01:00" ],
	[ 11, 'bar2', $longstr2, "2000-05-14", "2000-05-14 00:01:00" ],
	[ 12, 'bletch2', $longstr3, "2000-05-15", "2000-05-15 00:01:00" ],
);
my $tab_insert_ok = 1;
$rc = ODBCTEST::tab_insert_bind($dbh, \@data, 1);
ok($rc, "Table insert test");
unless ($rc) {
	diag("Test 4 is known to fail often. It is not a major concern.  It *may* be an indication of being unable to bind datetime values correctly.\n");
	$tab_insert_ok = 0;
	# print "not "
}

$dbh->{LongReadLen} = 2000;
is($dbh->{LongReadLen}, 2000, "Ensure long readlen set correctly");

$rc = tab_select($dbh, \@data);
ok($rc, "Select tests");

$rc = ODBCTEST::tab_insert_bind($dbh, \@data_long, 1);
ok($rc, "Insert with bind tests");
unless ($rc) {
   if ($tab_insert_ok) {
      diag("Since test #4 succeeded, this could be indicative of a problem with long inserting, with binding parameters.\n");
   } else {
      diag("Since test #4 failed, this could be indicative of a problem with date time binding, as per #4 above.\n");
   }
}


$rc = tab_select($dbh, \@data_long);
ok($rc, "select long test data");

$rc = tab_update_long($dbh, \@data_long);
ok($rc, "update long test data");

$rc = tab_select($dbh, \@data_long);
ok($rc, "select long test data again");

# clean up!
$rc = ODBCTEST::tab_delete($dbh);

# test param values!
my $sth = $dbh->prepare("insert into $ODBCTEST::table_name (COL_A, COL_C) values (?, ?)");
$sth->bind_param(1, 1, SQL_INTEGER);
$sth->bind_param(2, "test", SQL_LONGVARCHAR);
my $ref = $sth->{ParamValues};
is(ref($ref), 'HASH', 'ParamValues returns a hash ref');

is($ref->{1}, 1, "ParamValues test integer");
is($ref->{2}, "test", "Paramvalues test string");

# test param types
$ref = $sth->{ParamTypes};
is(ref($ref), 'HASH', 'ParamValues returns a hash ref');
ok(exists($ref->{1}), 'p1 exists');
ok(exists($ref->{1}), 'p2 exists');
is(ref($ref->{1}), 'HASH', 'p1 is a hash reference');
is(ref($ref->{2}), 'HASH', 'p2 is a hash reference');
ok(exists($ref->{1}->{TYPE}), 'p1 TYPE exists');
ok(exists($ref->{2}->{TYPE}), 'p2 TYPE exists');
like($ref->{1}->{TYPE}, qr/^-?\d+$/, 'numeric SQL type on p1');
like($ref->{2}->{TYPE}, qr/^-?\d+$/, 'numeric SQL type on p2');

# test numbered parameters
eval {
    $dbh->do("delete from $ODBCTEST::table_name");
    $sth = $dbh->prepare(
        "insert into $ODBCTEST::table_name(COL_A, COL_C) values (:1, :2)");
    $sth->bind_param("1", 1);
    $sth->bind_param("2", 2);
    $sth->execute;
};
my $ev = $@;
diag($ev) if $ev;
ok(!$ev, 'insert with numbered placeholders');
is($sth->rows, 1, '...inserted one row');

# test named parameters
eval {
    $dbh->do("delete from $ODBCTEST::table_name");
    $sth = $dbh->prepare(
        "insert into $ODBCTEST::table_name(COL_A, COL_C) values (:three, :four)");
    $sth->bind_param("three", 3);
    $sth->bind_param("four", 4);
    $sth->execute;
};
$ev = $@;
diag($ev) if $ev;
ok(!$ev, 'insert with named placeholders');
is($sth->rows, 1, '...inserted one row');

# how to test "sticky" bind_param?
# how about setting ODBC default bind_param to some number
# then
# clean up!
$rc = ODBCTEST::tab_delete($dbh);

exit(0);
print $DBI::errstr;

sub tab_select {
    my $dbh = shift;
    my $dref = shift;
    my @data = @{$dref};
    my @row;

    my $dbname;
    $dbname = $dbh->get_info(17); # SQL_DBMS_NAME
    my $sth = $dbh->prepare("SELECT COL_A,COL_B,COL_C,COL_D FROM $ODBCTEST::table_name WHERE COL_A = ?")
		or return undef;
    my $bind_val;
    foreach (@data) {
        $bind_val = $_->[0];
        $sth->bind_param(1, $bind_val, SQL_INTEGER);
        $sth->execute;
        while (@row = $sth->fetchrow()) {
            # print "$row[0]|$row[1]|$row[2]|\n";
            if ($row[0] != $bind_val) {
                print "Bind value failed! bind value = $bind_val, returned value = $row[0]\n";
                return undef;
            }
            if (!defined($row[2]) && !defined($_->[2])) {
                # ok...
            } else {
                if (!defined($row[2] && $dbname =~ /Oracle/)) {
                    # Oracle typically treats empty blanks as NULL in varchar, so that's what we should
                    # expect!
                    $row[2] = "";
                }
                if ($row[2] ne $_->[2]) {
                    print "Column C value failed! bind value = $bind_val, returned values = $row[0]|$row[1]|$row[2]|$row[3]\n";
                    return undef;
                }
            }
        }
    }
    return 1;
}

sub tab_update_long {
    my $dbh = shift;
    my $dref = shift;
    my @data = @{$dref};

    my $sth = $dbh->prepare(<<"/");
UPDATE $ODBCTEST::table_name SET COL_C = ? WHERE COL_A = ?
/
    unless ($sth) {
	warn $DBI::errstr;
	return 0;
    }
    $sth->{PrintError} = 1;
    foreach (@data) {
	# change the data...
	$_->[2] .= "  " . $_->[2];
	my $row = ODBCTEST::get_type_for_column($dbh, 'COL_C');
	$sth->bind_param(1, $_->[2], { TYPE => $row->{DATA_TYPE} });
	$row = ODBCTEST::get_type_for_column($dbh, 'COL_A');
	$sth->bind_param(2, $_->[0], { TYPE => $row->{DATA_TYPE} });

	return 0 unless $sth->execute;
    }
    1;
}

__END__