1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
#!perl
use strict;
use warnings;
use lib 't/lib';
use DBDOracleTestLib qw/ oracle_test_dsn table drop_table db_handle force_drop_table /;
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
## ----------------------------------------------------------------------------
$| = 1;
# create a database handle
my $dbh = eval{ db_handle( {
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 { force_drop_table( $dbh, $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 ); # ID: 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(),
'fetchrow 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' );
cmp_ok( $log, 'eq', $in_clob, 'clob1 = in_clob' );
cmp_ok( $log2, 'eq', $in_clob, 'clob2 = in_clob' );
cmp_ok( $log3, 'eq', $in_blob, 'clob1 = in_clob' );
cmp_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' );
cmp_ok( $log, 'eq', $in_clob, 'clob1 = in_clob' );
cmp_ok( $log2, 'eq', $in_clob, 'clob2 = in_clob' );
cmp_ok( $log3, 'eq', $in_blob, 'clob1 = in_clob' );
cmp_ok( $log4, 'eq', $in_blob, 'clob2 = in_clob' );
#no need to look at the data is should be ok
$sth->finish();
drop_table($dbh);
} # SKIP
|
