| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package UR::DataSource::Oracle; |
|
2
|
5
|
|
|
5
|
|
122
|
use strict; |
|
|
5
|
|
|
|
|
7
|
|
|
|
5
|
|
|
|
|
119
|
|
|
3
|
5
|
|
|
5
|
|
14
|
use warnings; |
|
|
5
|
|
|
|
|
9
|
|
|
|
5
|
|
|
|
|
11342
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
require UR; |
|
6
|
|
|
|
|
|
|
our $VERSION = "0.46"; # UR $VERSION; |
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
UR::Object::Type->define( |
|
9
|
|
|
|
|
|
|
class_name => 'UR::DataSource::Oracle', |
|
10
|
|
|
|
|
|
|
is => ['UR::DataSource::RDBMS'], |
|
11
|
|
|
|
|
|
|
is_abstract => 1, |
|
12
|
|
|
|
|
|
|
); |
|
13
|
|
|
|
|
|
|
|
|
14
|
0
|
|
|
0
|
0
|
0
|
sub driver { "Oracle" } |
|
15
|
|
|
|
|
|
|
|
|
16
|
0
|
|
|
0
|
0
|
0
|
sub owner { shift->_singleton_object->login } |
|
17
|
|
|
|
|
|
|
|
|
18
|
5
|
|
|
5
|
0
|
12
|
sub can_savepoint { 1 } # Oracle supports savepoints inside transactions |
|
19
|
|
|
|
|
|
|
|
|
20
|
10
|
|
|
10
|
0
|
28
|
sub does_support_limit_offset { 0 } |
|
21
|
|
|
|
|
|
|
|
|
22
|
0
|
|
|
0
|
0
|
0
|
sub does_support_recursive_queries { 'connect by' }; |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub set_savepoint { |
|
25
|
0
|
|
|
0
|
0
|
0
|
my($self,$sp_name) = @_; |
|
26
|
|
|
|
|
|
|
|
|
27
|
0
|
|
|
|
|
0
|
my $dbh = $self->get_default_handle; |
|
28
|
0
|
|
|
|
|
0
|
my $sp = $dbh->quote($sp_name); |
|
29
|
0
|
|
|
|
|
0
|
$dbh->do("savepoint $sp_name"); |
|
30
|
|
|
|
|
|
|
} |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub rollback_to_savepoint { |
|
34
|
0
|
|
|
0
|
0
|
0
|
my($self,$sp_name) = @_; |
|
35
|
|
|
|
|
|
|
|
|
36
|
0
|
|
|
|
|
0
|
my $dbh = $self->get_default_handle; |
|
37
|
0
|
|
|
|
|
0
|
my $sp = $dbh->quote($sp_name); |
|
38
|
0
|
|
|
|
|
0
|
$dbh->do("rollback to $sp_name"); |
|
39
|
|
|
|
|
|
|
} |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
my $DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS'; |
|
43
|
|
|
|
|
|
|
my $TIMESTAMP_FORMAT = 'YYYY-MM-DD HH24:MI:SSXFF'; |
|
44
|
|
|
|
|
|
|
sub _set_date_format { |
|
45
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
46
|
|
|
|
|
|
|
|
|
47
|
0
|
|
|
|
|
0
|
foreach my $sql ("alter session set NLS_DATE_FORMAT = '$DATE_FORMAT'", |
|
48
|
|
|
|
|
|
|
"alter session set NLS_TIMESTAMP_FORMAT = '$TIMESTAMP_FORMAT'" |
|
49
|
|
|
|
|
|
|
) { |
|
50
|
0
|
|
|
|
|
0
|
$self->do_sql($sql); |
|
51
|
|
|
|
|
|
|
} |
|
52
|
|
|
|
|
|
|
} |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
*_init_created_dbh = \&init_created_handle; |
|
56
|
|
|
|
|
|
|
sub init_created_handle { |
|
57
|
0
|
|
|
0
|
0
|
0
|
my ($self, $dbh) = @_; |
|
58
|
0
|
0
|
|
|
|
0
|
return unless defined $dbh; |
|
59
|
0
|
|
|
|
|
0
|
$dbh->{LongTruncOk} = 0; |
|
60
|
|
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
0
|
$self->_set_date_format(); |
|
62
|
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
0
|
return $dbh; |
|
64
|
|
|
|
|
|
|
} |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub _dbi_connect_args { |
|
67
|
0
|
|
|
0
|
|
0
|
my @args = shift->SUPER::_dbi_connect_args(@_); |
|
68
|
0
|
|
0
|
|
|
0
|
$args[3]{ora_module_name} = (UR::Context::Process->get_current->prog_name || $0); |
|
69
|
0
|
|
|
|
|
0
|
return @args; |
|
70
|
|
|
|
|
|
|
} |
|
71
|
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub _prepare_for_lob { |
|
73
|
0
|
|
|
0
|
|
0
|
{ ora_auto_lob => 0 } |
|
74
|
|
|
|
|
|
|
} |
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub _post_process_lob_values { |
|
77
|
0
|
|
|
0
|
|
0
|
my ($self, $dbh, $lob_id_arrayref) = @_; |
|
78
|
|
|
|
|
|
|
return |
|
79
|
|
|
|
|
|
|
map { |
|
80
|
0
|
0
|
|
|
|
0
|
if (defined($_)) { |
|
|
0
|
|
|
|
|
0
|
|
|
81
|
0
|
|
|
|
|
0
|
my $length = $dbh->ora_lob_length($_); |
|
82
|
0
|
|
|
|
|
0
|
my $data = $dbh->ora_lob_read($_, 1, $length); |
|
83
|
|
|
|
|
|
|
# TODO: bind to a file for items of a certain size to save RAM. |
|
84
|
|
|
|
|
|
|
# Special work with tying a scalar to the file? |
|
85
|
0
|
|
|
|
|
0
|
$data; |
|
86
|
|
|
|
|
|
|
} |
|
87
|
|
|
|
|
|
|
else { |
|
88
|
0
|
|
|
|
|
0
|
undef; |
|
89
|
|
|
|
|
|
|
} |
|
90
|
|
|
|
|
|
|
} @$lob_id_arrayref; |
|
91
|
|
|
|
|
|
|
} |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub _ignore_table { |
|
94
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
95
|
0
|
|
|
|
|
0
|
my $table_name = shift; |
|
96
|
0
|
0
|
|
|
|
0
|
return 1 if $table_name =~ /\$/; |
|
97
|
|
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub get_table_last_ddl_times_by_table_name { |
|
100
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
|
101
|
0
|
|
|
|
|
0
|
my $sql = qq| |
|
102
|
|
|
|
|
|
|
select object_name table_name, last_ddl_time |
|
103
|
|
|
|
|
|
|
from all_objects o |
|
104
|
|
|
|
|
|
|
where o.owner = ? |
|
105
|
|
|
|
|
|
|
and (o.object_type = 'TABLE' or o.object_type = 'VIEW') |
|
106
|
|
|
|
|
|
|
|; |
|
107
|
0
|
|
|
|
|
0
|
my $data = $self->get_default_handle->selectall_arrayref( |
|
108
|
|
|
|
|
|
|
$sql, |
|
109
|
|
|
|
|
|
|
undef, |
|
110
|
|
|
|
|
|
|
$self->owner |
|
111
|
|
|
|
|
|
|
); |
|
112
|
0
|
|
|
|
|
0
|
return { map { @$_ } @$data }; |
|
|
0
|
|
|
|
|
0
|
|
|
113
|
|
|
|
|
|
|
}; |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub _get_next_value_from_sequence { |
|
116
|
0
|
|
|
0
|
|
0
|
my($self,$sequence_name) = @_; |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# we may need to change how this db handle is gotten |
|
119
|
0
|
|
|
|
|
0
|
my $dbh = $self->get_default_handle; |
|
120
|
0
|
|
|
|
|
0
|
my $new_id = $dbh->selectrow_array("SELECT " . $sequence_name . ".nextval from DUAL"); |
|
121
|
|
|
|
|
|
|
|
|
122
|
0
|
0
|
|
|
|
0
|
if ($dbh->err) { |
|
123
|
0
|
|
|
|
|
0
|
die "Failed to prepare SQL to generate a column id from sequence: $sequence_name.\n" . $dbh->errstr . "\n"; |
|
124
|
0
|
|
|
|
|
0
|
return; |
|
125
|
|
|
|
|
|
|
} |
|
126
|
|
|
|
|
|
|
|
|
127
|
0
|
|
|
|
|
0
|
return $new_id; |
|
128
|
|
|
|
|
|
|
} |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub get_bitmap_index_details_from_data_dictionary { |
|
131
|
0
|
|
|
0
|
0
|
0
|
my($self, $table_name) = @_; |
|
132
|
0
|
|
|
|
|
0
|
my $sql = qq( |
|
133
|
|
|
|
|
|
|
select c.table_name,c.column_name,c.index_name |
|
134
|
|
|
|
|
|
|
from all_indexes i join all_ind_columns c on i.index_name = c.index_name |
|
135
|
|
|
|
|
|
|
where i.index_type = 'BITMAP' |
|
136
|
|
|
|
|
|
|
); |
|
137
|
|
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
0
|
my @select_params; |
|
139
|
0
|
0
|
|
|
|
0
|
if ($table_name) { |
|
140
|
0
|
|
|
|
|
0
|
@select_params = $self->_resolve_owner_and_table_from_table_name($table_name); |
|
141
|
0
|
|
|
|
|
0
|
$sql .= " and i.table_owner = ? and i.table_name = ?"; |
|
142
|
|
|
|
|
|
|
} |
|
143
|
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
0
|
my $dbh = $self->get_default_handle; |
|
145
|
0
|
|
|
|
|
0
|
my $rows = $dbh->selectall_arrayref($sql, undef, @select_params); |
|
146
|
0
|
0
|
|
|
|
0
|
return undef unless $rows; |
|
147
|
|
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
0
|
my @ret = map { { table_name => $_->[0], column_name => $_->[1], index_name => $_->[2] } } @$rows; |
|
|
0
|
|
|
|
|
0
|
|
|
149
|
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
0
|
return \@ret; |
|
151
|
|
|
|
|
|
|
} |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub get_unique_index_details_from_data_dictionary { |
|
155
|
0
|
|
|
0
|
0
|
0
|
my ($self, $owner_name, $table_name) = @_; |
|
156
|
0
|
|
|
|
|
0
|
my $sql = qq( |
|
157
|
|
|
|
|
|
|
select cc.constraint_name, cc.column_name |
|
158
|
|
|
|
|
|
|
from all_cons_columns cc |
|
159
|
|
|
|
|
|
|
join all_constraints c |
|
160
|
|
|
|
|
|
|
on c.constraint_name = cc.constraint_name |
|
161
|
|
|
|
|
|
|
and c.owner = cc.owner |
|
162
|
|
|
|
|
|
|
and c.constraint_type = 'U' |
|
163
|
|
|
|
|
|
|
where cc.table_name = ? |
|
164
|
|
|
|
|
|
|
and cc.owner = ? |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
union |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
select ai.index_name, aic.column_name |
|
169
|
|
|
|
|
|
|
from all_indexes ai |
|
170
|
|
|
|
|
|
|
join all_ind_columns aic |
|
171
|
|
|
|
|
|
|
on aic.index_name = ai.index_name |
|
172
|
|
|
|
|
|
|
and aic.index_owner = ai.owner |
|
173
|
|
|
|
|
|
|
where ai.uniqueness = 'UNIQUE' |
|
174
|
|
|
|
|
|
|
and aic.table_name = ? |
|
175
|
|
|
|
|
|
|
and aic.index_owner = ? |
|
176
|
|
|
|
|
|
|
); |
|
177
|
|
|
|
|
|
|
|
|
178
|
0
|
|
|
|
|
0
|
my $dbh = $self->get_default_handle(); |
|
179
|
0
|
0
|
|
|
|
0
|
return undef unless $dbh; |
|
180
|
|
|
|
|
|
|
|
|
181
|
0
|
|
|
|
|
0
|
my $sth = $dbh->prepare($sql); |
|
182
|
0
|
0
|
|
|
|
0
|
return undef unless $sth; |
|
183
|
|
|
|
|
|
|
|
|
184
|
0
|
|
|
|
|
0
|
$sth->execute($table_name, $owner_name, $table_name, $owner_name); |
|
185
|
|
|
|
|
|
|
|
|
186
|
0
|
|
|
|
|
0
|
my $ret; |
|
187
|
0
|
|
|
|
|
0
|
while (my $data = $sth->fetchrow_hashref()) { |
|
188
|
0
|
|
0
|
|
|
0
|
$ret->{$data->{'CONSTRAINT_NAME'}} ||= []; |
|
189
|
0
|
|
|
|
|
0
|
push @{ $ret->{ $data->{CONSTRAINT_NAME} } }, $data->{COLUMN_NAME}; |
|
|
0
|
|
|
|
|
0
|
|
|
190
|
|
|
|
|
|
|
} |
|
191
|
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
0
|
return $ret; |
|
193
|
|
|
|
|
|
|
} |
|
194
|
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub set_userenv { |
|
196
|
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# there are two places to set these oracle variables- |
|
198
|
|
|
|
|
|
|
# 1. this method in UR::DataSource::Oracle is a class method |
|
199
|
|
|
|
|
|
|
# that can be called to change the values later |
|
200
|
|
|
|
|
|
|
# 2. the method in YourSubclass::DataSource::Oracle is called in |
|
201
|
|
|
|
|
|
|
# init_created_handle which is called while the datasource |
|
202
|
|
|
|
|
|
|
# is still being set up- it operates directly on the db handle |
|
203
|
|
|
|
|
|
|
|
|
204
|
0
|
|
|
0
|
0
|
0
|
my ($self, %p) = @_; |
|
205
|
|
|
|
|
|
|
|
|
206
|
0
|
|
0
|
|
|
0
|
my $dbh = $p{'dbh'} || $self->get_default_handle(); |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# module is application name |
|
209
|
0
|
|
0
|
|
|
0
|
my $module = $p{'module'} || $0; |
|
210
|
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# storing username in 'action' oracle variable |
|
212
|
0
|
|
|
|
|
0
|
my $action = $p{'action'}; |
|
213
|
0
|
0
|
|
|
|
0
|
if (! defined($action)) { |
|
214
|
0
|
|
|
|
|
0
|
$action = getpwuid($>); # real UID |
|
215
|
|
|
|
|
|
|
} |
|
216
|
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
0
|
my $sql = q{BEGIN dbms_application_info.set_module(?, ?); END;}; |
|
218
|
|
|
|
|
|
|
|
|
219
|
0
|
|
|
|
|
0
|
my $sth = $dbh->prepare($sql); |
|
220
|
0
|
0
|
|
|
|
0
|
if (!$sth) { |
|
221
|
0
|
|
|
|
|
0
|
warn "Couldnt prepare query to set module/action in Oracle"; |
|
222
|
0
|
|
|
|
|
0
|
return undef; |
|
223
|
|
|
|
|
|
|
} |
|
224
|
|
|
|
|
|
|
|
|
225
|
0
|
0
|
|
|
|
0
|
$sth->execute($module, $action) || warn "Couldnt set module/action in Oracle"; |
|
226
|
|
|
|
|
|
|
} |
|
227
|
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub get_userenv { |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# there are two ways to set these values but this is |
|
231
|
|
|
|
|
|
|
# the only way to retrieve the values after they are set |
|
232
|
|
|
|
|
|
|
|
|
233
|
0
|
|
|
0
|
0
|
0
|
my ($self, $dbh) = @_; |
|
234
|
|
|
|
|
|
|
|
|
235
|
0
|
0
|
|
|
|
0
|
if (!$dbh) { |
|
236
|
0
|
|
|
|
|
0
|
$dbh = $self->get_default_handle(); |
|
237
|
|
|
|
|
|
|
} |
|
238
|
|
|
|
|
|
|
|
|
239
|
0
|
0
|
|
|
|
0
|
if (!$dbh) { |
|
240
|
0
|
|
|
|
|
0
|
warn "No dbh"; |
|
241
|
0
|
|
|
|
|
0
|
return undef; |
|
242
|
|
|
|
|
|
|
} |
|
243
|
|
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
0
|
my $sql = q{ |
|
245
|
|
|
|
|
|
|
SELECT sys_context('USERENV','MODULE') as module, |
|
246
|
|
|
|
|
|
|
sys_context('USERENV','ACTION') as action |
|
247
|
|
|
|
|
|
|
FROM dual |
|
248
|
|
|
|
|
|
|
}; |
|
249
|
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
0
|
my $sth = $dbh->prepare($sql); |
|
251
|
0
|
0
|
|
|
|
0
|
return undef unless $sth; |
|
252
|
|
|
|
|
|
|
|
|
253
|
0
|
0
|
|
|
|
0
|
$sth->execute() || die "execute failed: $!"; |
|
254
|
0
|
|
|
|
|
0
|
my $r = $sth->fetchrow_hashref(); |
|
255
|
|
|
|
|
|
|
|
|
256
|
0
|
|
|
|
|
0
|
return $r; |
|
257
|
|
|
|
|
|
|
} |
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
my %ur_data_type_for_vendor_data_type = ( |
|
261
|
|
|
|
|
|
|
'VARCHAR2' => ['Text', undef], |
|
262
|
|
|
|
|
|
|
'BLOB' => ['XmlBlob', undef], |
|
263
|
|
|
|
|
|
|
); |
|
264
|
|
|
|
|
|
|
sub ur_data_type_for_data_source_data_type { |
|
265
|
3
|
|
|
3
|
0
|
138
|
my($class,$type) = @_; |
|
266
|
|
|
|
|
|
|
|
|
267
|
3
|
|
|
|
|
10
|
$type = $class->normalize_vendor_type($type); |
|
268
|
3
|
|
|
|
|
4
|
my $urtype = $ur_data_type_for_vendor_data_type{$type}; |
|
269
|
3
|
50
|
|
|
|
6
|
unless (defined $urtype) { |
|
270
|
3
|
|
|
|
|
8
|
$urtype = $class->SUPER::ur_data_type_for_data_source_data_type($type); |
|
271
|
|
|
|
|
|
|
} |
|
272
|
3
|
|
|
|
|
5
|
return $urtype; |
|
273
|
|
|
|
|
|
|
} |
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sub _alter_sth_for_selecting_blob_columns { |
|
276
|
0
|
|
|
0
|
|
0
|
my($self, $sth, $column_objects) = @_; |
|
277
|
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
0
|
for (my $n = 0; $n < @$column_objects; $n++) { |
|
279
|
0
|
0
|
|
|
|
0
|
next unless defined ($column_objects->[$n]); # No metaDB info for this one |
|
280
|
0
|
0
|
|
|
|
0
|
if ($column_objects->[$n]->data_type eq 'BLOB') { |
|
281
|
0
|
|
|
|
|
0
|
$sth->bind_param($n+1, undef, { ora_type => 23 }); |
|
282
|
|
|
|
|
|
|
} |
|
283
|
|
|
|
|
|
|
} |
|
284
|
|
|
|
|
|
|
} |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub get_connection_debug_info { |
|
287
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
|
288
|
0
|
|
|
|
|
0
|
my @debug_info = $self->SUPER::get_connection_debug_info(@_); |
|
289
|
|
|
|
|
|
|
push @debug_info, ( |
|
290
|
|
|
|
|
|
|
"DBD::Oracle Version: ", $DBD::Oracle::VERSION, "\n", |
|
291
|
|
|
|
|
|
|
"TNS_ADMIN: ", $ENV{TNS_ADMIN}, "\n", |
|
292
|
0
|
|
|
|
|
0
|
"ORACLE_HOME: ", $ENV{ORACLE_HOME}, "\n", |
|
293
|
|
|
|
|
|
|
); |
|
294
|
0
|
|
|
|
|
0
|
return @debug_info; |
|
295
|
|
|
|
|
|
|
} |
|
296
|
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# This is a near cut-and-paste from DBD::Oracle, with the exception that |
|
299
|
|
|
|
|
|
|
# the query hint is removed, since it performs poorly on Oracle 11 |
|
300
|
|
|
|
|
|
|
sub get_table_details_from_data_dictionary { |
|
301
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
|
302
|
|
|
|
|
|
|
|
|
303
|
0
|
|
|
|
|
0
|
my $version = $self->_get_oracle_major_server_version(); |
|
304
|
0
|
0
|
|
|
|
0
|
if ($version < '11') { |
|
305
|
0
|
|
|
|
|
0
|
return $self->SUPER::get_table_details_from_data_dictionary(@_); |
|
306
|
|
|
|
|
|
|
} |
|
307
|
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
0
|
my($CatVal, $SchVal, $TblVal, $TypVal) = @_; |
|
309
|
0
|
|
|
|
|
0
|
my $dbh = $self->get_default_handle(); |
|
310
|
|
|
|
|
|
|
# XXX add knowledge of temp tables, etc |
|
311
|
|
|
|
|
|
|
# SQL/CLI (ISO/IEC JTC 1/SC 32 N 0595), 6.63 Tables |
|
312
|
0
|
0
|
|
|
|
0
|
if (ref $CatVal eq 'HASH') { |
|
313
|
|
|
|
|
|
|
($CatVal, $SchVal, $TblVal, $TypVal) = |
|
314
|
0
|
|
|
|
|
0
|
@$CatVal{'TABLE_CAT','TABLE_SCHEM','TABLE_NAME','TABLE_TYPE'}; |
|
315
|
|
|
|
|
|
|
} |
|
316
|
0
|
|
|
|
|
0
|
my @Where = (); |
|
317
|
0
|
|
|
|
|
0
|
my $SQL; |
|
318
|
0
|
0
|
0
|
|
|
0
|
if ( defined $CatVal && $CatVal eq '%' && (!defined $SchVal || $SchVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19a |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
319
|
0
|
|
|
|
|
0
|
$SQL = <<'SQL'; |
|
320
|
|
|
|
|
|
|
SELECT NULL TABLE_CAT |
|
321
|
|
|
|
|
|
|
, NULL TABLE_SCHEM |
|
322
|
|
|
|
|
|
|
, NULL TABLE_NAME |
|
323
|
|
|
|
|
|
|
, NULL TABLE_TYPE |
|
324
|
|
|
|
|
|
|
, NULL REMARKS |
|
325
|
|
|
|
|
|
|
FROM DUAL |
|
326
|
|
|
|
|
|
|
SQL |
|
327
|
|
|
|
|
|
|
} |
|
328
|
|
|
|
|
|
|
elsif ( defined $SchVal && $SchVal eq '%' && (!defined $CatVal || $CatVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19b |
|
329
|
0
|
|
|
|
|
0
|
$SQL = <<'SQL'; |
|
330
|
|
|
|
|
|
|
SELECT NULL TABLE_CAT |
|
331
|
|
|
|
|
|
|
, s TABLE_SCHEM |
|
332
|
|
|
|
|
|
|
, NULL TABLE_NAME |
|
333
|
|
|
|
|
|
|
, NULL TABLE_TYPE |
|
334
|
|
|
|
|
|
|
, NULL REMARKS |
|
335
|
|
|
|
|
|
|
FROM |
|
336
|
|
|
|
|
|
|
( |
|
337
|
|
|
|
|
|
|
SELECT USERNAME s FROM ALL_USERS |
|
338
|
|
|
|
|
|
|
UNION |
|
339
|
|
|
|
|
|
|
SELECT 'PUBLIC' s FROM DUAL |
|
340
|
|
|
|
|
|
|
) |
|
341
|
|
|
|
|
|
|
ORDER BY TABLE_SCHEM |
|
342
|
|
|
|
|
|
|
SQL |
|
343
|
|
|
|
|
|
|
} |
|
344
|
|
|
|
|
|
|
elsif ( defined $TypVal && $TypVal eq '%' && (!defined $CatVal || $CatVal eq '') && (!defined $SchVal || $SchVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19c |
|
345
|
0
|
|
|
|
|
0
|
$SQL = <<'SQL'; |
|
346
|
|
|
|
|
|
|
SELECT NULL TABLE_CAT |
|
347
|
|
|
|
|
|
|
, NULL TABLE_SCHEM |
|
348
|
|
|
|
|
|
|
, NULL TABLE_NAME |
|
349
|
|
|
|
|
|
|
, t.tt TABLE_TYPE |
|
350
|
|
|
|
|
|
|
, NULL REMARKS |
|
351
|
|
|
|
|
|
|
FROM |
|
352
|
|
|
|
|
|
|
( |
|
353
|
|
|
|
|
|
|
SELECT 'TABLE' tt FROM DUAL |
|
354
|
|
|
|
|
|
|
UNION |
|
355
|
|
|
|
|
|
|
SELECT 'VIEW' tt FROM DUAL |
|
356
|
|
|
|
|
|
|
UNION |
|
357
|
|
|
|
|
|
|
SELECT 'SYNONYM' tt FROM DUAL |
|
358
|
|
|
|
|
|
|
UNION |
|
359
|
|
|
|
|
|
|
SELECT 'SEQUENCE' tt FROM DUAL |
|
360
|
|
|
|
|
|
|
) t |
|
361
|
|
|
|
|
|
|
ORDER BY TABLE_TYPE |
|
362
|
|
|
|
|
|
|
SQL |
|
363
|
|
|
|
|
|
|
} |
|
364
|
|
|
|
|
|
|
else { |
|
365
|
0
|
|
|
|
|
0
|
$SQL = <<'SQL'; |
|
366
|
|
|
|
|
|
|
SELECT * |
|
367
|
|
|
|
|
|
|
FROM |
|
368
|
|
|
|
|
|
|
( |
|
369
|
|
|
|
|
|
|
SELECT |
|
370
|
|
|
|
|
|
|
NULL TABLE_CAT |
|
371
|
|
|
|
|
|
|
, t.OWNER TABLE_SCHEM |
|
372
|
|
|
|
|
|
|
, t.TABLE_NAME TABLE_NAME |
|
373
|
|
|
|
|
|
|
, decode(t.OWNER |
|
374
|
|
|
|
|
|
|
, 'SYS' , 'SYSTEM ' |
|
375
|
|
|
|
|
|
|
, 'SYSTEM' , 'SYSTEM ' |
|
376
|
|
|
|
|
|
|
, '' ) || t.TABLE_TYPE TABLE_TYPE |
|
377
|
|
|
|
|
|
|
, c.COMMENTS REMARKS |
|
378
|
|
|
|
|
|
|
FROM ALL_TAB_COMMENTS c |
|
379
|
|
|
|
|
|
|
, ALL_CATALOG t |
|
380
|
|
|
|
|
|
|
WHERE c.OWNER (+) = t.OWNER |
|
381
|
|
|
|
|
|
|
AND c.TABLE_NAME (+) = t.TABLE_NAME |
|
382
|
|
|
|
|
|
|
AND c.TABLE_TYPE (+) = t.TABLE_TYPE |
|
383
|
|
|
|
|
|
|
) |
|
384
|
|
|
|
|
|
|
SQL |
|
385
|
0
|
0
|
|
|
|
0
|
if ( defined $SchVal ) { |
|
386
|
0
|
|
|
|
|
0
|
push @Where, "TABLE_SCHEM LIKE '$SchVal' ESCAPE '\\'"; |
|
387
|
|
|
|
|
|
|
} |
|
388
|
0
|
0
|
|
|
|
0
|
if ( defined $TblVal ) { |
|
389
|
0
|
|
|
|
|
0
|
push @Where, "TABLE_NAME LIKE '$TblVal' ESCAPE '\\'"; |
|
390
|
|
|
|
|
|
|
} |
|
391
|
0
|
0
|
|
|
|
0
|
if ( defined $TypVal ) { |
|
392
|
0
|
|
|
|
|
0
|
my $table_type_list; |
|
393
|
0
|
|
|
|
|
0
|
$TypVal =~ s/^\s+//; |
|
394
|
0
|
|
|
|
|
0
|
$TypVal =~ s/\s+$//; |
|
395
|
0
|
|
|
|
|
0
|
my @ttype_list = split (/\s*,\s*/, $TypVal); |
|
396
|
0
|
|
|
|
|
0
|
foreach my $table_type (@ttype_list) { |
|
397
|
0
|
0
|
|
|
|
0
|
if ($table_type !~ /^'.*'$/) { |
|
398
|
0
|
|
|
|
|
0
|
$table_type = "'" . $table_type . "'"; |
|
399
|
|
|
|
|
|
|
} |
|
400
|
0
|
|
|
|
|
0
|
$table_type_list = join(", ", @ttype_list); |
|
401
|
|
|
|
|
|
|
} |
|
402
|
0
|
|
|
|
|
0
|
push @Where, "TABLE_TYPE IN ($table_type_list)"; |
|
403
|
|
|
|
|
|
|
} |
|
404
|
0
|
0
|
|
|
|
0
|
$SQL .= ' WHERE ' . join("\n AND ", @Where ) . "\n" if @Where; |
|
405
|
0
|
|
|
|
|
0
|
$SQL .= " ORDER BY TABLE_TYPE, TABLE_SCHEM, TABLE_NAME\n"; |
|
406
|
|
|
|
|
|
|
} |
|
407
|
0
|
0
|
|
|
|
0
|
my $sth = $dbh->prepare($SQL) or return undef; |
|
408
|
0
|
0
|
|
|
|
0
|
$sth->execute or return undef; |
|
409
|
0
|
|
|
|
|
0
|
$sth; |
|
410
|
|
|
|
|
|
|
} |
|
411
|
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
sub get_column_details_from_data_dictionary { |
|
413
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
|
414
|
|
|
|
|
|
|
|
|
415
|
0
|
|
|
|
|
0
|
my $version = $self->_get_oracle_major_server_version(); |
|
416
|
0
|
0
|
|
|
|
0
|
if ($version < '11') { |
|
417
|
0
|
|
|
|
|
0
|
return $self->SUPER::get_column_details_from_data_dictionary(@_); |
|
418
|
|
|
|
|
|
|
} |
|
419
|
|
|
|
|
|
|
|
|
420
|
0
|
|
|
|
|
0
|
my $dbh = $self->get_default_handle(); |
|
421
|
0
|
0
|
|
|
|
0
|
my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : { |
|
422
|
|
|
|
|
|
|
'TABLE_SCHEM' => $_[1],'TABLE_NAME' => $_[2],'COLUMN_NAME' => $_[3] }; |
|
423
|
0
|
|
|
|
|
0
|
my($typecase,$typecaseend) = ('',''); |
|
424
|
0
|
|
|
|
|
0
|
my $v = DBD::Oracle::db::ora_server_version($dbh); |
|
425
|
0
|
0
|
0
|
|
|
0
|
if (!defined($v) or $v->[0] >= 8) { |
|
426
|
0
|
|
|
|
|
0
|
$typecase = <<'SQL'; |
|
427
|
|
|
|
|
|
|
CASE WHEN tc.DATA_TYPE LIKE 'TIMESTAMP% WITH% TIME ZONE' THEN 95 |
|
428
|
|
|
|
|
|
|
WHEN tc.DATA_TYPE LIKE 'TIMESTAMP%' THEN 93 |
|
429
|
|
|
|
|
|
|
WHEN tc.DATA_TYPE LIKE 'INTERVAL DAY% TO SECOND%' THEN 110 |
|
430
|
|
|
|
|
|
|
WHEN tc.DATA_TYPE LIKE 'INTERVAL YEAR% TO MONTH' THEN 107 |
|
431
|
|
|
|
|
|
|
ELSE |
|
432
|
|
|
|
|
|
|
SQL |
|
433
|
0
|
|
|
|
|
0
|
$typecaseend = 'END'; |
|
434
|
|
|
|
|
|
|
} |
|
435
|
0
|
|
|
|
|
0
|
my $SQL = <<"SQL"; |
|
436
|
|
|
|
|
|
|
SELECT * |
|
437
|
|
|
|
|
|
|
FROM |
|
438
|
|
|
|
|
|
|
( |
|
439
|
|
|
|
|
|
|
SELECT |
|
440
|
|
|
|
|
|
|
to_char( NULL ) TABLE_CAT |
|
441
|
|
|
|
|
|
|
, tc.OWNER TABLE_SCHEM |
|
442
|
|
|
|
|
|
|
, tc.TABLE_NAME TABLE_NAME |
|
443
|
|
|
|
|
|
|
, tc.COLUMN_NAME COLUMN_NAME |
|
444
|
|
|
|
|
|
|
, $typecase decode( tc.DATA_TYPE |
|
445
|
|
|
|
|
|
|
, 'MLSLABEL' , -9106 |
|
446
|
|
|
|
|
|
|
, 'ROWID' , -9104 |
|
447
|
|
|
|
|
|
|
, 'UROWID' , -9104 |
|
448
|
|
|
|
|
|
|
, 'BFILE' , -4 -- 31? |
|
449
|
|
|
|
|
|
|
, 'LONG RAW' , -4 |
|
450
|
|
|
|
|
|
|
, 'RAW' , -3 |
|
451
|
|
|
|
|
|
|
, 'LONG' , -1 |
|
452
|
|
|
|
|
|
|
, 'UNDEFINED', 0 |
|
453
|
|
|
|
|
|
|
, 'CHAR' , 1 |
|
454
|
|
|
|
|
|
|
, 'NCHAR' , 1 |
|
455
|
|
|
|
|
|
|
, 'NUMBER' , decode( tc.DATA_SCALE, NULL, 8, 3 ) |
|
456
|
|
|
|
|
|
|
, 'FLOAT' , 8 |
|
457
|
|
|
|
|
|
|
, 'VARCHAR2' , 12 |
|
458
|
|
|
|
|
|
|
, 'NVARCHAR2', 12 |
|
459
|
|
|
|
|
|
|
, 'BLOB' , 30 |
|
460
|
|
|
|
|
|
|
, 'CLOB' , 40 |
|
461
|
|
|
|
|
|
|
, 'NCLOB' , 40 |
|
462
|
|
|
|
|
|
|
, 'DATE' , 93 |
|
463
|
|
|
|
|
|
|
, NULL |
|
464
|
|
|
|
|
|
|
) $typecaseend DATA_TYPE -- ... |
|
465
|
|
|
|
|
|
|
, tc.DATA_TYPE TYPE_NAME -- std.? |
|
466
|
|
|
|
|
|
|
, decode( tc.DATA_TYPE |
|
467
|
|
|
|
|
|
|
, 'LONG RAW' , 2147483647 |
|
468
|
|
|
|
|
|
|
, 'LONG' , 2147483647 |
|
469
|
|
|
|
|
|
|
, 'CLOB' , 2147483647 |
|
470
|
|
|
|
|
|
|
, 'NCLOB' , 2147483647 |
|
471
|
|
|
|
|
|
|
, 'BLOB' , 2147483647 |
|
472
|
|
|
|
|
|
|
, 'BFILE' , 2147483647 |
|
473
|
|
|
|
|
|
|
, 'NUMBER' , decode( tc.DATA_SCALE |
|
474
|
|
|
|
|
|
|
, NULL, 126 |
|
475
|
|
|
|
|
|
|
, nvl( tc.DATA_PRECISION, 38 ) |
|
476
|
|
|
|
|
|
|
) |
|
477
|
|
|
|
|
|
|
, 'FLOAT' , tc.DATA_PRECISION |
|
478
|
|
|
|
|
|
|
, 'DATE' , 19 |
|
479
|
|
|
|
|
|
|
, tc.DATA_LENGTH |
|
480
|
|
|
|
|
|
|
) COLUMN_SIZE |
|
481
|
|
|
|
|
|
|
, decode( tc.DATA_TYPE |
|
482
|
|
|
|
|
|
|
, 'LONG RAW' , 2147483647 |
|
483
|
|
|
|
|
|
|
, 'LONG' , 2147483647 |
|
484
|
|
|
|
|
|
|
, 'CLOB' , 2147483647 |
|
485
|
|
|
|
|
|
|
, 'NCLOB' , 2147483647 |
|
486
|
|
|
|
|
|
|
, 'BLOB' , 2147483647 |
|
487
|
|
|
|
|
|
|
, 'BFILE' , 2147483647 |
|
488
|
|
|
|
|
|
|
, 'NUMBER' , nvl( tc.DATA_PRECISION, 38 ) + 2 |
|
489
|
|
|
|
|
|
|
, 'FLOAT' , 8 -- ? |
|
490
|
|
|
|
|
|
|
, 'DATE' , 16 |
|
491
|
|
|
|
|
|
|
, tc.DATA_LENGTH |
|
492
|
|
|
|
|
|
|
) BUFFER_LENGTH |
|
493
|
|
|
|
|
|
|
, decode( tc.DATA_TYPE |
|
494
|
|
|
|
|
|
|
, 'DATE' , 0 |
|
495
|
|
|
|
|
|
|
, tc.DATA_SCALE |
|
496
|
|
|
|
|
|
|
) DECIMAL_DIGITS -- ... |
|
497
|
|
|
|
|
|
|
, decode( tc.DATA_TYPE |
|
498
|
|
|
|
|
|
|
, 'FLOAT' , 2 |
|
499
|
|
|
|
|
|
|
, 'NUMBER' , decode( tc.DATA_SCALE, NULL, 2, 10 ) |
|
500
|
|
|
|
|
|
|
, NULL |
|
501
|
|
|
|
|
|
|
) NUM_PREC_RADIX |
|
502
|
|
|
|
|
|
|
, decode( tc.NULLABLE |
|
503
|
|
|
|
|
|
|
, 'Y' , 1 |
|
504
|
|
|
|
|
|
|
, 'N' , 0 |
|
505
|
|
|
|
|
|
|
, NULL |
|
506
|
|
|
|
|
|
|
) NULLABLE |
|
507
|
|
|
|
|
|
|
, cc.COMMENTS REMARKS |
|
508
|
|
|
|
|
|
|
, tc.DATA_DEFAULT COLUMN_DEF -- Column is LONG! |
|
509
|
|
|
|
|
|
|
, decode( tc.DATA_TYPE |
|
510
|
|
|
|
|
|
|
, 'MLSLABEL' , -9106 |
|
511
|
|
|
|
|
|
|
, 'ROWID' , -9104 |
|
512
|
|
|
|
|
|
|
, 'UROWID' , -9104 |
|
513
|
|
|
|
|
|
|
, 'BFILE' , -4 -- 31? |
|
514
|
|
|
|
|
|
|
, 'LONG RAW' , -4 |
|
515
|
|
|
|
|
|
|
, 'RAW' , -3 |
|
516
|
|
|
|
|
|
|
, 'LONG' , -1 |
|
517
|
|
|
|
|
|
|
, 'UNDEFINED', 0 |
|
518
|
|
|
|
|
|
|
, 'CHAR' , 1 |
|
519
|
|
|
|
|
|
|
, 'NCHAR' , 1 |
|
520
|
|
|
|
|
|
|
, 'NUMBER' , decode( tc.DATA_SCALE, NULL, 8, 3 ) |
|
521
|
|
|
|
|
|
|
, 'FLOAT' , 8 |
|
522
|
|
|
|
|
|
|
, 'VARCHAR2' , 12 |
|
523
|
|
|
|
|
|
|
, 'NVARCHAR2', 12 |
|
524
|
|
|
|
|
|
|
, 'BLOB' , 30 |
|
525
|
|
|
|
|
|
|
, 'CLOB' , 40 |
|
526
|
|
|
|
|
|
|
, 'NCLOB' , 40 |
|
527
|
|
|
|
|
|
|
, 'DATE' , 9 -- not 93! |
|
528
|
|
|
|
|
|
|
, NULL |
|
529
|
|
|
|
|
|
|
) SQL_DATA_TYPE -- ... |
|
530
|
|
|
|
|
|
|
, decode( tc.DATA_TYPE |
|
531
|
|
|
|
|
|
|
, 'DATE' , 3 |
|
532
|
|
|
|
|
|
|
, NULL |
|
533
|
|
|
|
|
|
|
) SQL_DATETIME_SUB -- ... |
|
534
|
|
|
|
|
|
|
, to_number( NULL ) CHAR_OCTET_LENGTH -- TODO |
|
535
|
|
|
|
|
|
|
, tc.COLUMN_ID ORDINAL_POSITION |
|
536
|
|
|
|
|
|
|
, decode( tc.NULLABLE |
|
537
|
|
|
|
|
|
|
, 'Y' , 'YES' |
|
538
|
|
|
|
|
|
|
, 'N' , 'NO' |
|
539
|
|
|
|
|
|
|
, NULL |
|
540
|
|
|
|
|
|
|
) IS_NULLABLE |
|
541
|
|
|
|
|
|
|
FROM ALL_TAB_COLUMNS tc |
|
542
|
|
|
|
|
|
|
, ALL_COL_COMMENTS cc |
|
543
|
|
|
|
|
|
|
WHERE tc.OWNER = cc.OWNER |
|
544
|
|
|
|
|
|
|
AND tc.TABLE_NAME = cc.TABLE_NAME |
|
545
|
|
|
|
|
|
|
AND tc.COLUMN_NAME = cc.COLUMN_NAME |
|
546
|
|
|
|
|
|
|
) |
|
547
|
|
|
|
|
|
|
WHERE 1 = 1 |
|
548
|
|
|
|
|
|
|
SQL |
|
549
|
0
|
|
|
|
|
0
|
my @BindVals = (); |
|
550
|
0
|
|
|
|
|
0
|
while ( my ( $k, $v ) = each %$attr ) { |
|
551
|
0
|
0
|
|
|
|
0
|
if ( $v ) { |
|
552
|
0
|
|
|
|
|
0
|
$SQL .= " AND $k LIKE ? ESCAPE '\\'\n"; |
|
553
|
0
|
|
|
|
|
0
|
push @BindVals, $v; |
|
554
|
|
|
|
|
|
|
} |
|
555
|
|
|
|
|
|
|
} |
|
556
|
0
|
|
|
|
|
0
|
$SQL .= " ORDER BY TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION\n"; |
|
557
|
0
|
0
|
|
|
|
0
|
my $sth = $dbh->prepare( $SQL ) or return undef; |
|
558
|
0
|
0
|
|
|
|
0
|
$sth->execute( @BindVals ) or return undef; |
|
559
|
0
|
|
|
|
|
0
|
$sth; |
|
560
|
|
|
|
|
|
|
} |
|
561
|
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
sub get_primary_key_details_from_data_dictionary { |
|
563
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
|
564
|
|
|
|
|
|
|
|
|
565
|
0
|
|
|
|
|
0
|
my $version = $self->_get_oracle_major_server_version(); |
|
566
|
0
|
0
|
|
|
|
0
|
if ($version < '11') { |
|
567
|
0
|
|
|
|
|
0
|
return $self->SUPER::get_primary_key_details_from_data_dictionary(@_); |
|
568
|
|
|
|
|
|
|
} |
|
569
|
|
|
|
|
|
|
|
|
570
|
0
|
|
|
|
|
0
|
my $dbh = $self->get_default_handle(); |
|
571
|
0
|
|
|
|
|
0
|
my($catalog, $schema, $table) = @_; |
|
572
|
0
|
0
|
|
|
|
0
|
if (ref $catalog eq 'HASH') { |
|
573
|
0
|
|
|
|
|
0
|
($schema, $table) = @$catalog{'TABLE_SCHEM','TABLE_NAME'}; |
|
574
|
0
|
|
|
|
|
0
|
$catalog = undef; |
|
575
|
|
|
|
|
|
|
} |
|
576
|
0
|
|
|
|
|
0
|
my $SQL = <<'SQL'; |
|
577
|
|
|
|
|
|
|
SELECT * |
|
578
|
|
|
|
|
|
|
FROM |
|
579
|
|
|
|
|
|
|
( |
|
580
|
|
|
|
|
|
|
SELECT |
|
581
|
|
|
|
|
|
|
NULL TABLE_CAT |
|
582
|
|
|
|
|
|
|
, c.OWNER TABLE_SCHEM |
|
583
|
|
|
|
|
|
|
, c.TABLE_NAME TABLE_NAME |
|
584
|
|
|
|
|
|
|
, c.COLUMN_NAME COLUMN_NAME |
|
585
|
|
|
|
|
|
|
, c.POSITION KEY_SEQ |
|
586
|
|
|
|
|
|
|
, c.CONSTRAINT_NAME PK_NAME |
|
587
|
|
|
|
|
|
|
FROM ALL_CONSTRAINTS p |
|
588
|
|
|
|
|
|
|
, ALL_CONS_COLUMNS c |
|
589
|
|
|
|
|
|
|
WHERE p.OWNER = c.OWNER |
|
590
|
|
|
|
|
|
|
AND p.TABLE_NAME = c.TABLE_NAME |
|
591
|
|
|
|
|
|
|
AND p.CONSTRAINT_NAME = c.CONSTRAINT_NAME |
|
592
|
|
|
|
|
|
|
AND p.CONSTRAINT_TYPE = 'P' |
|
593
|
|
|
|
|
|
|
) |
|
594
|
|
|
|
|
|
|
WHERE TABLE_SCHEM = ? |
|
595
|
|
|
|
|
|
|
AND TABLE_NAME = ? |
|
596
|
|
|
|
|
|
|
ORDER BY TABLE_SCHEM, TABLE_NAME, KEY_SEQ |
|
597
|
|
|
|
|
|
|
SQL |
|
598
|
|
|
|
|
|
|
#warn "@_\n$Sql ($schema, $table)"; |
|
599
|
0
|
0
|
|
|
|
0
|
my $sth = $dbh->prepare($SQL) or return undef; |
|
600
|
0
|
0
|
|
|
|
0
|
$sth->execute($schema, $table) or return undef; |
|
601
|
0
|
|
|
|
|
0
|
$sth; |
|
602
|
|
|
|
|
|
|
} |
|
603
|
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
sub get_foreign_key_details_from_data_dictionary { |
|
607
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
|
608
|
|
|
|
|
|
|
|
|
609
|
0
|
|
|
|
|
0
|
my $version = $self->_get_oracle_major_server_version(); |
|
610
|
0
|
0
|
|
|
|
0
|
if ($version < '11') { |
|
611
|
0
|
|
|
|
|
0
|
return $self->SUPER::get_foreign_key_details_from_data_dictionary(@_); |
|
612
|
|
|
|
|
|
|
} |
|
613
|
|
|
|
|
|
|
|
|
614
|
0
|
|
|
|
|
0
|
my $dbh = $self->get_default_handle(); |
|
615
|
0
|
0
|
|
|
|
0
|
my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : { |
|
616
|
|
|
|
|
|
|
'UK_TABLE_SCHEM' => $_[1],'UK_TABLE_NAME ' => $_[2] |
|
617
|
|
|
|
|
|
|
,'FK_TABLE_SCHEM' => $_[4],'FK_TABLE_NAME ' => $_[5] }; |
|
618
|
0
|
|
|
|
|
0
|
my $SQL = <<'SQL'; # XXX: DEFERABILITY |
|
619
|
|
|
|
|
|
|
SELECT * |
|
620
|
|
|
|
|
|
|
FROM |
|
621
|
|
|
|
|
|
|
( |
|
622
|
|
|
|
|
|
|
SELECT |
|
623
|
|
|
|
|
|
|
to_char( NULL ) UK_TABLE_CAT |
|
624
|
|
|
|
|
|
|
, uk.OWNER UK_TABLE_SCHEM |
|
625
|
|
|
|
|
|
|
, uk.TABLE_NAME UK_TABLE_NAME |
|
626
|
|
|
|
|
|
|
, uc.COLUMN_NAME UK_COLUMN_NAME |
|
627
|
|
|
|
|
|
|
, to_char( NULL ) FK_TABLE_CAT |
|
628
|
|
|
|
|
|
|
, fk.OWNER FK_TABLE_SCHEM |
|
629
|
|
|
|
|
|
|
, fk.TABLE_NAME FK_TABLE_NAME |
|
630
|
|
|
|
|
|
|
, fc.COLUMN_NAME FK_COLUMN_NAME |
|
631
|
|
|
|
|
|
|
, uc.POSITION ORDINAL_POSITION |
|
632
|
|
|
|
|
|
|
, 3 UPDATE_RULE |
|
633
|
|
|
|
|
|
|
, decode( fk.DELETE_RULE, 'CASCADE', 0, 'RESTRICT', 1, 'SET NULL', 2, 'NO ACTION', 3, 'SET DEFAULT', 4 ) |
|
634
|
|
|
|
|
|
|
DELETE_RULE |
|
635
|
|
|
|
|
|
|
, fk.CONSTRAINT_NAME FK_NAME |
|
636
|
|
|
|
|
|
|
, uk.CONSTRAINT_NAME UK_NAME |
|
637
|
|
|
|
|
|
|
, to_char( NULL ) DEFERABILITY |
|
638
|
|
|
|
|
|
|
, decode( uk.CONSTRAINT_TYPE, 'P', 'PRIMARY', 'U', 'UNIQUE') |
|
639
|
|
|
|
|
|
|
UNIQUE_OR_PRIMARY |
|
640
|
|
|
|
|
|
|
FROM ALL_CONSTRAINTS uk |
|
641
|
|
|
|
|
|
|
, ALL_CONS_COLUMNS uc |
|
642
|
|
|
|
|
|
|
, ALL_CONSTRAINTS fk |
|
643
|
|
|
|
|
|
|
, ALL_CONS_COLUMNS fc |
|
644
|
|
|
|
|
|
|
WHERE uk.OWNER = uc.OWNER |
|
645
|
|
|
|
|
|
|
AND uk.CONSTRAINT_NAME = uc.CONSTRAINT_NAME |
|
646
|
|
|
|
|
|
|
AND fk.OWNER = fc.OWNER |
|
647
|
|
|
|
|
|
|
AND fk.CONSTRAINT_NAME = fc.CONSTRAINT_NAME |
|
648
|
|
|
|
|
|
|
AND uk.CONSTRAINT_TYPE IN ('P','U') |
|
649
|
|
|
|
|
|
|
AND fk.CONSTRAINT_TYPE = 'R' |
|
650
|
|
|
|
|
|
|
AND uk.CONSTRAINT_NAME = fk.R_CONSTRAINT_NAME |
|
651
|
|
|
|
|
|
|
AND uk.OWNER = fk.R_OWNER |
|
652
|
|
|
|
|
|
|
AND uc.POSITION = fc.POSITION |
|
653
|
|
|
|
|
|
|
) |
|
654
|
|
|
|
|
|
|
WHERE 1 = 1 |
|
655
|
|
|
|
|
|
|
SQL |
|
656
|
0
|
|
|
|
|
0
|
my @BindVals = (); |
|
657
|
0
|
|
|
|
|
0
|
while ( my ( $k, $v ) = each %$attr ) { |
|
658
|
0
|
0
|
|
|
|
0
|
if ( $v ) { |
|
659
|
0
|
|
|
|
|
0
|
$SQL .= " AND $k = ?\n"; |
|
660
|
0
|
|
|
|
|
0
|
push @BindVals, $v; |
|
661
|
|
|
|
|
|
|
} |
|
662
|
|
|
|
|
|
|
} |
|
663
|
0
|
|
|
|
|
0
|
$SQL .= " ORDER BY UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM, FK_TABLE_NAME, ORDINAL_POSITION\n"; |
|
664
|
0
|
0
|
|
|
|
0
|
my $sth = $dbh->prepare( $SQL ) or return undef; |
|
665
|
0
|
0
|
|
|
|
0
|
$sth->execute( @BindVals ) or return undef; |
|
666
|
0
|
|
|
|
|
0
|
$sth; |
|
667
|
|
|
|
|
|
|
} |
|
668
|
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
sub _get_oracle_major_server_version { |
|
671
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
672
|
|
|
|
|
|
|
|
|
673
|
0
|
0
|
|
|
|
0
|
unless (exists $self->{'__ora_major_server_version'}) { |
|
674
|
0
|
|
|
|
|
0
|
my $dbh = $self->get_default_handle(); |
|
675
|
0
|
|
|
|
|
0
|
my @data = $dbh->selectrow_arrayref('select version from v$instance'); |
|
676
|
0
|
|
|
|
|
0
|
$self->{'__ora_major_server_version'} = (split(/\./, $data[0]->[0]))[0]; |
|
677
|
|
|
|
|
|
|
} |
|
678
|
0
|
|
|
|
|
0
|
return $self->{'__ora_major_server_version'}; |
|
679
|
|
|
|
|
|
|
} |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
sub cast_for_data_conversion { |
|
682
|
23
|
|
|
23
|
0
|
36
|
my($class, $left_type, $right_type, $operator, $sql_clause) = @_; |
|
683
|
|
|
|
|
|
|
|
|
684
|
23
|
|
|
|
|
56
|
my @retval = ('%s','%s'); |
|
685
|
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
# compatible types |
|
687
|
23
|
100
|
66
|
|
|
188
|
if ($left_type->isa($right_type) |
|
688
|
|
|
|
|
|
|
or |
|
689
|
|
|
|
|
|
|
$right_type->isa($left_type) |
|
690
|
|
|
|
|
|
|
) { |
|
691
|
5
|
|
|
|
|
16
|
return @retval; |
|
692
|
|
|
|
|
|
|
} |
|
693
|
|
|
|
|
|
|
|
|
694
|
18
|
50
|
66
|
|
|
109
|
if (! $left_type->isa('UR::Value::Text') |
|
695
|
|
|
|
|
|
|
and |
|
696
|
|
|
|
|
|
|
! $right_type->isa('UR::Value::Text') |
|
697
|
|
|
|
|
|
|
) { |
|
698
|
|
|
|
|
|
|
# We only support cases where one is a string, for now |
|
699
|
|
|
|
|
|
|
# hopefully the DB can sort it out |
|
700
|
0
|
|
|
|
|
0
|
return @retval; |
|
701
|
|
|
|
|
|
|
} |
|
702
|
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
# Oracle can auto-convert strings into numbers and dates in the 'where' |
|
704
|
|
|
|
|
|
|
# clause, but has issues in joins |
|
705
|
18
|
100
|
|
|
|
34
|
if ($sql_clause eq 'where') { |
|
706
|
2
|
|
|
|
|
7
|
return @retval; |
|
707
|
|
|
|
|
|
|
} |
|
708
|
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
# Figure out which one is the non-string |
|
710
|
16
|
100
|
|
|
|
58
|
my($data_type, $i) = $left_type->isa('UR::Value::Text') |
|
711
|
|
|
|
|
|
|
? ( $right_type, 1) |
|
712
|
|
|
|
|
|
|
: ( $left_type, 0); |
|
713
|
|
|
|
|
|
|
|
|
714
|
16
|
100
|
|
|
|
65
|
if ($data_type->isa('UR::Value::Number')) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
715
|
12
|
|
|
|
|
19
|
$retval[$i] = q{to_char(%s)}; |
|
716
|
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
} elsif ($data_type->isa('UR::Value::Timestamp')) { |
|
718
|
|
|
|
|
|
|
# These time formats shoule match what's given in init_created_handle |
|
719
|
2
|
|
|
|
|
8
|
$retval[$i] = qq{to_char(%s, '$TIMESTAMP_FORMAT')}; |
|
720
|
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
} elsif ($data_type->isa('UR::Value::DateTime')) { |
|
722
|
2
|
|
|
|
|
8
|
$retval[$i] = qq{to_char(%s, '$DATE_FORMAT')}; |
|
723
|
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
} else { |
|
725
|
0
|
|
|
|
|
0
|
@retval = $class->SUPER::cast_for_data_conversion($left_type, $right_type); |
|
726
|
|
|
|
|
|
|
} |
|
727
|
|
|
|
|
|
|
|
|
728
|
16
|
|
|
|
|
47
|
return @retval; |
|
729
|
|
|
|
|
|
|
} |
|
730
|
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
sub _vendor_data_type_for_ur_data_type { |
|
732
|
0
|
|
|
0
|
|
|
return ( TEXT => 'VARCHAR2', |
|
733
|
|
|
|
|
|
|
STRING => 'VARCHAR2', |
|
734
|
|
|
|
|
|
|
BOOLEAN => 'INTEGER', |
|
735
|
|
|
|
|
|
|
__default__ => 'VARCHAR2', |
|
736
|
|
|
|
|
|
|
shift->SUPER::_vendor_data_type_for_ur_data_type(), |
|
737
|
|
|
|
|
|
|
); |
|
738
|
|
|
|
|
|
|
}; |
|
739
|
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
1; |
|
742
|
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
=pod |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=head1 NAME |
|
746
|
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
UR::DataSource::Oracle - Oracle specific subclass of UR::DataSource::RDBMS |
|
748
|
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
750
|
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
This module provides the Oracle-specific methods necessary for interacting with |
|
752
|
|
|
|
|
|
|
Oracle databases |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
L, L |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=cut |
|
759
|
|
|
|
|
|
|
|