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
|
#!perl
#
# Test you can set and retrieve some attributes after connect
# MJE wrote this after discovering the code to set these attributes
# was duplicated in connect/login6 and STORE and it did not need to be
# because DBI passes attributes to STORE for you.
#
use strict;
use warnings;
use lib 't/lib';
use DBDOracleTestLib qw/ oracle_test_dsn db_handle /;
use DBI;
use DBD::Oracle(qw(ORA_OCI));
#use Devel::Peek qw(SvREFCNT Dump);
use Test::More;
$| = 1;
#use Devel::Leak;
#use Test::LeakTrace;
#no_leaks_ok {
do_it();
#} -verbose;
sub do_it {
#my $handle;
#my $count = Devel::Leak::NoteSV($handle);
my $dbh = db_handle()
or plan skip_all => 'Unable to connect to Oracle';
diag( 'Oracle version: '
. join( '.', @{ $dbh->func('ora_server_version') } ) );
diag( 'client version: ' . ORA_OCI() );
SKIP: {
my @attrs = (
qw(ora_module_name
ora_client_info
ora_client_identifier
ora_action)
);
my @attrs112 = (qw(ora_driver_name));
skip( 'Oracle OCI too old', 1 + @attrs + @attrs112 ) if ORA_OCI() < 11;
foreach my $attr (@attrs) {
$dbh->{$attr} = 'fred';
is( $dbh->{$attr}, 'fred', "attribute $attr set and retrieved" );
}
SKIP: {
skip 'Oracle OCI too old', 1 + @attrs112 if ORA_OCI() < 11.2;
like( $dbh->{ora_driver_name}, qr/DBD/, 'Default driver name' );
foreach my $attr (@attrs) {
$dbh->{$attr} = 'fred';
is( $dbh->{$attr}, 'fred',
"attribute $attr set and retrieved" );
}
}
}
for my $attr (
qw(ora_oci_success_warn
ora_objects)
)
{
$dbh->{$attr} = 1;
is( $dbh->{$attr}, 1, "attribute $attr set and retrieved" );
}
$dbh->disconnect;
#Devel::Leak::CheckSV($handle);
}
done_testing();
|
