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