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