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
|
|
|
|
|
|
|
|