lib/SQL/Translator/Producer/Oracle.pm

   1 package SQL::Translator::Producer::Oracle;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: Oracle.pm,v 1.34 2005-08-10 16:33:39 duality72 Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =head1 NAME
  24
  25 SQL::Translator::Producer::Oracle - Oracle SQL producer
  26
  27 =head1 SYNOPSIS
  28
  29   use SQL::Translator;
  30
  31   my $t = SQL::Translator->new( parser => '...', producer => 'Oracle' );
  32   print $translator->translate( $file );
  33
  34 =head1 DESCRIPTION
  35
  36 Creates an SQL DDL suitable for Oracle.
  37
  38 =head1 producer_args
  39
  40 =over
  41
  42 =item delay_constraints
  43
  44 This option remove the primary key and other key constraints from the
  45 CREATE TABLE statement and adds ALTER TABLEs at the end with it.
  46
  47 =back
  48
  49 =cut
  50
  51 use strict;
  52 use vars qw[ $VERSION $DEBUG $WARN ];
  53 $VERSION = sprintf "%d.%02d", q$Revision: 1.34 $ =~ /(\d+)\.(\d+)/;
  54 $DEBUG   = 0 unless defined $DEBUG;
  55
  56 use SQL::Translator::Schema::Constants;
  57 use SQL::Translator::Utils qw(header_comment);
  58
  59 my %translate  = (
  60     #
  61     # MySQL types
  62     #
  63     bigint     => 'number',
  64     double     => 'number',
  65     decimal    => 'number',
  66     float      => 'number',
  67     int        => 'number',
  68     integer    => 'number',
  69     mediumint  => 'number',
  70     smallint   => 'number',
  71     tinyint    => 'number',
  72     char       => 'char',
  73     varchar    => 'varchar2',
  74     tinyblob   => 'blob',
  75     blob       => 'blob',
  76     mediumblob => 'blob',
  77     longblob   => 'blob',
  78     tinytext   => 'varchar2',
  79     text       => 'clob',
  80     longtext   => 'clob',
  81     mediumtext => 'clob',
  82     enum       => 'varchar2',
  83     set        => 'varchar2',
  84     date       => 'date',
  85     datetime   => 'date',
  86     time       => 'date',
  87     timestamp  => 'date',
  88     year       => 'date',
  89
  90     #
  91     # PostgreSQL types
  92     #
  93     numeric             => 'number',
  94     'double precision'  => 'number',
  95     serial              => 'number',
  96     bigserial           => 'number',
  97     money               => 'number',
  98     character           => 'char',
  99     'character varying' => 'varchar2',
 100     bytea               => 'BLOB',
 101     interval            => 'number',
 102     boolean             => 'number',
 103     point               => 'number',
 104     line                => 'number',
 105     lseg                => 'number',
 106     box                 => 'number',
 107     path                => 'number',
 108     polygon             => 'number',
 109     circle              => 'number',
 110     cidr                => 'number',
 111     inet                => 'varchar2',
 112     macaddr             => 'varchar2',
 113     bit                 => 'number',
 114     'bit varying'       => 'number',
 115
 116     #
 117     # Oracle types
 118     #
 119     number              => 'number',
 120     varchar2            => 'varchar2',
 121     long                => 'clob',
 122 );
 123
 124 #
 125 # Oracle reserved words from:
 126 # http://technet.oracle.com/docs/products/oracle8i/doc_library/\
 127 # 817_doc/server.817/a85397/ap_keywd.htm
 128 #
 129 my %ora_reserved = map { $_, 1 } qw(
 130     ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT
 131     BETWEEN BY
 132     CHAR CHECK CLUSTER COLUMN COMMENT COMPRESS CONNECT CREATE CURRENT
 133     DATE DECIMAL DEFAULT DELETE DESC DISTINCT DROP
 134     ELSE EXCLUSIVE EXISTS
 135     FILE FLOAT FOR FROM
 136     GRANT GROUP
 137     HAVING
 138     IDENTIFIED IMMEDIATE IN INCREMENT INDEX INITIAL INSERT
 139     INTEGER INTERSECT INTO IS
 140     LEVEL LIKE LOCK LONG
 141     MAXEXTENTS MINUS MLSLABEL MODE MODIFY
 142     NOAUDIT NOCOMPRESS NOT NOWAIT NULL NUMBER
 143     OF OFFLINE ON ONLINE OPTION OR ORDER
 144     PCTFREE PRIOR PRIVILEGES PUBLIC
 145     RAW RENAME RESOURCE REVOKE ROW ROWID ROWNUM ROWS
 146     SELECT SESSION SET SHARE SIZE SMALLINT START
 147     SUCCESSFUL SYNONYM SYSDATE
 148     TABLE THEN TO TRIGGER
 149     UID UNION UNIQUE UPDATE USER
 150     VALIDATE VALUES VARCHAR VARCHAR2 VIEW
 151     WHENEVER WHERE WITH
 152 );
 153
 154 #
 155 # Oracle 8/9 max size of data types from:
 156 # http://www.ss64.com/orasyntax/datatypes.html
 157 #
 158 my %max_size = (
 159     char      => 2000,
 160     nchar     => 2000,
 161     nvarchar2 => 4000,
 162     number    => [ 38, 127 ],
 163     raw       => 2000,
 164     varchar   => 4000,          # only synonym for varchar2
 165     varchar2  => 4000,
 166 );
 167
 168 my $max_id_length    = 30;
 169 my %used_identifiers = ();
 170 my %global_names;
 171 my %unreserve;
 172 my %truncated;
 173
 174 # -------------------------------------------------------------------
 175 sub produce {
 176     my $translator     = shift;
 177     $DEBUG             = $translator->debug;
 178     $WARN              = $translator->show_warnings || 0;
 179     my $no_comments    = $translator->no_comments;
 180     my $add_drop_table = $translator->add_drop_table;
 181     my $schema         = $translator->schema;
 182     my $delay_constraints = $translator->producer_args->{delay_constraints};
 183     my ($output, $create, @table_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs);
 184
 185     $create .= header_comment unless ($no_comments);
 186
 187     if ( $translator->parser_type =~ /mysql/i ) {
 188         $create .=
 189             "-- We assume that default NLS_DATE_FORMAT has been changed\n".
 190             "-- but we set it here anyway to be self-consistent.\n"
 191             unless $no_comments;
 192
 193         $create .=
 194         "ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS';\n\n";
 195     }
 196
 197     for my $table ( $schema->get_tables ) {
 198         my ( $table_def, $fk_def, $trigger_def, $index_def, $constraint_def) = create_table(
 199             $table,
 200             {
 201                 add_drop_table => $add_drop_table,
 202                 show_warnings  => $WARN,
 203                 no_comments    => $no_comments,
 204                 delay_constraints => $delay_constraints
 205             }
 206         );
 207         push @table_defs, @$table_def;
 208         push @fk_defs, @$fk_def;
 209         push @trigger_defs, @$trigger_def;
 210         push @index_defs, @$index_def;
 211         push @constraint_defs, @$constraint_def;
 212     }
 213
 214     my (@view_defs);
 215     foreach my $view ( $schema->get_views ) {
 216         push @view_defs, create_view($view);
 217     }
 218
 219     return wantarray ? (defined $create ? $create : (), @table_defs, @view_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs) : $create . join ('', map { $_ ? "$_;\n\n" : () } @table_defs, @view_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs);
 220 }
 221
 222 sub create_table {
 223     my ($table, $options) = @_;
 224     my $table_name = $table->name;
 225
 226     my $item = '';
 227     my $drop;
 228     my (@create, @field_defs, @constraint_defs, @fk_defs, @trigger_defs);
 229
 230     my $table_name_ur = unreserve($table_name) or next;
 231
 232     push @create, "--\n-- Table: $table_name_ur\n--" unless $options->{no_comments};
 233     push @create, qq[DROP TABLE $table_name_ur CASCADE CONSTRAINTS] if $options->{add_drop_table};
 234
 235         my ( %field_name_scope, @field_comments );
 236         for my $field ( $table->get_fields ) {
 237             my ($field_create, $field_defs, $trigger_defs, $field_comments) =
 238               create_field($field, $options, \%field_name_scope);
 239             push @create, @$field_create if ref $field_create;
 240             push @field_defs, @$field_defs if ref $field_defs;
 241             push @trigger_defs, @$trigger_defs if ref $trigger_defs;
 242             push @field_comments, @$field_comments if ref $field_comments;
 243         }
 244
 245         #
 246         # Table options
 247         #
 248         my @table_options;
 249         for my $opt ( $table->options ) {
 250             if ( ref $opt eq 'HASH' ) {
 251                 my ( $key, $value ) = each %$opt;
 252                 if ( ref $value eq 'ARRAY' ) {
 253                     push @table_options, "$key\n(\n".  join ("\n",
 254                         map { "  $_->[0]\t$_->[1]" }
 255                         map { [ each %$_ ] }
 256                         @$value
 257                     )."\n)";
 258                 }
 259                 elsif ( !defined $value ) {
 260                     push @table_options, $key;
 261                 }
 262                 else {
 263                     push @table_options, "$key    $value";
 264                 }
 265             }
 266         }
 267
 268         #
 269         # Table constraints
 270         #
 271         for my $c ( $table->get_constraints ) {
 272             my $name    = $c->name || '';
 273             my @fields  = map { unreserve( $_, $table_name ) } $c->fields;
 274             my @rfields = map { unreserve( $_, $table_name ) }
 275                 $c->reference_fields;
 276             next if !@fields && $c->type ne CHECK_C;
 277
 278             if ( $c->type eq PRIMARY_KEY ) {
 279                 # create a name if delay_constraints
 280                 $name ||= mk_name( $table_name, 'pk' )
 281                   if $options->{delay_constraints};
 282                 push @constraint_defs, ($name ? "CONSTRAINT $name " : '') .
 283                         'PRIMARY KEY (' . join( ', ', @fields ) . ')';
 284             }
 285             elsif ( $c->type eq UNIQUE ) {
 286                 # Don't create UNIQUE constraints identical to the primary key
 287                 if ( my $pk = $table->primary_key ) {
 288                                         my $u_fields = join(":", @fields);
 289                                         my $pk_fields = join(":", $pk->fields);
 290                                         next if $u_fields eq $pk_fields;
 291                 }
 292
 293                 $name ||= mk_name( $name || $table_name, 'u' );
 294
 295                 for my $f ( $c->fields ) {
 296                     my $field_def = $table->get_field( $f ) or next;
 297                     my $dtype     = $translate{ $field_def->data_type } or next;
 298                     if ( $WARN && $dtype =~ /clob/i ) {
 299                         warn "Oracle will not allow UNIQUE constraints on " .
 300                              "CLOB field '" . $field_def->table->name . '.' .
 301                              $field_def->name . ".'\n"
 302                     }
 303                 }
 304
 305                 push @constraint_defs, "CONSTRAINT $name UNIQUE " .
 306                     '(' . join( ', ', @fields ) . ')';
 307             }
 308             elsif ( $c->type eq CHECK_C ) {
 309                 $name ||= mk_name( $name || $table_name, 'ck' );
 310                 my $expression = $c->expression || '';
 311                 push @constraint_defs, "CONSTRAINT $name CHECK ($expression)";
 312             }
 313             elsif ( $c->type eq FOREIGN_KEY ) {
 314             $name = mk_name( join('_', $table_name, $c->fields). '_fk' );
 315                 my $def = "CONSTRAINT $name FOREIGN KEY ";
 316
 317                 if ( @fields ) {
 318                     $def .= '(' . join( ', ', @fields ) . ')';
 319                 }
 320
 321                 my $ref_table = unreserve($c->reference_table);
 322
 323                 $def .= " REFERENCES $ref_table";
 324
 325                 if ( @rfields ) {
 326                     $def .= ' (' . join( ', ', @rfields ) . ')';
 327                 }
 328
 329                 if ( $c->match_type ) {
 330                     $def .= ' MATCH ' .
 331                         ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 332                 }
 333
 334                 if ( $c->on_delete ) {
 335                     $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 336                 }
 337
 338             # disabled by plu 2007-12-29 - doesn't exist for oracle
 339             #if ( $c->on_update ) {
 340             #    $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 341             #}
 342
 343             push @fk_defs, sprintf("ALTER TABLE %s ADD %s", $table, $def);
 344             }
 345         }
 346
 347         #
 348         # Index Declarations
 349         #
 350         my @index_defs = ();
 351         for my $index ( $table->get_indices ) {
 352             my $index_name = $index->name || '';
 353             my $index_type = $index->type || NORMAL;
 354             my @fields     = map { unreserve( $_, $table_name ) }
 355                              $index->fields;
 356             next unless @fields;
 357
 358             my @index_options;
 359             for my $opt ( $index->options ) {
 360                 if ( ref $opt eq 'HASH' ) {
 361                     my ( $key, $value ) = each %$opt;
 362                     if ( ref $value eq 'ARRAY' ) {
 363                         push @table_options, "$key\n(\n".  join ("\n",
 364                             map { "  $_->[0]\t$_->[1]" }
 365                             map { [ each %$_ ] }
 366                            @$value
 367                         )."\n)";
 368                     }
 369                     elsif ( !defined $value ) {
 370                         push @index_options, $key;
 371                     }
 372                     else {
 373                         push @index_options, "$key    $value";
 374                     }
 375                 }
 376             }
 377             my $index_options = @index_options
 378               ? "\n".join("\n", @index_options) : '';
 379
 380             if ( $index_type eq PRIMARY_KEY ) {
 381                 $index_name = $index_name ? mk_name( $index_name )
 382                     : mk_name( $table_name, 'pk' );
 383                 push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
 384                     '(' . join( ', ', @fields ) . ')';
 385             }
 386             elsif ( $index_type eq NORMAL ) {
 387                 $index_name = $index_name ? mk_name( $index_name )
 388                     : mk_name( $table_name, $index_name || 'i' );
 389                 push @index_defs,
 390                     "CREATE INDEX $index_name on $table_name_ur (".
 391                         join( ', ', @fields ).
 392                     ")$index_options";
 393             }
 394             elsif ( $index_type eq UNIQUE ) {
 395                 $index_name = $index_name ? mk_name( $index_name )
 396                     : mk_name( $table_name, $index_name || 'i' );
 397                 push @index_defs,
 398                     "CREATE UNIQUE INDEX $index_name on $table_name_ur (".
 399                         join( ', ', @fields ).
 400                     ")$index_options";
 401             }
 402             else {
 403                 warn "Unknown index type ($index_type) on table $table_name.\n"
 404                     if $WARN;
 405             }
 406         }
 407
 408         if ( my @table_comments = $table->comments ) {
 409             for my $comment ( @table_comments ) {
 410                 next unless $comment;
 411                 $comment =~ s/'/''/g;
 412                 push @field_comments, "COMMENT ON TABLE $table_name_ur is\n '".
 413                 $comment . "'" unless $options->{no_comments}
 414                 ;
 415             }
 416         }
 417
 418         my $table_options = @table_options
 419             ? "\n".join("\n", @table_options) : '';
 420     push @create, "CREATE TABLE $table_name_ur (\n" .
 421             join( ",\n", map { "  $_" } @field_defs,
 422             ($options->{delay_constraints} ? () : @constraint_defs) ) .
 423             "\n)$table_options";
 424
 425     @constraint_defs = map { 'ALTER TABLE '.$table_name_ur.' ADD '.$_  }
 426       @constraint_defs;
 427
 428     if ( $WARN ) {
 429         if ( %truncated ) {
 430             warn "Truncated " . keys( %truncated ) . " names:\n";
 431             warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
 432         }
 433
 434         if ( %unreserve ) {
 435             warn "Encounted " . keys( %unreserve ) .
 436                 " unsafe names in schema (reserved or invalid):\n";
 437             warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
 438         }
 439     }
 440
 441     return \@create, \@fk_defs, \@trigger_defs, \@index_defs, ($options->{delay_constraints} ? \@constraint_defs : []);
 442 }
 443
 444 sub alter_field {
 445     my ($from_field, $to_field, $options) = @_;
 446
 447     my ($field_create, $field_defs, $trigger_defs, $field_comments) =
 448       create_field($to_field, $options, {});
 449
 450     # Fix ORA-01442
 451     if ($to_field->is_nullable && !$from_field->is_nullable) {
 452         die 'Cannot remove NOT NULL from table field';
 453     } elsif (!$from_field->is_nullable && !$to_field->is_nullable) {
 454         @$field_defs = map { s/ NOT NULL//; $_} @$field_defs;
 455     }
 456
 457     my $table_name = $to_field->table->name;
 458     my $table_name_ur = unreserve( $table_name );
 459
 460     return 'ALTER TABLE '.$table_name_ur.' MODIFY ( '.join('', @$field_defs).' )';
 461 }
 462
 463 sub add_field {
 464     my ($new_field, $options) = @_;
 465
 466     my ($field_create, $field_defs, $trigger_defs, $field_comments) =
 467       create_field($new_field, $options, {});
 468
 469     my $table_name = $new_field->table->name;
 470     my $table_name_ur = unreserve( $table_name );
 471
 472     my $out = sprintf('ALTER TABLE %s ADD ( %s )',
 473                       $table_name_ur,
 474                       join('', @$field_defs));
 475     return $out;
 476 }
 477
 478 sub create_field {
 479     my ($field, $options, $field_name_scope) = @_;
 480
 481     my (@create, @field_defs, @trigger_defs, @field_comments);
 482
 483     my $table_name = $field->table->name;
 484     my $table_name_ur = unreserve( $table_name );
 485
 486     #
 487     # Field name
 488     #
 489     my $field_name    = mk_name(
 490                                 $field->name, '', $field_name_scope, 1
 491                                );
 492
 493     my $field_name_ur = unreserve( $field_name, $table_name );
 494     my $field_def     = $field_name_ur;
 495     $field->name( $field_name_ur );
 496
 497     #
 498     # Datatype
 499     #
 500     my $check;
 501     my $data_type = lc $field->data_type;
 502     my @size      = $field->size;
 503     my %extra     = $field->extra;
 504     my $list      = $extra{'list'} || [];
 505     # \todo deal with embedded quotes
 506     my $commalist = join( ', ', map { qq['$_'] } @$list );
 507
 508     if ( $data_type eq 'enum' ) {
 509         $check = "CHECK ($field_name_ur IN ($commalist))";
 510         $data_type = 'varchar2';
 511     }
 512     elsif ( $data_type eq 'set' ) {
 513         # XXX add a CHECK constraint maybe
 514         # (trickier and slower, than enum :)
 515         $data_type = 'varchar2';
 516     }
 517     else {
 518         $data_type  = defined $translate{ $data_type } ?
 519           $translate{ $data_type } :
 520             $data_type;
 521         $data_type ||= 'varchar2';
 522     }
 523
 524     # ensure size is not bigger than max size oracle allows for data type
 525     if ( defined $max_size{$data_type} ) {
 526         for ( my $i = 0 ; $i < scalar @size ; $i++ ) {
 527             my $max =
 528               ref( $max_size{$data_type} ) eq 'ARRAY'
 529               ? $max_size{$data_type}->[$i]
 530               : $max_size{$data_type};
 531             $size[$i] = $max if $size[$i] > $max;
 532         }
 533     }
 534
 535     #
 536     # Fixes ORA-02329: column of datatype LOB cannot be
 537     # unique or a primary key
 538     #
 539     if ( $data_type eq 'clob' && $field->is_primary_key ) {
 540         $data_type = 'varchar2';
 541         $size[0]   = 4000;
 542         warn "CLOB cannot be a primary key, changing to VARCHAR2\n"
 543           if $WARN;
 544     }
 545
 546     if ( $data_type eq 'clob' && $field->is_unique ) {
 547         $data_type = 'varchar2';
 548         $size[0]   = 4000;
 549         warn "CLOB cannot be a unique key, changing to VARCHAR2\n"
 550           if $WARN;
 551     }
 552
 553     #
 554     # Fixes ORA-00907: missing right parenthesis
 555     #
 556     if ( $data_type =~ /(date|clob)/i ) {
 557         undef @size;
 558     }
 559
 560     $field_def .= " $data_type";
 561     if ( defined $size[0] && $size[0] > 0 ) {
 562         $field_def .= '(' . join( ', ', @size ) . ')';
 563     }
 564
 565     #
 566     # Default value
 567     #
 568     my $default = $field->default_value;
 569     if ( defined $default ) {
 570         #
 571         # Wherein we try to catch a string being used as
 572         # a default value for a numerical field.  If "true/false,"
 573         # then sub "1/0," otherwise just test the truthity of the
 574         # argument and use that (naive?).
 575         #
 576         if (ref $default and defined $$default) {
 577           $default = $$default;
 578         } elsif (ref $default) {
 579           $default = 'NULL';
 580         } elsif (
 581             $data_type =~ /^number$/i &&
 582             $default   !~ /^-?\d+$/     &&
 583             $default   !~ m/null/i
 584            ) {
 585             if ( $default =~ /^true$/i ) {
 586                 $default = "'1'";
 587             } elsif ( $default =~ /^false$/i ) {
 588                 $default = "'0'";
 589             } else {
 590                 $default = $default ? "'1'" : "'0'";
 591             }
 592         } elsif (
 593                  $data_type =~ /date/ && (
 594                                           $default eq 'current_timestamp'
 595                                           ||
 596                                           $default eq 'now()'
 597                                          )
 598                 ) {
 599             $default = 'SYSDATE';
 600         } else {
 601             $default = $default =~ m/null/i ? 'NULL' : "'$default'"
 602         }
 603
 604         $field_def .= " DEFAULT $default",
 605     }
 606
 607     #
 608     # Not null constraint
 609     #
 610     unless ( $field->is_nullable ) {
 611         $field_def .= ' NOT NULL';
 612     }
 613
 614     $field_def .= " $check" if $check;
 615
 616     #
 617     # Auto_increment
 618     #
 619     if ( $field->is_auto_increment ) {
 620         my $base_name    = $table_name_ur . "_". $field_name;
 621         my $seq_name     = mk_name( $base_name, 'sq' );
 622         my $trigger_name = mk_name( $base_name, 'ai' );
 623
 624         push @create, qq[DROP SEQUENCE $seq_name] if $options->{add_drop_table};
 625         push @create, "CREATE SEQUENCE $seq_name";
 626         push @trigger_defs,
 627           "CREATE OR REPLACE TRIGGER $trigger_name\n" .
 628           "BEFORE INSERT ON $table_name_ur\n" .
 629           "FOR EACH ROW WHEN (\n" .
 630           " new.$field_name_ur IS NULL".
 631           " OR new.$field_name_ur = 0\n".
 632           ")\n".
 633           "BEGIN\n" .
 634           " SELECT $seq_name.nextval\n" .
 635           " INTO :new." . $field->name."\n" .
 636           " FROM dual;\n" .
 637           "END\n/";
 638         ;
 639     }
 640
 641     if ( lc $field->data_type eq 'timestamp' ) {
 642         my $base_name = $table_name_ur . "_". $field_name_ur;
 643         my $trig_name = mk_name( $base_name, 'ts' );
 644         push @trigger_defs,
 645           "CREATE OR REPLACE TRIGGER $trig_name\n".
 646           "BEFORE INSERT OR UPDATE ON $table_name_ur\n".
 647           "FOR EACH ROW WHEN (new.$field_name_ur IS NULL)\n".
 648           "BEGIN \n".
 649           " SELECT sysdate INTO :new.$field_name_ur FROM dual;\n".
 650           "END\n/";
 651     }
 652
 653     push @field_defs, $field_def;
 654
 655     if ( my $comment = $field->comments ) {
 656         $comment =~ s/'/''/g;
 657         push @field_comments,
 658           "COMMENT ON COLUMN $table_name_ur.$field_name_ur is\n '" .
 659             $comment . "';" unless $options->{no_comments};
 660     }
 661
 662     return \@create, \@field_defs, \@trigger_defs, \@field_comments;
 663
 664 }
 665
 666
 667 sub create_view {
 668     my ($view) = @_;
 669
 670     my $out = sprintf("CREATE VIEW %s AS\n%s;",
 671                       $view->name,
 672                       $view->sql);
 673
 674     return $out;
 675 }
 676
 677 # -------------------------------------------------------------------
 678 sub mk_name {
 679     my $basename      = shift || '';
 680     my $type          = shift || '';
 681        $type          = '' if $type =~ /^\d/;
 682     my $scope         = shift || '';
 683     my $critical      = shift || '';
 684     my $basename_orig = $basename;
 685     my $max_name      = $type
 686                         ? $max_id_length - (length($type) + 1)
 687                         : $max_id_length;
 688     $basename         = substr( $basename, 0, $max_name )
 689                         if length( $basename ) > $max_name;
 690     my $name          = $type ? "${type}_$basename" : $basename;
 691
 692     if ( $basename ne $basename_orig and $critical ) {
 693         my $show_type = $type ? "+'$type'" : "";
 694         warn "Truncating '$basename_orig'$show_type to $max_id_length ",
 695             "character limit to make '$name'\n" if $WARN;
 696         $truncated{ $basename_orig } = $name;
 697     }
 698
 699     $scope ||= \%global_names;
 700     if ( my $prev = $scope->{ $name } ) {
 701         my $name_orig = $name;
 702         substr($name, $max_id_length - 2) = ""
 703             if length( $name ) >= $max_id_length - 1;
 704         $name        .= sprintf( "%02d", $prev++ );
 705
 706         warn "The name '$name_orig' has been changed to ",
 707              "'$name' to make it unique.\n" if $WARN;
 708
 709         $scope->{ $name_orig }++;
 710     }
 711
 712     $scope->{ $name }++;
 713     return $name;
 714 }
 715
 716 # -------------------------------------------------------------------
 717 sub unreserve {
 718     my $name            = shift || '';
 719     my $schema_obj_name = shift || '';
 720
 721     my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
 722
 723     # also trap fields that don't begin with a letter
 724     return $name if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i;
 725
 726     if ( $schema_obj_name ) {
 727         ++$unreserve{"$schema_obj_name.$name"};
 728     }
 729     else {
 730         ++$unreserve{"$name (table name)"};
 731     }
 732
 733     my $unreserve = sprintf '%s_', $name;
 734     return $unreserve.$suffix;
 735 }
 736
 737 1;
 738
 739 # -------------------------------------------------------------------
 740 # All bad art is the result of good intentions.
 741 # Oscar Wilde
 742 # -------------------------------------------------------------------
 743
 744 =pod
 745
 746 =head1 CREDITS
 747
 748 Mad props to Tim Bunce for much of the logic stolen from his "mysql2ora"
 749 script.
 750
 751 =head1 AUTHOR
 752
 753 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 754
 755 =head1 SEE ALSO
 756
 757 SQL::Translator, DDL::Oracle, mysql2ora.
 758
 759 =cut