package SQL::Translator::Producer::Oracle;
# -------------------------------------------------------------------
-# $Id: Oracle.pm,v 1.30 2004-02-09 23:02:15 kycl4rk Exp $
+# $Id: Oracle.pm,v 1.34 2005-08-10 16:33:39 duality72 Exp $
# -------------------------------------------------------------------
# Copyright (C) 2002-4 SQLFairy Authors
#
use strict;
use vars qw[ $VERSION $DEBUG $WARN ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.30 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.34 $ =~ /(\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
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
#
#
if (
$data_type =~ /^number$/i &&
- $default !~ /^\d+$/ &&
+ $default !~ /^-?\d+$/ &&
$default !~ m/null/i
) {
if ( $default =~ /^true$/i ) {
# 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' );
}
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;
}
}
next if !@fields && $c->type ne CHECK_C;
if ( $c->type eq PRIMARY_KEY ) {
- $name ||= mk_name( $table_name, 'pk' );
- push @constraint_defs, "CONSTRAINT $name PRIMARY KEY ".
- '(' . join( ', ', @fields ) . ')';
+ #$name ||= mk_name( $table_name, 'pk' );
+ push @constraint_defs, ($name ? "CONSTRAINT $name " : '') .
+ 'PRIMARY KEY (' . join( ', ', @fields ) . ')';
}
elsif ( $c->type eq UNIQUE ) {
- $name ||= mk_name( $table_name, 'u' );
+ # Don't create UNIQUE constraints identical to the primary key
+ if ( my $pk = $table->primary_key ) {
+ my $u_fields = join(":", @fields);
+ my $pk_fields = join(":", $pk->fields);
+ next if $u_fields eq $pk_fields;
+ }
+
+ $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;
$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)";
}
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;