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

use Test::More;

use DBI;
use Config;
use DBD::Oracle qw(:ora_types);



## ----------------------------------------------------------------------------
## 33pres_lobs.t
## By John Scoles, The Pythian Group
## ----------------------------------------------------------------------------
##  Checks to see if the Interface for Persistent LOBs is working
##  Nothing fancy. Just an insert and a select if they fail this there is something up in OCI or the version
##  of oci being used
## ----------------------------------------------------------------------------

unshift @INC ,'t';
require 'nchar_test_lib.pl';

$| = 1;

# create a database handle
my $dsn = oracle_test_dsn();
my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
my $dbh;
eval {$dbh = DBI->connect($dsn, $dbuser, '',
                          { RaiseError=>1,
                            AutoCommit=>1,
                            PrintError => 0 ,LongReadLen=>10000000})};
if ($dbh) {
    plan skip_all => "Data Interface for Persistent LOBs new in Oracle 9"
        if $dbh->func('ora_server_version')->[0] < 9;
    plan tests => 28;
} else {
    plan skip_all => "Unable to connect to Oracle";
}
# check that our db handle is good
my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar

SKIP: {
   	skip "OCI version less than 9.2\n Persistent LOBs Tests skiped.", 29 unless $ora_oci >= 9.2;


my $table = table();

eval { $dbh->do("DROP TABLE $table") };

ok($dbh->do(qq{
	CREATE TABLE $table (
	    id NUMBER,
	    clob1 CLOB,
	    clob2 CLOB,
	    blob1 BLOB,
	    blob2 BLOB)
    }), 'create test table');


my $in_clob='ABCD' x 10_000;
my $in_blob=("0\177x\0X"x 2048) x (1);
my ($sql, $sth,$value);

$sql = "insert into ".$table."
	(id,clob1,clob2, blob1,blob2)
	values(?,?,?,?,?)";
ok($sth=$dbh->prepare($sql ), 'prepare for insert into lobs');
$sth->bind_param(1,3);
ok($sth->bind_param(2,$in_clob,{ora_type=>SQLT_CHR}), 'bind p2');
ok($sth->bind_param(3,$in_clob,{ora_type=>SQLT_CHR}), 'bind p3');
ok($sth->bind_param(4,$in_blob,{ora_type=>SQLT_BIN}), 'bind p4');
ok($sth->bind_param(5,$in_blob,{ora_type=>SQLT_BIN}), 'bind p5');
ok($sth->execute(), 'execute');

$sql='select * from '.$table;

ok($sth=$dbh->prepare($sql,{ora_pers_lob=>1}), 'prepare with ora_pers_lob');

ok($sth->execute(), 'execute with ora_pers_lob');
my ($p_id,$log,$log2,$log3,$log4);

ok(( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(),
   'fetcheow for ora_pers_lob');

is($log, $in_clob, 'clob1 = in_clob');
is($log2, $in_clob, 'clob2 = in_clob');
is($log3, $in_blob, 'clob1 = in_blob');
is($log4, $in_blob, 'clob2 = in_blob');

ok($sth=$dbh->prepare($sql,{ora_clbk_lob=>1,ora_piece_size=>.5*1024*1024}),
   'prepare for ora_piece_size');

ok($sth->execute(), 'execute for ora_piece_size');

ok(( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(), 'fetchrow');
ok($log eq $in_clob, 'clob1 = in_clob');
ok($log2 eq $in_clob, 'clob2 = in_clob');
ok($log3 eq $in_blob, 'clob1 = in_clob');
ok($log4 eq $in_blob, 'clob2 = in_clob');

ok($sth=$dbh->prepare($sql,{ora_piece_lob=>1,ora_piece_size=>.5*1024*1024}),
  'prepare with ora_piece_lob/ora_piece_size');

ok($sth->execute(), 'execute');
ok( ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(),
   'fetchrow');

ok($log eq $in_clob, 'clob1 = in_clob');
ok($log2 eq $in_clob, 'clob2 = in_clob');
ok($log3 eq $in_blob, 'clob1 = in_clob');
ok($log4 eq $in_blob, 'clob2 = in_clob');

#no neeed to look at the data is should be ok

$sth->finish();
drop_table($dbh);
}


$dbh->disconnect;

1;