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