#!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 = ; } 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 = ; } 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'); }