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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
#!/usr/bin/perl -w -I./t
# $Id: 12blob.t 15226 2012-03-17 08:33:35Z mjevans $
#
# blob tests
# currently tests you can insert a clob with various odbc_putdata_start settings
#
use Test::More;
use strict;
$| = 1;
my $has_test_nowarnings = 1;
eval "require Test::NoWarnings";
$has_test_nowarnings = undef if $@;
my $tests = 24;
$tests += 1 if $has_test_nowarnings;
plan tests => $tests;
my $dbh;
# can't seem to get the imports right this way
use DBI qw(:sql_types);
use_ok('ODBCTEST');
sub tidyup {
if ($dbh) {
#diag "Tidying up\n";
eval {
local $dbh->{PrintWarn} = 0;
local $dbh->{PrintError} = 0;
$dbh->do(q/drop table DBD_ODBC_drop_me/);
};
}
}
BEGIN {
if (!defined $ENV{DBI_DSN}) {
plan skip_all => "DBI_DSN is undefined";
}
}
END {
tidyup();
Test::NoWarnings::had_no_warnings()
if ($has_test_nowarnings);
}
my $ev;
$dbh = DBI->connect();
unless($dbh) {
BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n");
exit 0;
}
tidyup();
my $putdata_start = $dbh->{odbc_putdata_start};
is($putdata_start, 32768, 'default putdata_start');
my $sth = $dbh->func(SQL_ALL_TYPES, 'GetTypeInfo');
ok($sth, "GetTypeInfo");
my ($type_name, $type);
while (my @row = $sth->fetchrow) {
#diag("$row[0], $row[1], $row[2]");
next if (($row[1] != SQL_WLONGVARCHAR) && ($row[1] != SQL_LONGVARCHAR));
if ($row[2] > 60000) {
#diag("$row[0] $row[1] $row[2]");
($type_name, $type) = ($row[0], $row[1]);
$sth->finish;
last;
}
}
SKIP: {
skip "ODBC Driver/Database has not got a big enough type", 21
if (!$type_name);
#diag("Using type $type_name");
eval { $dbh->do(qq/create table DBD_ODBC_drop_me(a $type_name)/); };
$ev = $@;
diag($ev) if $ev;
ok(!$ev, "table DBD_ODBC_drop_me created");
SKIP: {
skip "Cannot create test table", 17 if $ev;
my $bigval = "x" x 30000;
test($dbh, $bigval);
test($dbh, $bigval, 500);
$bigval = 'x' x 60000;
test($dbh, $bigval, 60001);
};
};
sub test
{
my ($dbh, $val, $putdata_start) = @_;
my $rc;
if ($putdata_start) {
$dbh->{odbc_putdata_start} = $putdata_start;
my $pds = $dbh->{odbc_putdata_start};
is($pds, $putdata_start, "retrieved putdata_start = set value");
}
$sth = $dbh->prepare(q/insert into DBD_ODBC_drop_me values(?)/);
ok($sth, "prepare for insert");
SKIP: {
skip "prepare failed", 3 unless $sth;
$rc = $sth->execute($val);
ok($rc, "insert clob");
SKIP: {
skip "insert failed - skipping the retrieval test", 2 unless $rc;
test_value($dbh, $val);
};
};
$sth = undef;
eval {$dbh->do(q/delete from DBD_ODBC_drop_me/); };
$ev = $@;
diag($ev) if $ev;
ok(!$ev, 'delete records from test table');
return;
}
sub test_value
{
my ($dbh, $value) = @_;
local $dbh->{RaiseError} = 1;
my $max = 60001;
$max = 120001 if ($type == SQL_WLONGVARCHAR);
local $dbh->{LongReadLen} = $max;
my $row = $dbh->selectall_arrayref(q/select a from DBD_ODBC_drop_me/);
$ev = $@;
diag($ev) if $ev;
ok(!$ev, 'select test data back');
my $rc = is(length($row->[0]->[0]), length($value),
"sizes of insert/select compare");
SKIP: {
skip "sizes do not match", 1 unless $rc;
is($row->[0]->[0], $value, 'data read back compares');
};
return;
}
|
