forked from sixapart/data-objectdriver
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathOracle.pm
More file actions
164 lines (132 loc) · 3.91 KB
/
Oracle.pm
File metadata and controls
164 lines (132 loc) · 3.91 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
# $Id$
# Contributor(s): Xiaoou Wu <xiaoou.wu@oracle.com>
#
package Data::ObjectDriver::Driver::DBD::Oracle;
use strict;
use base qw( Data::ObjectDriver::Driver::DBD );
use Data::ObjectDriver::SQL::Oracle;
use Data::ObjectDriver::Errors;
use DBD::Oracle qw(:ora_types);
sub init_dbh {
my $dbd = shift;
my ($dbh) = @_;
$dbh->{LongReadLen} = 1024000;
$dbh->{FetchHashKeyName} = 'NAME_lc';
return bless $dbh, 'Data::ObjectDriver::Driver::DBD::Oracle::db';
}
sub bind_param_attributes {
my ($dbd, $data_type) = @_;
if ($data_type && $data_type eq 'blob') {
return { ora_type => ORA_BLOB };
}
return;
}
sub map_error_code {
my $dbd = shift;
my($code, $msg) = @_;
if ($msg && $msg =~ /ORA-00001/i) {
return Data::ObjectDriver::Errors->UNIQUE_CONSTRAINT;
} else {
return;
}
}
## Oracle doesn't support auto-increment, it needs a SEQUENCE to emulate
## this feature. For usage, please see NOTES.
sub fetch_id {
my $dbd = shift;
my ($class, $dbh, $sth, $driver) = @_;
my $seq = $dbd->sequence_name($class, $driver);
my ($last_insert_id) = $dbh->selectrow_array("SELECT $seq.CURRVAL "
. " FROM DUAL");
return $last_insert_id;
}
sub sequence_name {
my $dbd = shift;
my ($class, $driver) = @_;
my $datasource = $class ->datasource;
my $prefix = $driver->prefix;
$datasource = join('', $prefix, $datasource) if $prefix;
join '_', $datasource,
$dbd->db_column_name(
$class->datasource,
$class->properties->{primary_key},
),
'seq';
}
sub bulk_insert {
my $dbd = shift;
my $dbh = shift;
my $table = shift;
my $cols = shift;
my $rows_ref = shift;
my $attrs = shift || {};
my $sql = "INSERT INTO $table("
. join(',', @$cols)
. ") VALUES ("
. join(',', map {'?'} @$cols)
. ")";
my $sth = $dbh->prepare($sql);
foreach my $row (@{ $rows_ref || []}) {
my $i = 1;
for (my $j = 0; $j < @$cols; $j++) {
$sth->bind_param($i++, $row->[$j], $attrs->{$cols->[$j]});
}
$sth->execute;
}
return 1;
}
##
sub sql_class { 'Data::ObjectDriver::SQL::Oracle' }
package Data::ObjectDriver::Driver::DBD::Oracle::db;
use strict;
## Inherit the DB class from DBI::db.
use base qw(DBI::db);
## Oracle doesn't allow a SELECT statement without FROM.
sub _adjust_stmt {
my $stmt = shift;
my $has_select = ($stmt =~ m/^\s*SELECT\b/io);
my $has_from = ($stmt =~ m/\bFROM\b/io);
$stmt .= " FROM DUAL" if ($has_select and !$has_from);
return $stmt;
}
sub selectrow_array {
my $self = shift;
my $stmt = shift;
$stmt = _adjust_stmt($stmt);
unshift @_, $stmt;
$self->SUPER::selectrow_array(@_);
}
1;
__END__
=head1 NAME
Data::ObjectDriver::Driver::DBD::Oracle - Oracle Driver for Data::ObjectDriver
=head1 DESCRIPTION
This module overrides methods of the Data::ObjectDriver::Driver::DBD module
with Oracle specific implementation.
=head1 NOTES
Oracle doesn't support auto-increment, so before you use this feature, you
should create a sequence and a trigger to work with it.
For example, you want field ID in table WINES be auto-increment, then create:
-- Create sequence
CREATE SEQUENCE WINES_ID_SEQ
MINVALUE 1
MAXVALUE 999999999999999999999999999
START WITH 1
INCREMENT BY 1
NOCACHE;
-- Create trigger
CREATE OR REPLACE TRIGGER WINES_ID_TR
BEFORE INSERT ON WINES
FOR EACH ROW
BEGIN
SELECT WINES_ID_SEQ.NEXTVAL INTO :NEW.ID FROM DUAL;
END;
=head1 LICENSE
This module is free software;
you may redistribute and/or modify it under the same
terms as Perl itself.
=head1 AUTHOR & COPYRIGHT
This module is
copyright (c) 2009 Xiaoou Wu E<lt>xiaoou.wu@oracle.comE<gt>.
All rights reserved.
=cut