lib/SQL/Translator/Producer/Oracle.pm

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