package SQL::Translator::Producer::Oracle;
# -------------------------------------------------------------------
-# $Id: Oracle.pm,v 1.27 2003-10-15 20:39:15 kycl4rk Exp $
+# $Id: Oracle.pm,v 1.33 2005-05-25 15:17:49 mwz444 Exp $
# -------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
-# darren chamberlain <darren@cpan.org>,
-# Chris Mungall <cjm@fruitfly.org>
+# Copyright (C) 2002-4 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
use strict;
use vars qw[ $VERSION $DEBUG $WARN ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.27 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0 unless defined $DEBUG;
use SQL::Translator::Schema::Constants;
);
my $field_name_ur = unreserve( $field_name, $table_name );
my $field_def = $field_name_ur;
+ $field->name( $field_name_ur );
#
# Datatype
else {
$data_type = defined $translate{ $data_type } ?
$translate{ $data_type } :
- die "Unknown datatype: $data_type\n";
+ $data_type;
+ $data_type ||= 'varchar2';
}
#
if $WARN;
}
+ if ( $data_type eq 'clob' && $field->is_unique ) {
+ $data_type = 'varchar2';
+ $size[0] = 4000;
+ warn "CLOB cannot be a unique key, changing to VARCHAR2\n"
+ if $WARN;
+ }
+
+
+
#
# Fixes ORA-00907: missing right parenthesis
#
}
}
elsif (
- $data_type =~ /date/ && $default eq 'current_timestamp'
+ $data_type =~ /date/ && (
+ $default eq 'current_timestamp'
+ ||
+ $default eq 'now()'
+ )
) {
$default = 'SYSDATE';
}
# Not null constraint
#
unless ( $field->is_nullable ) {
-# my $constraint_name = mk_name(
-# join('_', $table_name_ur, $field_name_ur ), 'nn'
-# );
-# $field_def .= ' CONSTRAINT ' . $constraint_name . ' NOT NULL';
$field_def .= ' NOT NULL';
}
# Auto_increment
#
if ( $field->is_auto_increment ) {
- my $base_name = $table_name . "_". $field_name;
+ my $base_name = $table_name_ur . "_". $field_name;
my $seq_name = mk_name( $base_name, 'sq' );
my $trigger_name = mk_name( $base_name, 'ai' );
push @trigger_defs,
"CREATE SEQUENCE $seq_name;\n" .
"CREATE OR REPLACE TRIGGER $trigger_name\n" .
- "BEFORE INSERT ON $table_name\n" .
+ "BEFORE INSERT ON $table_name_ur\n" .
"FOR EACH ROW WHEN (\n" .
" new.$field_name_ur IS NULL".
" OR new.$field_name_ur = 0\n".
}
if ( lc $field->data_type eq 'timestamp' ) {
- my $base_name = $table_name . "_". $field_name_ur;
+ my $base_name = $table_name_ur . "_". $field_name_ur;
my $trig_name = mk_name( $base_name, 'ts' );
push @trigger_defs,
"CREATE OR REPLACE TRIGGER $trig_name\n".
push @field_defs, $field_def;
if ( my $comment = $field->comments ) {
+ $comment =~ s/'/''/g;
push @field_comments,
- "COMMENT ON COLUMN $table_name.$field_name_ur is\n '".
- $comment."';" unless $no_comments;
+ "COMMENT ON COLUMN $table_name_ur.$field_name_ur is\n '" .
+ $comment . "';" unless $no_comments;
}
}
'(' . join( ', ', @fields ) . ')';
}
elsif ( $c->type eq UNIQUE ) {
- $name ||= mk_name( $table_name, 'u' );
+ $name = mk_name( $name || $table_name, 'u' );
+
+ for my $f ( $c->fields ) {
+ my $field_def = $table->get_field( $f ) or next;
+ my $dtype = $translate{ $field_def->data_type } or next;
+ if ( $WARN && $dtype =~ /clob/i ) {
+ warn "Oracle will not allow UNIQUE constraints on " .
+ "CLOB field '" . $field_def->table->name . '.' .
+ $field_def->name . ".'\n"
+ }
+ }
+
push @constraint_defs, "CONSTRAINT $name UNIQUE " .
'(' . join( ', ', @fields ) . ')';
}
elsif ( $c->type eq CHECK_C ) {
- $name ||= mk_name( $table_name, 'ck' );
+ $name = mk_name( $name || $table_name, 'ck' );
my $expression = $c->expression || '';
push @constraint_defs, "CONSTRAINT $name CHECK ($expression)";
}
elsif ( $c->type eq FOREIGN_KEY ) {
- $name ||= mk_name( join('_', $table_name, $c->fields), 'fk' );
+ $name = mk_name( join('_', $table_name, $c->fields), 'fk' );
my $def = "CONSTRAINT $name FOREIGN KEY ";
if ( @fields ) {
next unless @fields;
if ( $index_type eq PRIMARY_KEY ) {
- $index_name ||= mk_name( $table_name, 'pk' );
+ $index_name = $index_name ? mk_name( $index_name )
+ : mk_name( $table_name, 'pk' );
push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
'(' . join( ', ', @fields ) . ')';
}
elsif ( $index_type eq NORMAL ) {
- $index_name ||= mk_name( $table_name, $index_name || 'i' );
+ $index_name = $index_name ? mk_name( $index_name )
+ : mk_name( $table_name, $index_name || 'i' );
push @index_defs,
"CREATE INDEX $index_name on $table_name_ur (".
join( ', ', @fields ).
if ( my @table_comments = $table->comments ) {
for my $comment ( @table_comments ) {
next unless $comment;
- push @field_comments, "COMMENT ON TABLE $table_name is\n '".
- $comment."';" unless $no_comments
+ $comment =~ s/'/''/g;
+ push @field_comments, "COMMENT ON TABLE $table_name_ur is\n '".
+ $comment . "';" unless $no_comments
;
}
}
$scope ||= \%global_names;
if ( my $prev = $scope->{ $name } ) {
my $name_orig = $name;
- $name .= sprintf( "%02d", ++$prev );
- substr($name, $max_id_length - 3) = "00"
- if length( $name ) > $max_id_length;
+ substr($name, $max_id_length - 2) = ""
+ if length( $name ) >= $max_id_length - 1;
+ $name .= sprintf( "%02d", $prev++ );
warn "The name '$name_orig' has been changed to ",
"'$name' to make it unique.\n" if $WARN;
projects / dbsrgits/SQL-Translator.git / blobdiff