591 lines
19 KiB
Perl
591 lines
19 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::SQL::Driver::ORACLE
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: ORACLE.pm,v 2.2 2008/03/13 23:12:16 bao Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description: Oracle 8+ driver for GT::SQL
|
|
#
|
|
|
|
package GT::SQL::Driver::ORACLE;
|
|
# ====================================================================
|
|
use strict;
|
|
use vars qw/@ISA $ERROR_MESSAGE $ERRORS %BINDS/;
|
|
|
|
use DBD::Oracle qw/:ora_types/;
|
|
use GT::SQL::Driver;
|
|
use GT::AutoLoader;
|
|
|
|
$ERROR_MESSAGE = 'GT::SQL';
|
|
@ISA = qw/GT::SQL::Driver/;
|
|
|
|
sub protocol_version { 2 }
|
|
|
|
sub connect {
|
|
# ------------------------------------------------------------------
|
|
# Need to set some session preferences.
|
|
#
|
|
my $self = shift;
|
|
|
|
# ORACLE_HOME must be set for the DBD::Oracle driver to function properly.
|
|
return $self->warn('NOORACLEHOME') unless exists $ENV{ORACLE_HOME};
|
|
|
|
my $dbh = $self->SUPER::connect(@_) or return;
|
|
|
|
# Set the date format to same format as other drivers use.
|
|
$dbh->do("ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS'")
|
|
or return $self->fatal(NONLSDATE => $DBI::errstr);
|
|
|
|
# Set max read properties for DBI.
|
|
$dbh->{LongReadLen} = 1_048_576;
|
|
return $dbh;
|
|
}
|
|
|
|
sub dsn {
|
|
# -------------------------------------------------------------------
|
|
# Oracle DSN looks like:
|
|
# DBI:Oracle:host=HOST;port=POST;sid=SID
|
|
#
|
|
my ($self, $connect) = @_;
|
|
|
|
$connect->{driver} ||= 'Oracle';
|
|
$connect->{host} ||= 'localhost';
|
|
$self->{driver} = $connect->{driver};
|
|
|
|
my $dsn = "DBI:$connect->{driver}:";
|
|
$dsn .= "host=$connect->{host}";
|
|
$dsn .= ";port=$connect->{port}" if $connect->{port};
|
|
$dsn .= ";sid=$connect->{database}";
|
|
|
|
return $dsn;
|
|
}
|
|
|
|
sub hints {
|
|
case_map => 1,
|
|
prefix_indexes => 1,
|
|
bind => [
|
|
\%BINDS,
|
|
'TEXT' => ORA_CLOB,
|
|
'BLOB' => ORA_BLOB
|
|
],
|
|
now => 'SYSDATE',
|
|
ai => sub {
|
|
my ($table, $column) = @_;
|
|
my $seq = "${table}_seq";
|
|
my @q;
|
|
push @q, \"DROP SEQUENCE $seq";
|
|
push @q, "CREATE SEQUENCE $seq INCREMENT BY 1 START WITH 1 NOCYCLE";
|
|
\@q;
|
|
}
|
|
}
|
|
|
|
sub prepare {
|
|
# -----------------------------------------------------------------------------
|
|
# Clear our limit counters. Oracle does not have built-in limit support, so it
|
|
# is handled here by fetching all the results that were asked for into _results
|
|
# and our own fetchrow methods work off that.
|
|
#
|
|
my ($self, $query) = @_;
|
|
|
|
# Oracle uses "SUBSTR" instead of "SUBSTRING"
|
|
$query =~ s/\bSUBSTRING\(/SUBSTR(/gi;
|
|
|
|
$self->SUPER::prepare($query);
|
|
}
|
|
|
|
sub _prepare_select {
|
|
# -----------------------------------------------------------------------------
|
|
# Need to store what the requested result set; no built in LIMIT support like
|
|
# mysql.
|
|
#
|
|
my ($self, $query) = @_;
|
|
|
|
my ($limit, $offset);
|
|
|
|
# Handle either PG or MySQL limits
|
|
$query =~ s/\bLIMIT\s+(\d+)\s+OFFSET\s+(\d+)/($limit, $offset) = ($1, $2); ''/ie
|
|
or $query =~ s/\bOFFSET\s+(\d+)\s+LIMIT\s+(\d+)/($limit, $offset) = ($2, $1); ''/ie
|
|
or $query =~ s/\bLIMIT\s+(\d+)\s*(?:,\s*(\d+))?/($limit, $offset) = ($2 || $1, $2 ? $1 : 0); ''/ie;
|
|
if ($limit) {
|
|
$self->{_limit} = 1;
|
|
# using ROWNUM to limit rows instead.
|
|
my $max_rows = $offset + $limit;
|
|
$query = "SELECT * from (SELECT a.*, rownum rnum from ($query) a WHERE rownum <= $max_rows) where rnum > $offset";
|
|
}
|
|
|
|
# LEFT OUTER JOIN is not supported, instead:
|
|
# ... FROM Table1, Table2 WHERE col1 = col2(+) ...
|
|
$query =~ s{FROM\s+(\w+)\s+LEFT OUTER JOIN\s+(\w+)\s+ON\s+([\w.]+)\s*=\s*([\w.]+)(\s+WHERE\s+)?}{
|
|
my ($table1, $table2, $col1, $col2, $where) = ($1, $2, $3, $4, $5);
|
|
my $from_where = "FROM $table1, $table2 WHERE ";
|
|
$from_where .= index($col1, "$table1.") == 0
|
|
? "$col1 = $col2(+)"
|
|
: "$col2 = $col1(+)";
|
|
$from_where .= " AND " if $where;
|
|
$from_where;
|
|
}ie;
|
|
|
|
$query;
|
|
}
|
|
|
|
sub _prepare_describe {
|
|
# ------------------------------------------------------------------
|
|
# Oracle supports USER_TAB_COLUMNS to get information
|
|
# about a table.
|
|
#
|
|
my ($self, $query) = @_;
|
|
if ($query =~ /DESCRIBE\s+(\w+)/i) {
|
|
return <<" QUERY";
|
|
SELECT COLUMN_NAME, DATA_TYPE, DATA_LENGTH, DATA_PRECISION, DATA_SCALE, NULLABLE, DATA_DEFAULT
|
|
FROM USER_TAB_COLUMNS
|
|
WHERE TABLE_NAME = '\U$1\E'
|
|
ORDER BY COLUMN_ID
|
|
QUERY
|
|
}
|
|
else {
|
|
return $self->warn(CANTPREPARE => $query, "Cannot get properties from db_tab_columns");
|
|
}
|
|
}
|
|
|
|
sub column_exists {
|
|
my ($self, $table, $column) = @_;
|
|
my $sth = $self->{dbh}->prepare(<<EXISTS);
|
|
SELECT COUNT(*)
|
|
FROM USER_TAB_COLUMNS
|
|
WHERE TABLE_NAME = ? AND COLUMN_NAME = ?
|
|
EXISTS
|
|
$sth->execute(uc $table, uc $column);
|
|
|
|
return scalar $sth->fetchrow;
|
|
}
|
|
|
|
sub _prepare_show_tables {
|
|
# -----------------------------------------------------------------------------
|
|
# Oracle's equivelant to SHOW TABLES
|
|
#
|
|
my $self = shift;
|
|
$self->{do} = 'SELECT';
|
|
'SELECT table_name FROM USER_TABLES ORDER BY table_name';
|
|
}
|
|
|
|
sub _prepare_show_index {
|
|
# -----------------------------------------------------------------------------
|
|
# Get an index list; see 'Driver-specific notes' comment in GT::SQL::Driver
|
|
my ($self, $query) = @_;
|
|
if ($query =~ /^\s*SHOW\s+INDEX\s+FROM\s+(\w+)\s*$/i) {
|
|
# The below isn't quite perfect - Oracle 8 doesn't support CASE (9 does), so
|
|
# the 'index_unique' still has to be mapped to a 1/0 value in execute(). Also
|
|
# worth noting is that primary keys in Oracle don't always get their own index
|
|
# - in particular, when adding a primary key to a table using a column that is
|
|
# already indexed, the primary key will simply use the existing index instead
|
|
# of creating a new one.
|
|
return <<QUERY;
|
|
SELECT
|
|
ic.index_name AS "index_name",
|
|
ic.column_name AS "index_column",
|
|
(
|
|
SELECT COUNT(*) FROM user_constraints c, user_cons_columns cc
|
|
WHERE c.index_name = i.index_name AND c.constraint_name = cc.constraint_name
|
|
AND c.constraint_type = 'P' AND cc.column_name = ic.column_name
|
|
) "index_primary",
|
|
uniqueness AS "index_unique"
|
|
FROM
|
|
user_ind_columns ic,
|
|
user_indexes i
|
|
WHERE
|
|
ic.index_name = i.index_name AND
|
|
LOWER(ic.table_name) = '\L$1\E'
|
|
ORDER BY
|
|
ic.index_name,
|
|
ic.column_position
|
|
QUERY
|
|
}
|
|
else {
|
|
return $self->warn(CANTPREPARE => $query, "Invalid/unsupported SHOW INDEX query: $query");
|
|
}
|
|
}
|
|
|
|
sub drop_table {
|
|
# -------------------------------------------------------------------
|
|
# Drops a table, including a sequence if necessary
|
|
#
|
|
my ($self, $table) = @_;
|
|
|
|
my $seq = uc "${table}_seq";
|
|
my $sth = $self->{dbh}->prepare("SELECT SEQUENCE_NAME FROM USER_SEQUENCES WHERE SEQUENCE_NAME = '$seq'");
|
|
$sth->execute();
|
|
if (my $seq_name = $sth->fetchrow) {
|
|
my $sth = $self->{dbh}->prepare("DROP SEQUENCE $seq");
|
|
$sth->execute or $self->warn(CANTEXECUTE => "DROP SEQUENCE $seq", $GT::SQL::error);
|
|
}
|
|
return $self->SUPER::drop_table($table);
|
|
}
|
|
|
|
sub ai_insert {
|
|
my ($self, $ai) = @_;
|
|
return $ai, "$self->{name}_seq.NEXTVAL";
|
|
}
|
|
|
|
sub alter_column {
|
|
# -------------------------------------------------------------------
|
|
# Changes a column. Takes table name, column name, and new column definition.
|
|
#
|
|
my ($self, $table, $column, $new_def, $old_col) = @_;
|
|
|
|
# make a copy so the original reference doesn't get clobbered
|
|
my %col = %{$self->{schema}->{cols}->{$column}};
|
|
|
|
# If the default value was removed, then make sure that the default constraint
|
|
# from the previous instance is deactivated.
|
|
if (not exists $col{default} and defined $old_col->{default} and length $old_col->{default}) {
|
|
$col{default} = \'NULL';
|
|
}
|
|
|
|
# Oracle doesn't like being told to make an already NOT NULL column NOT NULL:
|
|
if ($col{not_null} and $old_col->{not_null}) {
|
|
delete $col{not_null};
|
|
}
|
|
|
|
$new_def = $self->column_sql(\%col);
|
|
|
|
# But it needs an explicit NULL to drop the field's NOT NULL
|
|
if (not $col{not_null} and $old_col->{not_null}) {
|
|
$new_def .= ' NULL';
|
|
}
|
|
|
|
# Oracle doesn't need the data type, and won't accept it on CLOB/BLOB columns
|
|
$new_def =~ s/^[BC]LOB ?//;
|
|
$new_def or return 1; # If the def is empty now, there really isn't anything to be done.
|
|
|
|
$self->do("ALTER TABLE $table MODIFY $column $new_def");
|
|
}
|
|
|
|
sub drop_column {
|
|
# -------------------------------------------------------------------
|
|
# Drops a column
|
|
#
|
|
my ($self, $table, $column) = @_;
|
|
$self->do("ALTER TABLE $table DROP COLUMN $column");
|
|
}
|
|
|
|
sub create_pk {
|
|
# -------------------------------------------------------------------
|
|
# Adds a primary key to a table.
|
|
#
|
|
my ($self, $table, @cols) = @_;
|
|
$self->create_index($table, "${table}_pkey", @cols);
|
|
$self->do("ALTER TABLE $table ADD CONSTRAINT ${table}_pkey PRIMARY KEY (" . join(",", @cols) . ")");
|
|
}
|
|
|
|
package GT::SQL::Driver::ORACLE::sth;
|
|
# ====================================================================
|
|
use strict;
|
|
use vars qw/@ISA $ERROR_MESSAGE $DEBUG/;
|
|
use GT::SQL::Driver::sth;
|
|
use GT::AutoLoader;
|
|
|
|
$ERROR_MESSAGE = 'GT::SQL';
|
|
$DEBUG = 0;
|
|
@ISA = qw/GT::SQL::Driver::sth/;
|
|
|
|
sub insert_id {
|
|
# -------------------------------------------------------------------
|
|
# Retrieves the current sequence.
|
|
#
|
|
my $self = shift;
|
|
return $self->{_insert_id} if $self->{_insert_id};
|
|
|
|
my ($table) = $self->{query} =~ /\s*insert\s*into\s*(\w+)/i;
|
|
$table ||= $self->{name};
|
|
my $seq = $table . "_seq.CURRVAL";
|
|
my $query = "SELECT $seq FROM $table";
|
|
my $sth = $self->{dbh}->prepare($query) or return $self->fatal(CANTPREPARE => $query, $DBI::errstr);
|
|
$sth->execute or return $self->fatal(CANTEXECUTE => $query, $DBI::errstr);
|
|
my ($id) = $sth->fetchrow_array;
|
|
$self->{_insert_id} = $id;
|
|
|
|
return $id;
|
|
}
|
|
|
|
sub execute {
|
|
# -------------------------------------------------------------------
|
|
# Fetch off only desired rows.
|
|
#
|
|
my $self = shift;
|
|
my $time;
|
|
if ($self->{_debug}) {
|
|
$self->last_query($self->{query}, @_);
|
|
my $stack = '';
|
|
if ($self->{_debug} > 1) {
|
|
$stack = GT::Base->stack_trace(1,1);
|
|
$stack =~ s/<br>/\n /g;
|
|
$stack =~ s/ / /g;
|
|
$stack = "\n $stack\n"
|
|
}
|
|
my $query = GT::SQL::Driver::debug->replace_placeholders($self->{query}, @_);
|
|
$self->debug("Executing query: $query$stack");
|
|
$time = Time::HiRes::time() if exists $INC{"Time/HiRes.pm"};
|
|
}
|
|
if ($GT::SQL::Driver::ORACLE::BINDS{$self->{query}}) {
|
|
for my $bind (@{$GT::SQL::Driver::ORACLE::BINDS{$self->{query}}}) {
|
|
my ($index, $col, $type) = @$bind;
|
|
$self->{sth}->bind_param($index, $_[$index - 1], { ora_type => $type, ora_field => $col });
|
|
}
|
|
}
|
|
my $rc = $self->{sth}->execute(@_) or return $self->warn(CANTEXECUTE => $self->{query}, $DBI::errstr);
|
|
$self->{_results} = [];
|
|
$self->{_insert_id} = '';
|
|
$self->{_names} = $self->{sth}->{NAME};
|
|
if ($self->{do} eq 'SELECT') {
|
|
$self->{_lim_cnt} = 0;
|
|
if ($self->{_limit}) {
|
|
while (my $rec = $self->{sth}->fetchrow_arrayref) {
|
|
my @tmp = @$rec;
|
|
pop @tmp; # get rid of the RNUM extra column
|
|
push @{$self->{_results}}, [@tmp]; # Must copy as ref is reused in DBI.
|
|
}
|
|
}
|
|
else {
|
|
$self->{_results} = $self->{sth}->fetchall_arrayref;
|
|
}
|
|
$self->{rows} = @{$self->{_results}};
|
|
}
|
|
elsif ($self->{do} eq 'SHOW INDEX') {
|
|
$self->{_names} = $self->{sth}->{NAME_lc};
|
|
$self->{_results} = $self->{sth}->fetchall_arrayref;
|
|
my $i = 0;
|
|
for (@{$self->{_names}}) { last if $_ eq 'index_unique'; $i++ }
|
|
for (@{$self->{_results}}) {
|
|
$_->[$i] = uc($_->[$i]) eq 'UNIQUE' ? 1 : 0;
|
|
}
|
|
$self->{rows} = @{$self->{_results}};
|
|
}
|
|
elsif ($self->{do} eq 'DESCRIBE') {
|
|
$rc = $self->_fixup_describe();
|
|
}
|
|
else {
|
|
$self->{rows} = $self->{sth}->rows;
|
|
}
|
|
|
|
if ($self->{_debug} and exists $INC{"Time/HiRes.pm"}) {
|
|
my $elapsed = Time::HiRes::time() - $time;
|
|
$self->debug(sprintf("Query execution took: %.6fs", $elapsed));
|
|
}
|
|
|
|
return $rc;
|
|
}
|
|
|
|
sub _fixup_describe {
|
|
# ---------------------------------------------------------------
|
|
# Converts output of 'sp_columns tablename' into similiar results
|
|
# of mysql's describe tablename.
|
|
#
|
|
my $self = shift;
|
|
my @results;
|
|
|
|
# Mysql Cols are: Field, Type, Null, Key, Default, Extra
|
|
my $table = uc $self->{name};
|
|
while (my $col = $self->{sth}->fetchrow_hashref) {
|
|
my ($table, $field, $type, $size, $prec, $scale) = @$col{qw/TABLE_NAME COLUMN_NAME DATA_TYPE DATA_LENGTH DATA_PRECISION DATA_SCALE/};
|
|
my $null = $col->{NULLABLE} eq 'Y';
|
|
my $default = (not defined $col->{DATA_DEFAULT} or $col->{DATA_DEFAULT} =~ /^''\s*/) ? '' : $col->{DATA_DEFAULT};
|
|
|
|
$size = length $default if length $default > $size;
|
|
|
|
if ($type =~ /VARCHAR2|CHAR/) {
|
|
$type = "varchar($size)";
|
|
}
|
|
elsif ($type =~ /NUMBER/ and !$scale) {
|
|
if ($prec) {
|
|
$type =
|
|
$prec >= 11 ? 'bigint' :
|
|
$prec >= 9 ? 'int' :
|
|
$prec >= 6 ? 'mediumint' :
|
|
$prec >= 4 ? 'smallint' :
|
|
'tinyint';
|
|
}
|
|
else {
|
|
$type = 'bigint';
|
|
}
|
|
}
|
|
elsif ($type =~ /NUMBER/ and length $prec and length $scale) {
|
|
$type = "decimal($prec, $scale)";
|
|
}
|
|
elsif ($type =~ /FLOAT/) {
|
|
$type = (!$prec or $prec > 23) ? 'double' : 'real';
|
|
}
|
|
elsif ($type =~ /LONG|CLOB|NCLOB/) {
|
|
$type = 'text';
|
|
}
|
|
elsif ($type =~ /DATE/) {
|
|
$type = 'datetime';
|
|
}
|
|
|
|
$type = lc $type;
|
|
$default =~ s,^NULL\s*,,;
|
|
$default =~ s,^\(?'(.*)'\)?\s*$,$1,;
|
|
$null = $null ? 'YES' : '';
|
|
push @results, [$field, $type, $null, '', $default, ''];
|
|
}
|
|
( $#results < 0 ) and return;
|
|
|
|
# Fetch the Primary key
|
|
my $que_pk = <<" QUERY";
|
|
SELECT COL.COLUMN_NAME
|
|
FROM USER_CONS_COLUMNS COL, USER_CONSTRAINTS CON
|
|
WHERE COL.TABLE_NAME = '\U$table\E'
|
|
AND COL.TABLE_NAME = CON.TABLE_NAME
|
|
AND COL.CONSTRAINT_NAME = CON.CONSTRAINT_NAME
|
|
AND CON.CONSTRAINT_TYPE='P'
|
|
QUERY
|
|
my $sth_pk = $self->{dbh}->prepare($que_pk);
|
|
$sth_pk->execute;
|
|
my $indexes = {};
|
|
while ( my $col = $sth_pk->fetchrow_array ) {
|
|
$indexes->{$col} = "PRI";
|
|
}
|
|
$sth_pk->finish;
|
|
|
|
# Fetch the index information.
|
|
my $que_idx = <<" QUERY";
|
|
SELECT *
|
|
FROM USER_INDEXES IND, USER_IND_COLUMNS COL
|
|
WHERE IND.TABLE_NAME = '\U$table\E'
|
|
AND IND.TABLE_NAME = COL.TABLE_NAME
|
|
AND IND.INDEX_NAME = COL.INDEX_NAME
|
|
QUERY
|
|
|
|
my $sth_idx = $self->{dbh}->prepare($que_idx);
|
|
$sth_idx->execute;
|
|
while ( my $col = $sth_idx->fetchrow_hashref ) {
|
|
my $key = $col->{UNIQUENESS} =~ /UNIQUE/ ? 'UNIQUE' : 'MUL';
|
|
exists $indexes->{$col->{COLUMN_NAME}} or $indexes->{$col->{COLUMN_NAME}} = $key;
|
|
}
|
|
|
|
for my $result (@results) {
|
|
if (defined $indexes->{$result->[0]}) {
|
|
$result->[3] = $indexes->{$result->[0]};
|
|
if ($result->[1] =~ /int/) { # Set extra
|
|
my $sth = $self->{dbh}->prepare("SELECT SEQUENCE_NAME FROM USER_SEQUENCES WHERE SEQUENCE_NAME = '\U$table\E_SEQ'");
|
|
$sth->execute;
|
|
$result->[5] = 'auto_increment' if $sth->fetchrow;
|
|
$sth->finish;
|
|
}
|
|
}
|
|
}
|
|
$sth_idx->finish;
|
|
$self->{_results} = \@results;
|
|
$self->{_names} = [qw/Field Type Null Key Default Extra/];
|
|
$self->{rows} = @{$self->{_results}};
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub finish {
|
|
# -----------------------------------------------------------------------------
|
|
my $self = shift;
|
|
delete $GT::SQL::Driver::ORACLE::BINDS{$self->{query}};
|
|
$self->SUPER::finish;
|
|
}
|
|
|
|
$COMPILE{_fetchrow_hashref} = __LINE__ . <<'END_OF_SUB';
|
|
sub _fetchrow_hashref {
|
|
# -----------------------------------------------------------------------------
|
|
# Handles row fetching for driver that can't use the default ->fetchrow_hashref
|
|
# due to needing column case mapping ($sth->{hints}->{case_map}), or special
|
|
# result handling (e.g. PG's DESCRIBE handling, Oracle & ODBC's limit
|
|
# handling).
|
|
#
|
|
my $self = shift;
|
|
|
|
my %case_map; # returnedname => ReturnedName, but only for columns that use upper case
|
|
if ($self->{hints}->{case_map}) {
|
|
if (exists $self->{schema}->{cols}) {
|
|
my $cols = $self->{schema}->{cols};
|
|
%case_map = map { lc $_ => $_ } keys %$cols;
|
|
}
|
|
else {
|
|
for my $table (keys %{$self->{schema}}) {
|
|
for my $col (keys %{$self->{schema}->{$table}->{schema}->{cols}}) {
|
|
$case_map{lc $col} = $col;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($self->{_results}) {
|
|
my $arr = shift @{$self->{_results}} or return;
|
|
|
|
my $i;
|
|
my %selected = map { lc $_ => $i++ } @{$self->{_names}};
|
|
my %hash;
|
|
|
|
for my $lc_col (keys %selected) {
|
|
next if $lc_col eq 'rnum';
|
|
if (exists $case_map{$lc_col}) {
|
|
$hash{$case_map{$lc_col}} = $arr->[$selected{$lc_col}];
|
|
}
|
|
else {
|
|
$hash{$self->{_names}->[$selected{$lc_col}]} = $arr->[$selected{$lc_col}];
|
|
}
|
|
}
|
|
return \%hash;
|
|
}
|
|
else {
|
|
my $h = $self->{sth}->fetchrow_hashref or return;
|
|
for (keys %$h) {
|
|
$h->{$case_map{lc $_}} = delete $h->{lc $_} if exists $case_map{lc $_};
|
|
}
|
|
return $h;
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# -----------------------------------------------------------------------------
|
|
# DATA TYPE MAPPINGS
|
|
# -----------------------------------------------------------------------------
|
|
|
|
package GT::SQL::Driver::ORACLE::Types;
|
|
|
|
use strict;
|
|
use GT::SQL::Driver::Types;
|
|
use Carp qw/croak/;
|
|
use vars qw/@ISA/;
|
|
@ISA = 'GT::SQL::Driver::Types';
|
|
|
|
# Quoting table and/or column names gives case-sensitivity to the table and
|
|
# column names in Oracle - however, because this needs to be compatible with
|
|
# older versions of this driver that didn't properly handle table/column case,
|
|
# we can't use that to our advantage, as all the old unquoted tables/columns
|
|
# would be upper-case - TABLE or COLUMN will be the name in the database, and
|
|
# "Table" or "column" would not exist. It would, however, still be nice to
|
|
# support this at some point:
|
|
# sub base {
|
|
# my ($class, $args, $name, $attribs) = @_;
|
|
# $class->SUPER::base($args, qq{"$name"}, $attribs);
|
|
# }
|
|
|
|
sub TINYINT { $_[0]->base($_[1], 'NUMBER(3)') }
|
|
sub SMALLINT { $_[0]->base($_[1], 'NUMBER(5)') }
|
|
sub MEDIUMINT { $_[0]->base($_[1], 'NUMBER(8)') }
|
|
sub INT { $_[0]->base($_[1], 'NUMBER(10)') }
|
|
sub BIGINT { $_[0]->base($_[1], 'NUMBER(19)') }
|
|
sub REAL { $_[0]->base($_[1], 'FLOAT(23)') }
|
|
sub DOUBLE { $_[0]->base($_[1], 'FLOAT(52)') }
|
|
|
|
sub DATETIME { $_[0]->base($_[1], 'DATE') }
|
|
sub TIMESTAMP { $_[0]->base($_[1], 'DATE') }
|
|
sub TIME { croak "Oracle does not support 'TIME' columns\n" }
|
|
sub YEAR { croak "Oracle does not support 'YEAR' columns\n" }
|
|
|
|
sub CHAR { $_[0]->SUPER::CHAR($_[1], 'VARCHAR2') }
|
|
sub VARCHAR { $_[0]->SUPER::CHAR($_[1], 'VARCHAR2') }
|
|
sub TEXT { $_[0]->base($_[1], 'CLOB') }
|
|
sub BLOB { delete $_[1]->{default}; $_[0]->base($_[1], 'BLOB') }
|
|
|
|
1;
|