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
|
#!perl -w
use Test::More;
use strict;
use DBI qw(:sql_types);
use Data::Dumper;
unshift @INC ,'t';
require 'nchar_test_lib.pl';
$| = 1;
my $dsn = oracle_test_dsn();
my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
my $dbh = DBI->connect($dsn, $dbuser, '', {PrintError => 0 });
if ($dbh) {
plan tests=>21;
$dbh->{RaiseError} = 1;
} else {
plan skip_all => "Unable to connect to Oracle";
}
note("type_info_all\n");
my @types = $dbh->type_info(SQL_ALL_TYPES);
ok(@types >= 8, 'more than 8 types');
note(Dumper( @types ));
note("tables():\n");
my @tables = $dbh->tables;
note(@tables." tables\n");
ok(scalar @tables, 'tables');
my @table_info_params = (
[ 'schema list', undef, '%', undef, undef ],
[ 'type list', undef, undef, undef, '%' ],
[ 'table list', undef, undef, undef, undef ],
);
foreach my $table_info_params (@table_info_params) {
my ($name) = shift @$table_info_params;
my $start = time;
note("$name: table_info(".DBI::neat_list($table_info_params).")\n");
my $table_info_sth = $dbh->table_info(@$table_info_params);
ok($table_info_sth, 'table_info');
my $data = $table_info_sth->fetchall_arrayref;
ok($data, 'table_info fetch');
ok(scalar @$data, 'table_info data returned');
my $dur = time - $start;
note("$name: ".@$data." rows, $dur seconds\n");
}
my $sql_dbms_version = $dbh->get_info(18);
ok($sql_dbms_version, 'dbms_version');
note "sql_dbms_version=$sql_dbms_version";
like($sql_dbms_version, qr/^\d+\.\d+\.\d+$/, 'matched');
# test long DEFAULT from column_info
SKIP: {
my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||'');
eval { $dbh->do("DROP TABLE $table") };
my $created = eval { $dbh->do("CREATE TABLE $table (testcol NUMBER(15) DEFAULT to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ', null,substrb(userenv('CLIENT_INFO'),1,10))))") };
skip 'could not create test table', 8 unless $created;
is $dbh->{LongReadLen}, 80, 'LongReadLen is at default';
ok((my $sth = $dbh->column_info(undef, '%', uc($table), '%')), 'column_info sth');
is $dbh->{LongReadLen}, 80, 'LongReadLen still at default';
ok((my $info = eval { $sth->fetchrow_hashref }), 'sth->fetchrow_hashref lived')
or diag $@;
is $info->{COLUMN_DEF}, "to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ', null,substrb(userenv('CLIENT_INFO'),1,10)))", 'long DEFAULT matched';
ok($sth->finish, 'sth->finish');
is $dbh->{LongReadLen}, 80, 'LongReadLen still at default';
ok($dbh->do("DROP TABLE $table"), 'drop table');
}
$dbh->disconnect;
exit 0;
|
