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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
#!/usr/bin/perl -w -I./t
# $Id: rt_38977.t 13874 2010-03-24 14:22:58Z mjevans $
#
# rt 38977 and 48304
#
# test varbinary(MAX), varchar(MAX) and nvarchar(MAX) types in SQL Server
#
use Test::More;
use strict;
$| = 1;
my $has_test_nowarnings = 1;
eval "require Test::NoWarnings";
$has_test_nowarnings = undef if $@;
my $tests = 14;
$tests += 1 if $has_test_nowarnings;
plan tests => $tests;
# can't seem to get the imports right this way
use DBI qw(:sql_types);
use_ok('ODBCTEST'); # 1
my $dbh;
BEGIN {
if (!defined $ENV{DBI_DSN}) {
plan skip_all => "DBI_DSN is undefined";
}
}
END {
if ($dbh) {
eval {
local $dbh->{PrintWarn} = 0;
local $dbh->{PrintError} = 0;
$dbh->do(q/drop table PERL_DBD_RT_38977/);
};
}
Test::NoWarnings::had_no_warnings()
if ($has_test_nowarnings);
}
$dbh = DBI->connect();
unless($dbh) {
BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n");
exit 0;
}
$dbh->{RaiseError} = 1;
my $dbms_name = $dbh->get_info(17);
ok($dbms_name, "got DBMS name: $dbms_name"); # 2
my $dbms_version = $dbh->get_info(18);
ok($dbms_version, "got DBMS version: $dbms_version"); # 3
my $driver_name = $dbh->get_info(6);
ok($driver_name, "got DRIVER name: $driver_name"); # 4
my $driver_version = $dbh->get_info(7);
ok($driver_version, "got DRIVER version $driver_version"); # 5
my ($ev, $sth);
SKIP: {
skip "not SQL Server", 9 if $dbms_name !~ /Microsoft SQL Server/;
skip "Easysoft OOB", 9 if $driver_name =~ /esoobclient/;
my $major_version = $dbms_version;
$major_version =~ s/^(\d+)\..*$/$1/;
#diag("Major Version: $major_version\n");
skip "SQL Server version too old", 9 if $major_version < 9;
eval {
local $dbh->{PrintWarn} = 0;
local $dbh->{PrintError} = 0;
$dbh->do('drop table PERL_DBD_RT_38977');
};
eval {
$dbh->do('create table PERL_DBD_RT_38977 (a VARCHAR(MAX))');
};
$ev = $@;
ok(!$ev, 'create test table with varchar(max)'); # 6
SKIP: {
skip "Failed to create test table", 2 if ($ev);
eval {
$sth = $dbh->prepare('INSERT into PERL_DBD_RT_38977 VALUES (?)');
};
$ev = $@;
ok($sth && !$@, "prepare insert"); # 7
SKIP: {
skip "Failed to prepare", 1 if ($ev);
my $x = 'x' x 500000;
eval {
$sth->execute($x);
};
$ev = $@;
ok(!$ev, "execute insert"); # 8
if ($ev) {
diag("Execute for insert into varchar(max) failed with $ev");
diag(q/Some SQL Server drivers such as the native client 09.00.1399 / .
q/driver fail this test with a HY104, "Invalid precision error". / .
qq/You have driver $driver_name at version $driver_version. / .
q/There is a free upgrade from Microsoft of the native client driver /.
q/to 10.00.1600 which you will need if you intend to insert / .
q/into varchar(max) columns./);
}
};
};
eval {
local $dbh->{PrintWarn} = 0;
local $dbh->{PrintError} = 0;
$dbh->do('drop table PERL_DBD_RT_38977');
};
eval {
$dbh->do('create table PERL_DBD_RT_38977 (a VARBINARY(MAX))');
};
$ev = $@;
ok(!$ev, 'create test table with varbinary(max)'); # 9
SKIP: {
skip "Failed to create test table", 2 if ($ev);
eval {
$sth = $dbh->prepare('INSERT into PERL_DBD_RT_38977 VALUES (?)');
};
$ev = $@;
ok($sth && !$@, "prepare insert"); # 10
SKIP: {
skip "Failed to prepare", 1 if ($ev);
my $x = 'x' x 500000;
ok($sth->execute($x), "execute insert");
};
};
eval {
local $dbh->{PrintWarn} = 0;
local $dbh->{PrintError} = 0;
$dbh->do('drop table PERL_DBD_RT_38977');
};
eval {
$dbh->do('create table PERL_DBD_RT_38977 (a NVARCHAR(MAX))');
};
$ev = $@;
ok(!$ev, 'create test table with nvarchar(max)'); # 11
SKIP: {
skip "Failed to create test table", 2 if ($ev);
eval {
$sth = $dbh->prepare('INSERT into PERL_DBD_RT_38977 VALUES (?)');
};
$ev = $@;
ok($sth && !$@, "prepare insert"); # 12
SKIP: {
skip "Failed to prepare", 1 if ($ev);
my $x = 'x' x 4001;
ok($sth->execute($x), "execute insert"); # 13
};
};
};
#my $ev;
#
#eval {$h->do('drop table binary_meta');};
#$h->do('create table binary_meta (doc_id INTEGER NOT NULL, meta_name VARCHAR (255), meta_value VARCHAR(MAX), meta_idx INTEGER, from_ver BIGINT, to_ver BIGINT)');
#my $s = $h->prepare('INSERT into binary_meta VALUES (?, ?, ?, ?, ?, ?)');
#my $x = 'x' x 5000000;
#$s->execute(1, 'fred', $x, 1, 1, 1);
|
