The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
#
# $Id: xblob.t,v 1.12 2007/03/01 17:17:44 mpeppler Exp $

use lib 't';

use strict;

use _test;

use Test::More tests=>11; #qw(no_plan);

use vars qw($Pwd $Uid $Srv $Db $loaded);

BEGIN { use_ok('DBI');
        use_ok('DBD::Sybase');}

($Uid, $Pwd, $Srv, $Db) = _test::get_info();

#DBI->trace(3);
my $dbh = DBI->connect("dbi:Sybase:server=$Srv;database=$Db", $Uid, $Pwd, {PrintError=>1});
#exit;
ok($dbh, 'Connect');

if(!$dbh) {
    warn "No connection - did you set the user, password and server name correctly in PWD?\n";
    for (4 .. 11) {
	ok(0);
    }
    exit(0);
}

$dbh->do("if object_id('blob_test') != NULL drop table blob_test");
my $rc = $dbh->do("create table blob_test(id int, data image null, foo varchar(30))");
ok($rc, 'Create table');

open(IN, "t/screen.jpg") || die "Can't open t/screen.jpg: $!";
binmode(IN);
my $image;
{
    local $/;
    $image = <IN>;
}
close(IN);
my $heximg = unpack('H*', $image);
$rc = $dbh->do("insert blob_test(id, data, foo) values(1, '', 'screen.jpg')");
ok($rc, 'Insert image');

#DBI->trace(3);
my $sth = $dbh->prepare("select id, data from blob_test");
#$sth->{syb_no_bind_blob} = 1;
$sth->execute;
while($sth->fetch) {
#    my $d;
#    $sth->func(2, \$d, 0, 'ct_get_data');
    
    $sth->func('CS_GET', 2, 'ct_data_info') || print $sth->errstr, "\n";
}
$sth->func('ct_prepare_send') || print $sth->errstr, "\n";
$sth->func('CS_SET', 2, {total_txtlen => length($image), log_on_update=>1}, 'ct_data_info') || print $sth->errstr, "\n";
$sth->func($image, length($image), 'ct_send_data') || print $sth->errstr, "\n";
$sth->func('ct_finish_send') || print $sth->errstr, "\n";

$dbh->{LongReadLen} = 100000;
$sth = $dbh->prepare("select id, data from blob_test");
#$dbh->{LongReadLen} = 100000;
#DBI->trace(3);
$sth->{syb_no_bind_blob} = 1;
$sth->execute;
my $heximg2 = '';
my $size = 0;
while(my $d = $sth->fetch) {
    my $data;
#    open(OUT, ">/tmp/mp_conf.jpg") || die "Can't open /tmp/mp_conf.jpg: $!";
    while(1) {
	my $read = $sth->func(2, \$data, 1024, 'ct_get_data');
	$heximg2 .= unpack('H*', $data);
	$size += $read;
	last unless $read == 1024;
#	print OUT $data;
    }
#    close(OUT);
}

#warn "Got $size bytes\n";

ok($heximg eq $heximg2, 'Images are the same');

mkdir("./tmp", 0755);
open(ONE, ">./tmp/hex1");
binmode(ONE);
print ONE $heximg;
close(ONE);
open(TWO, ">./tmp/hex2");
binmode(TWO);
print TWO $heximg2;
close(TWO);

$rc = $dbh->do("drop table blob_test");

ok($rc, 'Drop table');

SKIP: {
    skip 'Requires DBI 1.34', 4 unless $DBI::VERSION >= 1.34;
    my $rc = $dbh->do("create table blob_test(id int, data image null, foo varchar(30))");
    ok($rc, 'Creat table');

    open(IN, "t/screen.jpg") || die "Can't open t/screen.jpg: $!";
    binmode(IN);
    my $image;
    {
	local $/;
	$image = <IN>;
    }
    close(IN);
    my $heximg = unpack('H*', $image);
    $rc = $dbh->do("insert blob_test(id, data, foo) values(1, '', 'screen.jpg')");
    ok($rc, 'Insert image');


#DBI->trace(3);
    my $sth = $dbh->prepare("select id, data from blob_test");
#$sth->{syb_no_bind_blob} = 1;
    $sth->execute;
    while($sth->fetch) {
	#    my $d;
	#    $sth->func(2, \$d, 0, 'ct_get_data');
    
	$sth->syb_ct_data_info('CS_GET', 2) || print $sth->errstr, "\n";
    }
    $sth->syb_ct_prepare_send() || print $sth->errstr, "\n";
    $sth->syb_ct_data_info('CS_SET', 2, {total_txtlen => length($image), log_on_update=>1}) || print $sth->errstr, "\n";
    $sth->syb_ct_send_data($image, length($image)) || print $sth->errstr, "\n";
    $sth->syb_ct_finish_send() || print $sth->errstr, "\n";

#DBI->trace(4);
    $dbh->{LongReadLen} = 100000;
    $sth = $dbh->prepare("select id, data from blob_test");
    #$dbh->{LongReadLen} = 100000;
    #DBI->trace(0);
    #DBI->trace(3);
    $sth->{syb_no_bind_blob} = 1;
    $sth->execute;
    my $heximg2 = '';
    my $size = 0;
    while(my $d = $sth->fetch) {
	my $data;
	#    open(OUT, ">/tmp/mp_conf.jpg") || die "Can't open /tmp/mp_conf.jpg: $!";
	while(1) {
	    my $read = $sth->syb_ct_get_data(2, \$data, 1024);
	    $heximg2 .= unpack('H*', $data);
	    $size += $read;
	    last unless $read == 1024;
	    #	print OUT $data;
	}
	#    close(OUT);
    }

#warn "Got $size bytes\n";

    ok($heximg eq $heximg2, 'Images are the same');
    
    mkdir("./tmp");
    open(ONE, ">./tmp/hex1");
    binmode(ONE);
    print ONE $heximg;
    close(ONE);
    open(TWO, ">./tmp/hex2");
    binmode(TWO);
    print TWO $heximg2;
    close(TWO);

    $rc = $dbh->do("drop table blob_test");
					
    ok($rc, 'Drop table');
}