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