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     if (wantarray) {
 220         return defined $create ? $create : (), @table_defs, @view_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs;
 221     }
 222     else {
 223         $create .= join ('', map { $_ ? "$_;\n\n" : () } @table_defs, @view_defs, @fk_defs, @index_defs, @constraint_defs);
 224         # triggers may NOT end with a semicolon
 225         $create .= join "\n\n", @trigger_defs;
 226         return $create;
 227     }
 228 }
 229
 230 sub create_table {
 231     my ($table, $options) = @_;
 232     my $table_name = $table->name;
 233
 234     my $item = '';
 235     my $drop;
 236     my (@create, @field_defs, @constraint_defs, @fk_defs, @trigger_defs);
 237
 238     my $table_name_ur = unreserve($table_name) or next;
 239
 240     push @create, "--\n-- Table: $table_name_ur\n--" unless $options->{no_comments};
 241     push @create, qq[DROP TABLE $table_name_ur CASCADE CONSTRAINTS] if $options->{add_drop_table};
 242
 243         my ( %field_name_scope, @field_comments );
 244         for my $field ( $table->get_fields ) {
 245             my ($field_create, $field_defs, $trigger_defs, $field_comments) =
 246               create_field($field, $options, \%field_name_scope);
 247             push @create, @$field_create if ref $field_create;
 248             push @field_defs, @$field_defs if ref $field_defs;
 249             push @trigger_defs, @$trigger_defs if ref $trigger_defs;
 250             push @field_comments, @$field_comments if ref $field_comments;
 251         }
 252
 253         #
 254         # Table options
 255         #
 256         my @table_options;
 257         for my $opt ( $table->options ) {
 258             if ( ref $opt eq 'HASH' ) {
 259                 my ( $key, $value ) = each %$opt;
 260                 if ( ref $value eq 'ARRAY' ) {
 261                     push @table_options, "$key\n(\n".  join ("\n",
 262                         map { "  $_->[0]\t$_->[1]" }
 263                         map { [ each %$_ ] }
 264                         @$value
 265                     )."\n)";
 266                 }
 267                 elsif ( !defined $value ) {
 268                     push @table_options, $key;
 269                 }
 270                 else {
 271                     push @table_options, "$key    $value";
 272                 }
 273             }
 274         }
 275
 276         #
 277         # Table constraints
 278         #
 279         for my $c ( $table->get_constraints ) {
 280             my $name    = $c->name || '';
 281             my @fields  = map { unreserve( $_, $table_name ) } $c->fields;
 282             my @rfields = map { unreserve( $_, $table_name ) }
 283                 $c->reference_fields;
 284             next if !@fields && $c->type ne CHECK_C;
 285
 286             if ( $c->type eq PRIMARY_KEY ) {
 287                 # create a name if delay_constraints
 288                 $name ||= mk_name( $table_name, 'pk' )
 289                   if $options->{delay_constraints};
 290                 push @constraint_defs, ($name ? "CONSTRAINT $name " : '') .
 291                         'PRIMARY KEY (' . join( ', ', @fields ) . ')';
 292             }
 293             elsif ( $c->type eq UNIQUE ) {
 294                 # Don't create UNIQUE constraints identical to the primary key
 295                 if ( my $pk = $table->primary_key ) {
 296                                         my $u_fields = join(":", @fields);
 297                                         my $pk_fields = join(":", $pk->fields);
 298                                         next if $u_fields eq $pk_fields;
 299                 }
 300
 301                 $name ||= mk_name( $name || $table_name, 'u' );
 302
 303                 for my $f ( $c->fields ) {
 304                     my $field_def = $table->get_field( $f ) or next;
 305                     my $dtype     = $translate{ $field_def->data_type } or next;
 306                     if ( $WARN && $dtype =~ /clob/i ) {
 307                         warn "Oracle will not allow UNIQUE constraints on " .
 308                              "CLOB field '" . $field_def->table->name . '.' .
 309                              $field_def->name . ".'\n"
 310                     }
 311                 }
 312
 313                 push @constraint_defs, "CONSTRAINT $name UNIQUE " .
 314                     '(' . join( ', ', @fields ) . ')';
 315             }
 316             elsif ( $c->type eq CHECK_C ) {
 317                 $name ||= mk_name( $name || $table_name, 'ck' );
 318                 my $expression = $c->expression || '';
 319                 push @constraint_defs, "CONSTRAINT $name CHECK ($expression)";
 320             }
 321             elsif ( $c->type eq FOREIGN_KEY ) {
 322                 $name = mk_name( join('_', $table_name, $c->fields). '_fk' );
 323                 my $def = "CONSTRAINT $name FOREIGN KEY ";
 324
 325                 if ( @fields ) {
 326                     $def .= '(' . join( ', ', @fields ) . ')';
 327                 }
 328
 329                 my $ref_table = unreserve($c->reference_table);
 330
 331                 $def .= " REFERENCES $ref_table";
 332
 333                 if ( @rfields ) {
 334                     $def .= ' (' . join( ', ', @rfields ) . ')';
 335                 }
 336
 337                 if ( $c->match_type ) {
 338                     $def .= ' MATCH ' .
 339                         ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 340                 }
 341
 342                 if ( $c->on_delete ) {
 343                     $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 344                 }
 345
 346                 # disabled by plu 2007-12-29 - doesn't exist for oracle
 347                 #if ( $c->on_update ) {
 348                 #    $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 349                 #}
 350
 351                 push @fk_defs, sprintf("ALTER TABLE %s ADD %s", $table_name_ur, $def);
 352             }
 353         }
 354
 355         #
 356         # Index Declarations
 357         #
 358         my @index_defs = ();
 359         for my $index ( $table->get_indices ) {
 360             my $index_name = $index->name || '';
 361             my $index_type = $index->type || NORMAL;
 362             my @fields     = map { unreserve( $_, $table_name ) }
 363                              $index->fields;
 364             next unless @fields;
 365
 366             my @index_options;
 367             for my $opt ( $index->options ) {
 368                 if ( ref $opt eq 'HASH' ) {
 369                     my ( $key, $value ) = each %$opt;
 370                     if ( ref $value eq 'ARRAY' ) {
 371                         push @table_options, "$key\n(\n".  join ("\n",
 372                             map { "  $_->[0]\t$_->[1]" }
 373                             map { [ each %$_ ] }
 374                            @$value
 375                         )."\n)";
 376                     }
 377                     elsif ( !defined $value ) {
 378                         push @index_options, $key;
 379                     }
 380                     else {
 381                         push @index_options, "$key    $value";
 382                     }
 383                 }
 384             }
 385             my $index_options = @index_options
 386               ? "\n".join("\n", @index_options) : '';
 387
 388             if ( $index_type eq PRIMARY_KEY ) {
 389                 $index_name = $index_name ? mk_name( $index_name )
 390                     : mk_name( $table_name, 'pk' );
 391                 push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
 392                     '(' . join( ', ', @fields ) . ')';
 393             }
 394             elsif ( $index_type eq NORMAL ) {
 395                 $index_name = $index_name ? mk_name( $index_name )
 396                     : mk_name( $table_name, $index_name || 'i' );
 397                 push @index_defs,
 398                     "CREATE INDEX $index_name on $table_name_ur (".
 399                         join( ', ', @fields ).
 400                     ")$index_options";
 401             }
 402             elsif ( $index_type eq UNIQUE ) {
 403                 $index_name = $index_name ? mk_name( $index_name )
 404                     : mk_name( $table_name, $index_name || 'i' );
 405                 push @index_defs,
 406                     "CREATE UNIQUE INDEX $index_name on $table_name_ur (".
 407                         join( ', ', @fields ).
 408                     ")$index_options";
 409             }
 410             else {
 411                 warn "Unknown index type ($index_type) on table $table_name.\n"
 412                     if $WARN;
 413             }
 414         }
 415
 416         if ( my @table_comments = $table->comments ) {
 417             for my $comment ( @table_comments ) {
 418                 next unless $comment;
 419                 $comment =~ s/'/''/g;
 420                 push @field_comments, "COMMENT ON TABLE $table_name_ur is\n '".
 421                 $comment . "'" unless $options->{no_comments}
 422                 ;
 423             }
 424         }
 425
 426         my $table_options = @table_options
 427             ? "\n".join("\n", @table_options) : '';
 428     push @create, "CREATE TABLE $table_name_ur (\n" .
 429             join( ",\n", map { "  $_" } @field_defs,
 430             ($options->{delay_constraints} ? () : @constraint_defs) ) .
 431             "\n)$table_options";
 432
 433     @constraint_defs = map { 'ALTER TABLE '.$table_name_ur.' ADD '.$_  }
 434       @constraint_defs;
 435
 436     if ( $WARN ) {
 437         if ( %truncated ) {
 438             warn "Truncated " . keys( %truncated ) . " names:\n";
 439             warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
 440         }
 441
 442         if ( %unreserve ) {
 443             warn "Encounted " . keys( %unreserve ) .
 444                 " unsafe names in schema (reserved or invalid):\n";
 445             warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
 446         }
 447     }
 448
 449     return \@create, \@fk_defs, \@trigger_defs, \@index_defs, ($options->{delay_constraints} ? \@constraint_defs : []);
 450 }
 451
 452 sub alter_field {
 453     my ($from_field, $to_field, $options) = @_;
 454
 455     my ($field_create, $field_defs, $trigger_defs, $field_comments) =
 456       create_field($to_field, $options, {});
 457
 458     # Fix ORA-01442
 459     if ($to_field->is_nullable && !$from_field->is_nullable) {
 460         die 'Cannot remove NOT NULL from table field';
 461     } elsif (!$from_field->is_nullable && !$to_field->is_nullable) {
 462         @$field_defs = map { s/ NOT NULL//; $_} @$field_defs;
 463     }
 464
 465     my $table_name = $to_field->table->name;
 466     my $table_name_ur = unreserve( $table_name );
 467
 468     return 'ALTER TABLE '.$table_name_ur.' MODIFY ( '.join('', @$field_defs).' )';
 469 }
 470
 471 sub add_field {
 472     my ($new_field, $options) = @_;
 473
 474     my ($field_create, $field_defs, $trigger_defs, $field_comments) =
 475       create_field($new_field, $options, {});
 476
 477     my $table_name = $new_field->table->name;
 478     my $table_name_ur = unreserve( $table_name );
 479
 480     my $out = sprintf('ALTER TABLE %s ADD ( %s )',
 481                       $table_name_ur,
 482                       join('', @$field_defs));
 483     return $out;
 484 }
 485
 486 sub create_field {
 487     my ($field, $options, $field_name_scope) = @_;
 488
 489     my (@create, @field_defs, @trigger_defs, @field_comments);
 490
 491     my $table_name = $field->table->name;
 492     my $table_name_ur = unreserve( $table_name );
 493
 494     #
 495     # Field name
 496     #
 497     my $field_name    = mk_name(
 498                                 $field->name, '', $field_name_scope, 1
 499                                );
 500
 501     my $field_name_ur = unreserve( $field_name, $table_name );
 502     my $field_def     = $field_name_ur;
 503     $field->name( $field_name_ur );
 504
 505     #
 506     # Datatype
 507     #
 508     my $check;
 509     my $data_type = lc $field->data_type;
 510     my @size      = $field->size;
 511     my %extra     = $field->extra;
 512     my $list      = $extra{'list'} || [];
 513     # \todo deal with embedded quotes
 514     my $commalist = join( ', ', map { qq['$_'] } @$list );
 515
 516     if ( $data_type eq 'enum' ) {
 517         $check = "CHECK ($field_name_ur IN ($commalist))";
 518         $data_type = 'varchar2';
 519     }
 520     elsif ( $data_type eq 'set' ) {
 521         # XXX add a CHECK constraint maybe
 522         # (trickier and slower, than enum :)
 523         $data_type = 'varchar2';
 524     }
 525     else {
 526         $data_type  = defined $translate{ $data_type } ?
 527           $translate{ $data_type } :
 528             $data_type;
 529         $data_type ||= 'varchar2';
 530     }
 531
 532     # ensure size is not bigger than max size oracle allows for data type
 533     if ( defined $max_size{$data_type} ) {
 534         for ( my $i = 0 ; $i < scalar @size ; $i++ ) {
 535             my $max =
 536               ref( $max_size{$data_type} ) eq 'ARRAY'
 537               ? $max_size{$data_type}->[$i]
 538               : $max_size{$data_type};
 539             $size[$i] = $max if $size[$i] > $max;
 540         }
 541     }
 542
 543     #
 544     # Fixes ORA-02329: column of datatype LOB cannot be
 545     # unique or a primary key
 546     #
 547     if ( $data_type eq 'clob' && $field->is_primary_key ) {
 548         $data_type = 'varchar2';
 549         $size[0]   = 4000;
 550         warn "CLOB cannot be a primary key, changing to VARCHAR2\n"
 551           if $WARN;
 552     }
 553
 554     if ( $data_type eq 'clob' && $field->is_unique ) {
 555         $data_type = 'varchar2';
 556         $size[0]   = 4000;
 557         warn "CLOB cannot be a unique key, changing to VARCHAR2\n"
 558           if $WARN;
 559     }
 560
 561     #
 562     # Fixes ORA-00907: missing right parenthesis
 563     #
 564     if ( $data_type =~ /(date|clob)/i ) {
 565         undef @size;
 566     }
 567
 568     $field_def .= " $data_type";
 569     if ( defined $size[0] && $size[0] > 0 ) {
 570         $field_def .= '(' . join( ', ', @size ) . ')';
 571     }
 572
 573     #
 574     # Default value
 575     #
 576     my $default = $field->default_value;
 577     if ( defined $default ) {
 578         #
 579         # Wherein we try to catch a string being used as
 580         # a default value for a numerical field.  If "true/false,"
 581         # then sub "1/0," otherwise just test the truthity of the
 582         # argument and use that (naive?).
 583         #
 584         if (ref $default and defined $$default) {
 585           $default = $$default;
 586         } elsif (ref $default) {
 587           $default = 'NULL';
 588         } elsif (
 589             $data_type =~ /^number$/i &&
 590             $default   !~ /^-?\d+$/     &&
 591             $default   !~ m/null/i
 592            ) {
 593             if ( $default =~ /^true$/i ) {
 594                 $default = "'1'";
 595             } elsif ( $default =~ /^false$/i ) {
 596                 $default = "'0'";
 597             } else {
 598                 $default = $default ? "'1'" : "'0'";
 599             }
 600         } elsif (
 601                  $data_type =~ /date/ && (
 602                                           $default eq 'current_timestamp'
 603                                           ||
 604                                           $default eq 'now()'
 605                                          )
 606                 ) {
 607             $default = 'SYSDATE';
 608         } else {
 609             $default = $default =~ m/null/i ? 'NULL' : "'$default'"
 610         }
 611
 612         $field_def .= " DEFAULT $default",
 613     }
 614
 615     #
 616     # Not null constraint
 617     #
 618     unless ( $field->is_nullable ) {
 619         $field_def .= ' NOT NULL';
 620     }
 621
 622     $field_def .= " $check" if $check;
 623
 624     #
 625     # Auto_increment
 626     #
 627     if ( $field->is_auto_increment ) {
 628         my $base_name    = $table_name_ur . "_". $field_name;
 629         my $seq_name     = mk_name( $base_name, 'sq' );
 630         my $trigger_name = mk_name( $base_name, 'ai' );
 631
 632         push @create, qq[DROP SEQUENCE $seq_name] if $options->{add_drop_table};
 633         push @create, "CREATE SEQUENCE $seq_name";
 634         push @trigger_defs,
 635           "CREATE OR REPLACE TRIGGER $trigger_name\n" .
 636           "BEFORE INSERT ON $table_name_ur\n" .
 637           "FOR EACH ROW WHEN (\n" .
 638           " new.$field_name_ur IS NULL".
 639           " OR new.$field_name_ur = 0\n".
 640           ")\n".
 641           "BEGIN\n" .
 642           " SELECT $seq_name.nextval\n" .
 643           " INTO :new." . $field->name."\n" .
 644           " FROM dual;\n" .
 645           "END;\n/";
 646         ;
 647     }
 648
 649     if ( lc $field->data_type eq 'timestamp' ) {
 650         my $base_name = $table_name_ur . "_". $field_name_ur;
 651         my $trig_name = mk_name( $base_name, 'ts' );
 652         push @trigger_defs,
 653           "CREATE OR REPLACE TRIGGER $trig_name\n".
 654           "BEFORE INSERT OR UPDATE ON $table_name_ur\n".
 655           "FOR EACH ROW WHEN (new.$field_name_ur IS NULL)\n".
 656           "BEGIN \n".
 657           " SELECT sysdate INTO :new.$field_name_ur FROM dual;\n".
 658           "END;\n/";
 659     }
 660
 661     push @field_defs, $field_def;
 662
 663     if ( my $comment = $field->comments ) {
 664         $comment =~ s/'/''/g;
 665         push @field_comments,
 666           "COMMENT ON COLUMN $table_name_ur.$field_name_ur is\n '" .
 667             $comment . "';" unless $options->{no_comments};
 668     }
 669
 670     return \@create, \@field_defs, \@trigger_defs, \@field_comments;
 671
 672 }
 673
 674
 675 sub create_view {
 676     my ($view) = @_;
 677
 678     my $out = sprintf("CREATE VIEW %s AS\n%s;",
 679                       $view->name,
 680                       $view->sql);
 681
 682     return $out;
 683 }
 684
 685 # -------------------------------------------------------------------
 686 sub mk_name {
 687     my $basename      = shift || '';
 688     my $type          = shift || '';
 689        $type          = '' if $type =~ /^\d/;
 690     my $scope         = shift || '';
 691     my $critical      = shift || '';
 692     my $basename_orig = $basename;
 693     my $max_name      = $type
 694                         ? $max_id_length - (length($type) + 1)
 695                         : $max_id_length;
 696     $basename         = substr( $basename, 0, $max_name )
 697                         if length( $basename ) > $max_name;
 698     my $name          = $type ? "${type}_$basename" : $basename;
 699
 700     if ( $basename ne $basename_orig and $critical ) {
 701         my $show_type = $type ? "+'$type'" : "";
 702         warn "Truncating '$basename_orig'$show_type to $max_id_length ",
 703             "character limit to make '$name'\n" if $WARN;
 704         $truncated{ $basename_orig } = $name;
 705     }
 706
 707     $scope ||= \%global_names;
 708     if ( my $prev = $scope->{ $name } ) {
 709         my $name_orig = $name;
 710         substr($name, $max_id_length - 2) = ""
 711             if length( $name ) >= $max_id_length - 1;
 712         $name        .= sprintf( "%02d", $prev++ );
 713
 714         warn "The name '$name_orig' has been changed to ",
 715              "'$name' to make it unique.\n" if $WARN;
 716
 717         $scope->{ $name_orig }++;
 718     }
 719
 720     $scope->{ $name }++;
 721     return $name;
 722 }
 723
 724 # -------------------------------------------------------------------
 725 sub unreserve {
 726     my $name            = shift || '';
 727     my $schema_obj_name = shift || '';
 728
 729     my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
 730
 731     # also trap fields that don't begin with a letter
 732     return $name if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i;
 733
 734     if ( $schema_obj_name ) {
 735         ++$unreserve{"$schema_obj_name.$name"};
 736     }
 737     else {
 738         ++$unreserve{"$name (table name)"};
 739     }
 740
 741     my $unreserve = sprintf '%s_', $name;
 742     return $unreserve.$suffix;
 743 }
 744
 745 1;
 746
 747 # -------------------------------------------------------------------
 748 # All bad art is the result of good intentions.
 749 # Oscar Wilde
 750 # -------------------------------------------------------------------
 751
 752 =pod
 753
 754 =head1 CREDITS
 755
 756 Mad props to Tim Bunce for much of the logic stolen from his "mysql2ora"
 757 script.
 758
 759 =head1 AUTHOR
 760
 761 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 762
 763 =head1 SEE ALSO
 764
 765 SQL::Translator, DDL::Oracle, mysql2ora.
 766
 767 =cut