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