line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Rose::DB::Oracle; |
2
|
|
|
|
|
|
|
|
3
|
16
|
|
|
16
|
|
118
|
use strict; |
|
16
|
|
|
|
|
37
|
|
|
16
|
|
|
|
|
494
|
|
4
|
|
|
|
|
|
|
|
5
|
16
|
|
|
16
|
|
86
|
use Carp(); |
|
16
|
|
|
|
|
38
|
|
|
16
|
|
|
|
|
222
|
|
6
|
16
|
|
|
16
|
|
7241
|
use SQL::ReservedWords::Oracle(); |
|
16
|
|
|
|
|
31626
|
|
|
16
|
|
|
|
|
439
|
|
7
|
|
|
|
|
|
|
|
8
|
16
|
|
|
16
|
|
351
|
use Rose::DB; |
|
16
|
|
|
|
|
43
|
|
|
16
|
|
|
|
|
779
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $Debug = 0; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.767'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use Rose::Class::MakeMethods::Generic |
15
|
|
|
|
|
|
|
( |
16
|
16
|
|
|
|
|
144
|
inheritable_scalar => '_default_post_connect_sql', |
17
|
16
|
|
|
16
|
|
91
|
); |
|
16
|
|
|
|
|
32
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
__PACKAGE__->_default_post_connect_sql |
20
|
|
|
|
|
|
|
( |
21
|
|
|
|
|
|
|
[ |
22
|
|
|
|
|
|
|
q(ALTER SESSION SET NLS_DATE_FORMAT = ') . |
23
|
|
|
|
|
|
|
($ENV{'NLS_DATE_FORMAT'} || 'YYYY-MM-DD HH24:MI:SS') . q('), |
24
|
|
|
|
|
|
|
q(ALTER SESSION SET NLS_TIMESTAMP_FORMAT = ') . |
25
|
|
|
|
|
|
|
($ENV{'NLS_TIMESTAMP_FORMAT'} || 'YYYY-MM-DD HH24:MI:SS.FF') . q('), |
26
|
|
|
|
|
|
|
q(ALTER SESSION SET NLS_TIMESTAMP_TZ_FORMAT = ') . |
27
|
|
|
|
|
|
|
($ENV{'NLS_TIMESTAMP_TZ_FORMAT'} || 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM') . q('), |
28
|
|
|
|
|
|
|
] |
29
|
|
|
|
|
|
|
); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub default_post_connect_sql |
32
|
|
|
|
|
|
|
{ |
33
|
10
|
|
|
10
|
1
|
31
|
my($class) = shift; |
34
|
|
|
|
|
|
|
|
35
|
10
|
50
|
|
|
|
38
|
if(@_) |
36
|
|
|
|
|
|
|
{ |
37
|
0
|
0
|
0
|
|
|
0
|
if(@_ == 1 && ref $_[0] eq 'ARRAY') |
38
|
|
|
|
|
|
|
{ |
39
|
0
|
|
|
|
|
0
|
$class->_default_post_connect_sql(@_); |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
else |
42
|
|
|
|
|
|
|
{ |
43
|
0
|
|
|
|
|
0
|
$class->_default_post_connect_sql([ @_ ]); |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
10
|
|
|
|
|
57
|
return $class->_default_post_connect_sql; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub post_connect_sql |
51
|
|
|
|
|
|
|
{ |
52
|
10
|
|
|
10
|
1
|
39
|
my($self) = shift; |
53
|
|
|
|
|
|
|
|
54
|
10
|
50
|
|
|
|
48
|
unless(@_) |
55
|
|
|
|
|
|
|
{ |
56
|
|
|
|
|
|
|
return wantarray ? |
57
|
0
|
0
|
|
|
|
0
|
( @{ $self->default_post_connect_sql || [] }, @{$self->{'post_connect_sql'} || [] } ) : |
|
0
|
0
|
|
|
|
0
|
|
58
|
0
|
0
|
|
|
|
0
|
[ @{ $self->default_post_connect_sql || [] }, @{$self->{'post_connect_sql'} || [] } ]; |
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
10
|
50
|
33
|
|
|
70
|
if(@_ == 1 && ref $_[0] eq 'ARRAY') |
62
|
|
|
|
|
|
|
{ |
63
|
10
|
|
|
|
|
30
|
$self->{'post_connect_sql'} = $_[0]; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
else |
66
|
|
|
|
|
|
|
{ |
67
|
0
|
|
|
|
|
0
|
$self->{'post_connect_sql'} = [ @_ ]; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
return wantarray ? |
71
|
0
|
0
|
|
|
|
0
|
( @{ $self->default_post_connect_sql || [] }, @{$self->{'post_connect_sql'} || [] } ) : |
|
0
|
0
|
|
|
|
0
|
|
72
|
10
|
50
|
|
|
|
33
|
[ @{ $self->default_post_connect_sql || [] }, @{$self->{'post_connect_sql'} || [] } ]; |
|
10
|
50
|
|
|
|
62
|
|
|
10
|
50
|
|
|
|
415
|
|
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub schema |
76
|
|
|
|
|
|
|
{ |
77
|
0
|
|
|
0
|
1
|
0
|
my($self) = shift; |
78
|
0
|
0
|
|
|
|
0
|
$self->{'schema'} = shift if(@_); |
79
|
0
|
|
0
|
|
|
0
|
return $self->{'schema'} || $self->username; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
0
|
0
|
0
|
sub use_auto_sequence_name { 1 } |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub auto_sequence_name |
85
|
|
|
|
|
|
|
{ |
86
|
0
|
|
|
0
|
0
|
0
|
my($self, %args) = @_; |
87
|
|
|
|
|
|
|
|
88
|
0
|
|
|
|
|
0
|
my($table) = $args{'table'}; |
89
|
0
|
0
|
|
|
|
0
|
Carp::croak 'Missing table argument' unless(defined $table); |
90
|
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
0
|
my($column) = $args{'column'}; |
92
|
0
|
0
|
|
|
|
0
|
Carp::croak 'Missing column argument' unless(defined $column); |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
|
|
|
0
|
return uc "${table}_${column}_SEQ"; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub build_dsn |
98
|
|
|
|
|
|
|
{ |
99
|
9
|
|
|
9
|
0
|
81
|
my($self_or_class, %args) = @_; |
100
|
|
|
|
|
|
|
|
101
|
9
|
|
33
|
|
|
65
|
my $database = $args{'db'} || $args{'database'}; |
102
|
|
|
|
|
|
|
|
103
|
9
|
50
|
33
|
|
|
53
|
if($args{'host'} || $args{'port'}) |
104
|
|
|
|
|
|
|
{ |
105
|
9
|
|
|
|
|
34
|
$args{'sid'} = $database; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
return 'dbi:Oracle:' . |
108
|
9
|
|
|
|
|
40
|
join(';', map { "$_=$args{$_}" } grep { $args{$_} } qw(sid host port)); |
|
18
|
|
|
|
|
112
|
|
|
27
|
|
|
|
|
79
|
|
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
0
|
return "dbi:Oracle:$database"; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
0
|
0
|
0
|
sub init_date_handler { Rose::DB::Oracle::DateHandler->new } |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub database_version |
117
|
|
|
|
|
|
|
{ |
118
|
0
|
|
|
0
|
0
|
0
|
my($self) = shift; |
119
|
|
|
|
|
|
|
|
120
|
0
|
0
|
|
|
|
0
|
return $self->{'database_version'} if (defined $self->{'database_version'}); |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
0
|
my($version) = $self->dbh->get_info(18); # SQL_DBMS_VER. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# Convert to an integer, e.g., 10.02.0100 -> 100020100 |
125
|
|
|
|
|
|
|
|
126
|
0
|
0
|
|
|
|
0
|
if($version =~ /^(\d+)\.(\d+)(?:\.(\d+))?/) |
127
|
|
|
|
|
|
|
{ |
128
|
0
|
|
|
|
|
0
|
$version = sprintf('%d%03d%04d', $1, $2, $3); |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
0
|
return $self->{'database_version'} = $version; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
10
|
|
|
10
|
0
|
43
|
sub dbi_driver { 'Oracle' } |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
0
|
0
|
|
sub likes_uppercase_table_names { 1 } |
137
|
0
|
|
|
0
|
0
|
|
sub likes_uppercase_schema_names { 1 } |
138
|
0
|
|
|
0
|
0
|
|
sub likes_uppercase_catalog_names { 1 } |
139
|
0
|
|
|
0
|
0
|
|
sub likes_uppercase_sequence_names { 1 } |
140
|
|
|
|
|
|
|
|
141
|
0
|
|
|
0
|
0
|
|
sub insertid_param { '' } |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
sub list_tables |
144
|
|
|
|
|
|
|
{ |
145
|
0
|
|
|
0
|
0
|
|
my($self, %args) = @_; |
146
|
|
|
|
|
|
|
|
147
|
0
|
0
|
|
|
|
|
my $types = $args{'include_views'} ? "'TABLE','VIEW'" : 'TABLE'; |
148
|
|
|
|
|
|
|
|
149
|
0
|
|
|
|
|
|
my($error, @tables); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
TRY: |
152
|
|
|
|
|
|
|
{ |
153
|
0
|
|
|
|
|
|
local $@; |
|
0
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
eval |
156
|
0
|
|
|
|
|
|
{ |
157
|
0
|
0
|
|
|
|
|
my($dbh) = $self->dbh or die $self->error; |
158
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
local $dbh->{'RaiseError'} = 1; |
160
|
0
|
|
|
|
|
|
local $dbh->{'FetchHashKeyName'} = 'NAME'; |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
|
my $sth = $dbh->table_info($self->catalog, uc $self->schema, '%', $types); |
163
|
0
|
|
|
|
|
|
my $info = $sth->fetchall_arrayref({}); # The {} are mandatory. |
164
|
|
|
|
|
|
|
|
165
|
0
|
|
|
|
|
|
for my $table (@$info) |
166
|
|
|
|
|
|
|
{ |
167
|
0
|
0
|
|
|
|
|
push @tables, $$table{'TABLE_NAME'} if ($$table{'TABLE_NAME'} !~ /^BIN\$.+\$.+/); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
}; |
170
|
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
|
$error = $@; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
0
|
0
|
|
|
|
|
if($error) |
175
|
|
|
|
|
|
|
{ |
176
|
0
|
|
|
|
|
|
Carp::croak 'Could not list tables from ', $self->dsn, " - $error"; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
0
|
0
|
|
|
|
|
return wantarray ? @tables : \@tables; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub next_value_in_sequence |
183
|
|
|
|
|
|
|
{ |
184
|
0
|
|
|
0
|
0
|
|
my($self, $sequence_name) = @_; |
185
|
|
|
|
|
|
|
|
186
|
0
|
0
|
|
|
|
|
my $dbh = $self->dbh or return undef; |
187
|
|
|
|
|
|
|
|
188
|
0
|
|
|
|
|
|
my($error, $value); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
TRY: |
191
|
|
|
|
|
|
|
{ |
192
|
0
|
|
|
|
|
|
local $@; |
|
0
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
eval |
195
|
0
|
|
|
|
|
|
{ |
196
|
0
|
|
|
|
|
|
local $dbh->{'PrintError'} = 0; |
197
|
0
|
|
|
|
|
|
local $dbh->{'RaiseError'} = 1; |
198
|
0
|
|
|
|
|
|
my $sth = $dbh->prepare("SELECT $sequence_name.NEXTVAL FROM DUAL"); |
199
|
0
|
|
|
|
|
|
$sth->execute; |
200
|
0
|
|
|
|
|
|
$value = ${$sth->fetch}[0]; |
|
0
|
|
|
|
|
|
|
201
|
0
|
|
|
|
|
|
$sth->finish; |
202
|
|
|
|
|
|
|
}; |
203
|
|
|
|
|
|
|
|
204
|
0
|
|
|
|
|
|
$error = $@; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
0
|
0
|
|
|
|
|
if($error) |
208
|
|
|
|
|
|
|
{ |
209
|
0
|
|
|
|
|
|
$self->error("Could not get the next value in the sequence $sequence_name - $error"); |
210
|
0
|
|
|
|
|
|
return undef; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
|
return $value; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# Tried to execute a CURRVAL command on a sequence before the |
217
|
|
|
|
|
|
|
# NEXTVAL command was executed at least once. |
218
|
16
|
|
|
16
|
|
23284
|
use constant ORA_08002 => 8002; |
|
16
|
|
|
|
|
207
|
|
|
16
|
|
|
|
|
4386
|
|
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub current_value_in_sequence |
221
|
|
|
|
|
|
|
{ |
222
|
0
|
|
|
0
|
0
|
|
my($self, $sequence_name) = @_; |
223
|
|
|
|
|
|
|
|
224
|
0
|
0
|
|
|
|
|
my $dbh = $self->dbh or return undef; |
225
|
|
|
|
|
|
|
|
226
|
0
|
|
|
|
|
|
my($error, $value); |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
TRY: |
229
|
|
|
|
|
|
|
{ |
230
|
0
|
|
|
|
|
|
local $@; |
|
0
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
eval |
233
|
0
|
|
|
|
|
|
{ |
234
|
0
|
|
|
|
|
|
local $dbh->{'PrintError'} = 0; |
235
|
0
|
|
|
|
|
|
local $dbh->{'RaiseError'} = 1; |
236
|
0
|
|
|
|
|
|
my $sth = $dbh->prepare("SELECT $sequence_name.CURRVAL FROM DUAL"); |
237
|
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
$sth->execute; |
239
|
|
|
|
|
|
|
|
240
|
0
|
|
|
|
|
|
$value = ${$sth->fetch}[0]; |
|
0
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
|
$sth->finish; |
243
|
|
|
|
|
|
|
}; |
244
|
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
|
$error = $@; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
0
|
0
|
|
|
|
|
if($error) |
249
|
|
|
|
|
|
|
{ |
250
|
0
|
0
|
|
|
|
|
if(DBI->err == ORA_08002) |
251
|
|
|
|
|
|
|
{ |
252
|
0
|
0
|
|
|
|
|
if(defined $self->next_value_in_sequence($sequence_name)) |
253
|
|
|
|
|
|
|
{ |
254
|
0
|
|
|
|
|
|
return $self->current_value_in_sequence($sequence_name); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
$self->error("Could not get the current value in the sequence $sequence_name - $error"); |
259
|
0
|
|
|
|
|
|
return undef; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
0
|
|
|
|
|
|
return $value; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# Sequence does not exist, or the user does not have the required |
266
|
|
|
|
|
|
|
# privilege to perform this operation. |
267
|
16
|
|
|
16
|
|
129
|
use constant ORA_02289 => 2289; |
|
16
|
|
|
|
|
41
|
|
|
16
|
|
|
|
|
9939
|
|
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
sub sequence_exists |
270
|
|
|
|
|
|
|
{ |
271
|
0
|
|
|
0
|
0
|
|
my($self, $sequence_name) = @_; |
272
|
|
|
|
|
|
|
|
273
|
0
|
0
|
|
|
|
|
my $dbh = $self->dbh or return undef; |
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
my $error; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
TRY: |
278
|
|
|
|
|
|
|
{ |
279
|
0
|
|
|
|
|
|
local $@; |
|
0
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
eval |
282
|
0
|
|
|
|
|
|
{ |
283
|
0
|
|
|
|
|
|
local $dbh->{'PrintError'} = 0; |
284
|
0
|
|
|
|
|
|
local $dbh->{'RaiseError'} = 1; |
285
|
0
|
|
|
|
|
|
my $sth = $dbh->prepare("SELECT $sequence_name.CURRVAL FROM DUAL"); |
286
|
0
|
|
|
|
|
|
$sth->execute; |
287
|
0
|
|
|
|
|
|
$sth->fetch; |
288
|
0
|
|
|
|
|
|
$sth->finish; |
289
|
|
|
|
|
|
|
}; |
290
|
|
|
|
|
|
|
|
291
|
0
|
|
|
|
|
|
$error = $@; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
0
|
0
|
|
|
|
|
if($error) |
295
|
|
|
|
|
|
|
{ |
296
|
0
|
|
|
|
|
|
my $dbi_error = DBI->err; |
297
|
|
|
|
|
|
|
|
298
|
0
|
0
|
|
|
|
|
if($dbi_error == ORA_08002) |
|
|
0
|
|
|
|
|
|
299
|
|
|
|
|
|
|
{ |
300
|
0
|
0
|
|
|
|
|
if(defined $self->next_value_in_sequence($sequence_name)) |
301
|
|
|
|
|
|
|
{ |
302
|
0
|
|
|
|
|
|
return $self->sequence_exists($sequence_name); |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
elsif($dbi_error == ORA_02289) |
306
|
|
|
|
|
|
|
{ |
307
|
0
|
|
|
|
|
|
return 0; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
0
|
|
|
|
|
|
$self->error("Could not check if sequence $sequence_name exists - $error"); |
311
|
0
|
|
|
|
|
|
return undef; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
0
|
|
|
|
|
|
return 1; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub parse_dbi_column_info_default |
318
|
|
|
|
|
|
|
{ |
319
|
0
|
|
|
0
|
0
|
|
my($self, $default, $col_info) = @_; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# For some reason, given a default value like this: |
322
|
|
|
|
|
|
|
# |
323
|
|
|
|
|
|
|
# MYCOLUMN VARCHAR(128) DEFAULT 'foo' NOT NULL |
324
|
|
|
|
|
|
|
# |
325
|
|
|
|
|
|
|
# DBD::Oracle hands back a COLUMN_DEF value of: |
326
|
|
|
|
|
|
|
# |
327
|
|
|
|
|
|
|
# $col_info->{'COLUMN_DEF'} = "'foo' "; # WTF? |
328
|
|
|
|
|
|
|
# |
329
|
|
|
|
|
|
|
# I have no idea why. Anyway, we just want the value beteen the quotes. |
330
|
|
|
|
|
|
|
|
331
|
0
|
0
|
|
|
|
|
return undef unless (defined $default); |
332
|
|
|
|
|
|
|
|
333
|
0
|
|
|
|
|
|
$default =~ s/^\s*'(.+)'\s*$/$1/; |
334
|
|
|
|
|
|
|
|
335
|
0
|
|
|
|
|
|
return $default; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
*is_reserved_word = \&SQL::ReservedWords::Oracle::is_reserved; |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
sub quote_identifier_for_sequence |
341
|
|
|
|
|
|
|
{ |
342
|
0
|
|
|
0
|
0
|
|
my($self, $catalog, $schema, $table) = @_; |
343
|
0
|
|
|
|
|
|
return join('.', map { uc } grep { defined } ($schema, $table)); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# sub auto_quote_column_name |
347
|
|
|
|
|
|
|
# { |
348
|
|
|
|
|
|
|
# my($self, $name) = @_; |
349
|
|
|
|
|
|
|
# |
350
|
|
|
|
|
|
|
# if($name =~ /[^\w#]/ || $self->is_reserved_word($name)) |
351
|
|
|
|
|
|
|
# { |
352
|
|
|
|
|
|
|
# return $self->quote_column_name($name, @_); |
353
|
|
|
|
|
|
|
# } |
354
|
|
|
|
|
|
|
# |
355
|
|
|
|
|
|
|
# return $name; |
356
|
|
|
|
|
|
|
# } |
357
|
|
|
|
|
|
|
|
358
|
0
|
|
|
0
|
0
|
|
sub supports_schema { 1 } |
359
|
|
|
|
|
|
|
|
360
|
0
|
|
|
0
|
0
|
|
sub max_column_name_length { 30 } |
361
|
0
|
|
|
0
|
0
|
|
sub max_column_alias_length { 30 } |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
sub quote_column_name |
364
|
|
|
|
|
|
|
{ |
365
|
0
|
|
|
0
|
0
|
|
my $name = uc $_[1]; |
366
|
0
|
|
|
|
|
|
$name =~ s/"/""/g; |
367
|
0
|
|
|
|
|
|
return qq("$name"); |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub quote_table_name |
371
|
|
|
|
|
|
|
{ |
372
|
0
|
|
|
0
|
0
|
|
my $name = uc $_[1]; |
373
|
0
|
|
|
|
|
|
$name =~ s/"/""/g; |
374
|
0
|
|
|
|
|
|
return qq("$name"); |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub quote_identifier { |
378
|
0
|
|
|
0
|
0
|
|
my($self) = shift; |
379
|
0
|
|
|
|
|
|
my $method = ref($self)->parent_class . '::quote_identifier'; |
380
|
16
|
|
|
16
|
|
150
|
no strict 'refs'; |
|
16
|
|
|
|
|
42
|
|
|
16
|
|
|
|
|
2436
|
|
381
|
0
|
|
|
|
|
|
return uc $self->$method(@_); |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub primary_key_column_names |
385
|
|
|
|
|
|
|
{ |
386
|
0
|
|
|
0
|
0
|
|
my($self) = shift; |
387
|
|
|
|
|
|
|
|
388
|
0
|
0
|
|
|
|
|
my %args = @_ == 1 ? (table => @_) : @_; |
389
|
|
|
|
|
|
|
|
390
|
0
|
0
|
|
|
|
|
my $table = $args{'table'} or Carp::croak "Missing table name parameter"; |
391
|
0
|
|
0
|
|
|
|
my $schema = $args{'schema'} || $self->schema; |
392
|
0
|
|
0
|
|
|
|
my $catalog = $args{'catalog'} || $self->catalog; |
393
|
|
|
|
|
|
|
|
394
|
16
|
|
|
16
|
|
118
|
no warnings 'uninitialized'; |
|
16
|
|
|
|
|
41
|
|
|
16
|
|
|
|
|
2202
|
|
395
|
0
|
|
|
|
|
|
$table = uc $table; |
396
|
0
|
|
|
|
|
|
$schema = uc $schema; |
397
|
0
|
|
|
|
|
|
$catalog = uc $catalog; |
398
|
|
|
|
|
|
|
|
399
|
0
|
|
|
|
|
|
my $table_unquoted = $self->unquote_table_name($table); |
400
|
|
|
|
|
|
|
|
401
|
0
|
|
|
|
|
|
my($error, $columns); |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
TRY: |
404
|
|
|
|
|
|
|
{ |
405
|
0
|
|
|
|
|
|
local $@; |
|
0
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
eval |
408
|
0
|
|
|
|
|
|
{ |
409
|
0
|
|
|
|
|
|
$columns = |
410
|
|
|
|
|
|
|
$self->_get_primary_key_column_names($catalog, $schema, $table_unquoted); |
411
|
|
|
|
|
|
|
}; |
412
|
|
|
|
|
|
|
|
413
|
0
|
|
|
|
|
|
$error = $@; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
0
|
0
|
0
|
|
|
|
if($error || !$columns) |
417
|
|
|
|
|
|
|
{ |
418
|
16
|
|
|
16
|
|
115
|
no warnings 'uninitialized'; # undef strings okay |
|
16
|
|
|
|
|
45
|
|
|
16
|
|
|
|
|
11341
|
|
419
|
0
|
0
|
|
|
|
|
$error = 'no primary key columns found' unless(defined $error); |
420
|
0
|
|
|
|
|
|
Carp::croak "Could not get primary key columns for catalog '" . |
421
|
|
|
|
|
|
|
$catalog . "' schema '" . $schema . "' table '" . |
422
|
|
|
|
|
|
|
$table_unquoted . "' - " . $error; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
0
|
0
|
|
|
|
|
return wantarray ? @$columns : $columns; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub format_limit_with_offset |
429
|
|
|
|
|
|
|
{ |
430
|
0
|
|
|
0
|
0
|
|
my($self, $limit, $offset, $args) = @_; |
431
|
|
|
|
|
|
|
|
432
|
0
|
|
|
|
|
|
delete $args->{'limit'}; |
433
|
0
|
|
|
|
|
|
delete $args->{'offset'}; |
434
|
|
|
|
|
|
|
|
435
|
0
|
0
|
|
|
|
|
if($offset) |
436
|
|
|
|
|
|
|
{ |
437
|
|
|
|
|
|
|
# http://www.oracle.com/technology/oramag/oracle/06-sep/o56asktom.html |
438
|
|
|
|
|
|
|
# select * |
439
|
|
|
|
|
|
|
# from ( select /*+ FIRST_ROWS(n) */ |
440
|
|
|
|
|
|
|
# a.*, ROWNUM rnum |
441
|
|
|
|
|
|
|
# from ( your_query_goes_here, |
442
|
|
|
|
|
|
|
# with order by ) a |
443
|
|
|
|
|
|
|
# where ROWNUM <= |
444
|
|
|
|
|
|
|
# :MAX_ROW_TO_FETCH ) |
445
|
|
|
|
|
|
|
# where rnum >= :MIN_ROW_TO_FETCH; |
446
|
|
|
|
|
|
|
|
447
|
0
|
|
|
|
|
|
my $size = $limit; |
448
|
0
|
|
|
|
|
|
my $start = $offset + 1; |
449
|
0
|
|
|
|
|
|
my $end = $start + $size - 1; |
450
|
0
|
|
|
|
|
|
my $n = $offset + $limit; |
451
|
|
|
|
|
|
|
|
452
|
0
|
|
|
|
|
|
$args->{'limit_prefix'} = |
453
|
|
|
|
|
|
|
"SELECT * FROM (SELECT /*+ FIRST_ROWS($n) */\na.*, ROWNUM oracle_rownum FROM ("; |
454
|
|
|
|
|
|
|
#"SELECT * FROM (SELECT a.*, ROWNUM oracle_rownum FROM ("; |
455
|
|
|
|
|
|
|
|
456
|
0
|
|
|
|
|
|
$args->{'limit_suffix'} = |
457
|
|
|
|
|
|
|
") a WHERE ROWNUM <= $end) WHERE oracle_rownum >= $start"; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
else |
460
|
|
|
|
|
|
|
{ |
461
|
0
|
|
|
|
|
|
$args->{'limit_prefix'} = "SELECT /*+ FIRST_ROWS($limit) */ a.* FROM ("; |
462
|
|
|
|
|
|
|
#$args->{'limit_prefix'} = "SELECT a.* FROM ("; |
463
|
0
|
|
|
|
|
|
$args->{'limit_suffix'} = ") a WHERE ROWNUM <= $limit"; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
sub format_select_lock |
468
|
|
|
|
|
|
|
{ |
469
|
0
|
|
|
0
|
0
|
|
my($self, $class, $lock, $tables) = @_; |
470
|
|
|
|
|
|
|
|
471
|
0
|
0
|
|
|
|
|
$lock = { type => $lock } unless(ref $lock); |
472
|
|
|
|
|
|
|
|
473
|
0
|
0
|
0
|
|
|
|
$lock->{'type'} ||= 'for update' if($lock->{'for_update'}); |
474
|
|
|
|
|
|
|
|
475
|
0
|
0
|
|
|
|
|
unless($lock->{'type'} eq 'for update') |
476
|
|
|
|
|
|
|
{ |
477
|
0
|
|
|
|
|
|
Carp::croak "Invalid lock type: $lock->{'type'}"; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
0
|
|
|
|
|
|
my $sql = 'FOR UPDATE'; |
481
|
|
|
|
|
|
|
|
482
|
0
|
|
|
|
|
|
my @columns; |
483
|
|
|
|
|
|
|
|
484
|
0
|
0
|
|
|
|
|
if(my $on = $lock->{'on'}) |
|
|
0
|
|
|
|
|
|
485
|
|
|
|
|
|
|
{ |
486
|
0
|
|
|
|
|
|
@columns = map { $self->column_sql_from_lock_on_value($class, $_, $tables) } @$on; |
|
0
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
elsif(my $columns = $lock->{'columns'}) |
489
|
|
|
|
|
|
|
{ |
490
|
0
|
|
|
|
|
|
my %map; |
491
|
|
|
|
|
|
|
|
492
|
0
|
0
|
|
|
|
|
if($tables) |
493
|
|
|
|
|
|
|
{ |
494
|
0
|
|
|
|
|
|
my $tn = 1; |
495
|
|
|
|
|
|
|
|
496
|
0
|
|
|
|
|
|
foreach my $table (@$tables) |
497
|
|
|
|
|
|
|
{ |
498
|
0
|
|
|
|
|
|
(my $table_key = $table) =~ s/^(["']?)[^.]+\1\.//; |
499
|
0
|
|
|
|
|
|
$map{$table_key} = 't' . $tn++; |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
@columns = map |
504
|
|
|
|
|
|
|
{ |
505
|
0
|
|
|
|
|
|
ref $_ eq 'SCALAR' ? $$_ : |
506
|
|
|
|
|
|
|
/^([^.]+)\.([^.]+)$/ ? |
507
|
0
|
0
|
|
|
|
|
$self->auto_quote_column_with_table($2, defined $map{$1} ? $map{$1} : $1) : |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
508
|
|
|
|
|
|
|
$self->auto_quote_column_name($_) |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
@$columns; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
0
|
0
|
|
|
|
|
if(@columns) |
514
|
|
|
|
|
|
|
{ |
515
|
0
|
|
|
|
|
|
$sql .= ' OF ' . join(', ', @columns); |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
|
518
|
0
|
0
|
|
|
|
|
if($lock->{'nowait'}) |
|
|
0
|
|
|
|
|
|
519
|
|
|
|
|
|
|
{ |
520
|
0
|
|
|
|
|
|
$sql .= ' NOWAIT'; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
elsif(my $wait = $lock->{'wait'}) |
523
|
|
|
|
|
|
|
{ |
524
|
0
|
|
|
|
|
|
$sql .= " WAIT $wait"; |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
0
|
0
|
|
|
|
|
if($lock->{'skip_locked'}) |
528
|
|
|
|
|
|
|
{ |
529
|
0
|
|
|
|
|
|
$sql .= ' SKIP LOCKED'; |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
|
532
|
0
|
|
|
|
|
|
return $sql; |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
0
|
0
|
|
0
|
0
|
|
sub format_boolean { $_[1] ? 't' : 'f' } |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
# |
538
|
|
|
|
|
|
|
# Date/time keywords and inlining |
539
|
|
|
|
|
|
|
# |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
sub validate_date_keyword |
542
|
|
|
|
|
|
|
{ |
543
|
16
|
|
|
16
|
|
138
|
no warnings; |
|
16
|
|
|
|
|
33
|
|
|
16
|
|
|
|
|
4401
|
|
544
|
0
|
0
|
0
|
0
|
1
|
|
$_[1] =~ /^(?:CURRENT_|SYS|LOCAL)(?:TIMESTAMP|DATE)$/i || |
545
|
|
|
|
|
|
|
($_[0]->keyword_function_calls && $_[1] =~ /^\w+\(.*\)$/); |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
*validate_time_keyword = \&validate_date_keyword; |
549
|
|
|
|
|
|
|
*validate_timestamp_keyword = \&validate_date_keyword; |
550
|
|
|
|
|
|
|
*validate_datetime_keyword = \&validate_date_keyword; |
551
|
|
|
|
|
|
|
|
552
|
0
|
|
|
0
|
0
|
|
sub should_inline_date_keyword { 1 } |
553
|
0
|
|
|
0
|
0
|
|
sub should_inline_datetime_keyword { 1 } |
554
|
0
|
|
|
0
|
0
|
|
sub should_inline_time_keyword { 1 } |
555
|
0
|
|
|
0
|
0
|
|
sub should_inline_timestamp_keyword { 1 } |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
package Rose::DB::Oracle::DateHandler; |
558
|
|
|
|
|
|
|
|
559
|
16
|
|
|
16
|
|
127
|
use Rose::Object; |
|
16
|
|
|
|
|
43
|
|
|
16
|
|
|
|
|
1056
|
|
560
|
|
|
|
|
|
|
our @ISA = qw(Rose::Object); |
561
|
|
|
|
|
|
|
|
562
|
16
|
|
|
16
|
|
8574
|
use DateTime::Format::Oracle; |
|
16
|
|
|
|
|
43947
|
|
|
16
|
|
|
|
|
11260
|
|
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
sub parse_date |
565
|
|
|
|
|
|
|
{ |
566
|
0
|
|
|
0
|
|
|
my($self, $value) = @_; |
567
|
|
|
|
|
|
|
|
568
|
0
|
|
0
|
|
|
|
local $DateTime::Format::Oracle::nls_date_format = $ENV{'NLS_DATE_FORMAT'} || 'YYYY-MM-DD HH24:MI:SS'; |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
# Add or extend the time to appease DateTime::Format::Oracle |
571
|
0
|
0
|
|
|
|
|
if($value =~ /\d\d:/) |
572
|
|
|
|
|
|
|
{ |
573
|
0
|
|
|
|
|
|
$value =~ s/( \d\d:\d\d)([^:]|$)/$1:00$2/; |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
else |
576
|
|
|
|
|
|
|
{ |
577
|
0
|
|
|
|
|
|
$value .= ' 00:00:00'; |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
|
580
|
0
|
|
|
|
|
|
return DateTime::Format::Oracle->parse_date($value); |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
*parse_datetime = \&parse_date; |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
sub parse_timestamp |
586
|
|
|
|
|
|
|
{ |
587
|
0
|
|
|
0
|
|
|
my($self, $value) = @_; |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
local $DateTime::Format::Oracle::nls_timestamp_format = |
590
|
0
|
|
0
|
|
|
|
$ENV{'NLS_TIMESTAMP_FORMAT'} || 'YYYY-MM-DD HH24:MI:SS.FF'; |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# Add, extend, or truncate fractional seconds to appease DateTime::Format::Oracle |
593
|
0
|
|
|
|
|
|
for($value) |
594
|
|
|
|
|
|
|
{ |
595
|
0
|
0
|
0
|
|
|
|
s/( \d\d:\d\d:\d\d)(?!\.)/$1.000000/ || |
596
|
0
|
|
|
|
|
|
s/( \d\d:\d\d:\d\d\.)(\d{1,5})(\D|$)/ "$1$2" . ('0' x (6 - length($2))) . $3/e || |
597
|
|
|
|
|
|
|
s/( \d\d:\d\d:\d\d\.\d{6})\d+/$1/; |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
|
600
|
0
|
|
|
|
|
|
return DateTime::Format::Oracle->parse_timestamp($value); |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
sub parse_timestamp_with_time_zone |
604
|
|
|
|
|
|
|
{ |
605
|
0
|
|
|
0
|
|
|
my($self, $value) = @_; |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
local $DateTime::Format::Oracle::nls_timestamp_tz_format = |
608
|
0
|
|
0
|
|
|
|
$ENV{'NLS_TIMESTAMP_TZ_FORMAT'} || 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM'; |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
# Add, extend, or truncate fractional seconds to appease DateTime::Format::Oracle |
611
|
0
|
|
|
|
|
|
for($value) |
612
|
|
|
|
|
|
|
{ |
613
|
0
|
0
|
0
|
|
|
|
s/( \d\d:\d\d:\d\d)(?!\.)/$1.000000/ || |
614
|
0
|
|
|
|
|
|
s/( \d\d:\d\d:\d\d\.)(\d{1,5})(\D|$)/ "$1$2" . ('0' x (6 - length($2))) . $3/e || |
615
|
|
|
|
|
|
|
s/( \d\d:\d\d:\d\d\.\d{6})\d+/$1/; |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
|
618
|
0
|
|
|
|
|
|
return DateTime::Format::Oracle->parse_timestamp_with_time_zone($value); |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
sub format_date |
622
|
|
|
|
|
|
|
{ |
623
|
0
|
|
|
0
|
|
|
my($self) = shift; |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
local $DateTime::Format::Oracle::nls_date_format = |
626
|
0
|
|
0
|
|
|
|
$ENV{'NLS_DATE_FORMAT'} || 'YYYY-MM-DD HH24:MI:SS'; |
627
|
|
|
|
|
|
|
|
628
|
0
|
|
|
|
|
|
return DateTime::Format::Oracle->format_date(@_); |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
*format_datetime = \&format_date; |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
sub format_timestamp |
634
|
|
|
|
|
|
|
{ |
635
|
0
|
|
|
0
|
|
|
my($self) = shift; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
local $DateTime::Format::Oracle::nls_timestamp_format = |
638
|
0
|
|
0
|
|
|
|
$ENV{'NLS_TIMESTAMP_FORMAT'} || 'YYYY-MM-DD HH24:MI:SS.FF'; |
639
|
|
|
|
|
|
|
|
640
|
0
|
|
|
|
|
|
return DateTime::Format::Oracle->format_timestamp(@_); |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
sub format_timestamp_with_time_zone |
644
|
|
|
|
|
|
|
{ |
645
|
0
|
|
|
0
|
|
|
my($self) = shift; |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
local $DateTime::Format::Oracle::nls_timestamp_tz_format = |
648
|
0
|
|
0
|
|
|
|
$ENV{'NLS_TIMESTAMP_TZ_FORMAT'} || 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM'; |
649
|
|
|
|
|
|
|
|
650
|
0
|
|
|
|
|
|
return DateTime::Format::Oracle->format_timestamp_with_time_zone(@_); |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
1; |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
__END__ |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
=head1 NAME |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
Rose::DB::Oracle - Oracle driver class for Rose::DB. |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
=head1 SYNOPSIS |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
use Rose::DB; |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
Rose::DB->register_db |
666
|
|
|
|
|
|
|
( |
667
|
|
|
|
|
|
|
domain => 'development', |
668
|
|
|
|
|
|
|
type => 'main', |
669
|
|
|
|
|
|
|
driver => 'Oracle', |
670
|
|
|
|
|
|
|
database => 'dev_db', |
671
|
|
|
|
|
|
|
host => 'localhost', |
672
|
|
|
|
|
|
|
username => 'devuser', |
673
|
|
|
|
|
|
|
password => 'mysecret', |
674
|
|
|
|
|
|
|
); |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
Rose::DB->default_domain('development'); |
677
|
|
|
|
|
|
|
Rose::DB->default_type('main'); |
678
|
|
|
|
|
|
|
... |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
$db = Rose::DB->new; # $db is really a Rose::DB::Oracle-derived object |
681
|
|
|
|
|
|
|
... |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
=head1 DESCRIPTION |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
L<Rose::DB> blesses objects into a class derived from L<Rose::DB::Oracle> when the L<driver|Rose::DB/driver> is "oracle". This mapping of driver names to class names is configurable. See the documentation for L<Rose::DB>'s L<new()|Rose::DB/new> and L<driver_class()|Rose::DB/driver_class> methods for more information. |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
This class cannot be used directly. You must use L<Rose::DB> and let its L<new()|Rose::DB/new> method return an object blessed into the appropriate class for you, according to its L<driver_class()|Rose::DB/driver_class> mappings. |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
Only the methods that are new or have different behaviors than those in L<Rose::DB> are documented here. See the L<Rose::DB> documentation for the full list of methods. |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
B<Oracle 9 or later is required.> |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
B<Note:> This class is a work in progress. Support for Oracle databases is not yet complete. If you would like to help, please contact John Siracusa at siracusa@gmail.com or post to the L<mailing list|Rose::DB/SUPPORT>. |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
=head1 CLASS METHODS |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=over 4 |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=item B<default_post_connect_sql [STATEMENTS]> |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
Get or set the default list of SQL statements that will be run immediately after connecting to the database. STATEMENTS should be a list or reference to an array of SQL statements. Returns a reference to the array of SQL statements in scalar context, or a list of SQL statements in list context. |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
The L<default_post_connect_sql|/default_post_connect_sql> statements will be run before any statements set using the L<post_connect_sql|/post_connect_sql> method. The default list contains the following: |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS' |
706
|
|
|
|
|
|
|
ALTER SESSION SET NLS_TIMESTAMP_FORMAT = 'YYYY-MM-DD HH24:MI:SS.FF' |
707
|
|
|
|
|
|
|
ALTER SESSION SET NLS_TIMESTAMP_TZ_FORMAT = 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM' |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
If one or more C<NLS_*_FORMAT> environment variables are set, the format strings above are replaced by the values that these environment variables have I<at the time this module is loaded>. |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
=back |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=head1 OBJECT METHODS |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=over 4 |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=item B<post_connect_sql [STATEMENTS]> |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
Get or set the SQL statements that will be run immediately after connecting to the database. STATEMENTS should be a list or reference to an array of SQL statements. Returns a reference to an array (in scalar) or a list of the L<default_post_connect_sql|/default_post_connect_sql> statements and the L<post_connect_sql|/post_connect_sql> statements. Example: |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
$db->post_connect_sql('UPDATE mytable SET num = num + 1'); |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
print join("\n", $db->post_connect_sql); |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
ALTER SESSION SET NLS_DATE_FORMAT='YYYY-MM-DD HH24:MI:SS' |
726
|
|
|
|
|
|
|
ALTER SESSION SET NLS_TIMESTAMP_FORMAT='YYYY-MM-DD HH24:MI:SSxFF' |
727
|
|
|
|
|
|
|
UPDATE mytable SET num = num + 1 |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=item B<schema [SCHEMA]> |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
Get or set the database schema name. In Oracle, every user has a corresponding schema. The schema is comprised of all objects that user owns, and has the same name as that user. Therefore, this attribute defaults to the L<username|Rose::DB/username> if it is not set explicitly. |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=back |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=head2 Value Parsing and Formatting |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=over 4 |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=item B<validate_date_keyword STRING> |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
Returns true if STRING is a valid keyword for the PostgreSQL "date" data type. Valid (case-insensitive) date keywords are: |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
current_date |
744
|
|
|
|
|
|
|
current_timestamp |
745
|
|
|
|
|
|
|
localtimestamp |
746
|
|
|
|
|
|
|
months_between |
747
|
|
|
|
|
|
|
sysdate |
748
|
|
|
|
|
|
|
systimestamp |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
The keywords are case sensitive. Any string that looks like a function call (matches C</^\w+\(.*\)$/>) is also considered a valid date keyword if L<keyword_function_calls|Rose::DB/keyword_function_calls> is true. |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=item B<validate_timestamp_keyword STRING> |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
Returns true if STRING is a valid keyword for the Oracle "timestamp" data type, false otherwise. Valid timestamp keywords are: |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
current_date |
757
|
|
|
|
|
|
|
current_timestamp |
758
|
|
|
|
|
|
|
localtimestamp |
759
|
|
|
|
|
|
|
months_between |
760
|
|
|
|
|
|
|
sysdate |
761
|
|
|
|
|
|
|
systimestamp |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
The keywords are case sensitive. Any string that looks like a function call (matches C</^\w+\(.*\)$/>) is also considered a valid timestamp keyword if L<keyword_function_calls|Rose::DB/keyword_function_calls> is true. |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=back |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=head1 AUTHORS |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
John C. Siracusa (siracusa@gmail.com), Ron Savage (ron@savage.net.au) |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
=head1 LICENSE |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
Copyright (c) 2008 by John Siracusa and Ron Savage. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |