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 strict;
use warnings;
use DBI qw(:sql_types);
use Test::More;

my $has_test_nowarnings = 1;
eval "require Test::NoWarnings";
$has_test_nowarnings = undef if $@;

my $dbh;
my $bind_string = "frederickfrederick";

BEGIN {
   if (!defined $ENV{DBI_DSN}) {
      plan skip_all => "DBI_DSN is undefined";
   }
}

END {
    if ($dbh) {
        local $dbh->{PrintError} = 0;
        local $dbh->{PrintWarn} = 0;
        eval {
            $dbh->do(q/drop table DBD_ODBC_LOB_TEST/);
        };
    }
    Test::NoWarnings::had_no_warnings()
          if ($has_test_nowarnings);

    done_testing();
}

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

my $dbname = $h->get_info(17); # DBI::SQL_DBMS_NAME
unless ($dbname =~ /Microsoft SQL Server/i) {
    note("Not MS SQL Server");
    skip_all => "Not MS SQL Server";
    exit 0;
}

eval {
    $h->do(q/drop table DBD_ODBC_LOB_TEST/);
};

eval {
    $h->do(q/create table DBD_ODBC_LOB_TEST(a image)/);
} or BAIL_OUT("Failed to create test table $@");

my $s = $h->prepare(q/insert into DBD_ODBC_LOB_TEST (a) values(?)/);
ok($s, "Created test table");

$s->bind_param(1, $bind_string, {TYPE => SQL_BINARY});
ok($s->execute, "inserted test data") or BAIL_OUT($DBI::errstr);

ok($s = $h->prepare(q/select a from DBD_ODBC_LOB_TEST/),
   "preparing select") or BAIL_OUT("cannot select test data $DBI::errstr");
ok($s->execute, "executing select") or BAIL_OUT("execute $DBI::errstr");

ok($s->bind_col(1, undef, {TreatAsLOB => 1}), "binding");

ok($s->fetch, "fetching");

getit($s, SQL_BINARY);
$s->execute;
$s->fetch;
getit($s, SQL_BINARY);

sub getit{
    my ($s, $type) = @_;

    my $total = 0;
    my $first = 1;
    my $fetched = '';

    my $len;
    while($len = $s->odbc_lob_read(1, \my $x, 8, {TYPE => $type})) {
        if ($first) {
            if ($type == SQL_BINARY) {
                is($len, 8, "correct chunk size");
            } else {
                is($len, 7, "correct chunk size");
            }
        }
        #diag("len=$len, x=$x, ", length($x));
        $total += $len;
        $first = 0;
        $fetched .= $x;
    }
    is($len, 0, "0 at end");

    is($total, length($bind_string), "received correct amount of bytes");
    is($fetched, $bind_string, "data correct");

    my $x;
    $len = $s->odbc_lob_read(1, \$x, 8);
    is($len, 0, "0 at end after another read");

}
$s->finish;


$h->disconnect;