lib/SQL/Translator/Producer/Oracle.pm

   1 package SQL::Translator::Producer::Oracle;
   2
   3 =head1 NAME
   4
   5 SQL::Translator::Producer::Oracle - Oracle SQL producer
   6
   7 =head1 SYNOPSIS
   8
   9   use SQL::Translator;
  10
  11   my $t = SQL::Translator->new( parser => '...', producer => 'Oracle' );
  12   print $translator->translate( $file );
  13
  14 =head1 DESCRIPTION
  15
  16 Creates an SQL DDL suitable for Oracle.
  17
  18 =head1 producer_args
  19
  20 =over
  21
  22 =item delay_constraints
  23
  24 This option remove the primary key and other key constraints from the
  25 CREATE TABLE statement and adds ALTER TABLEs at the end with it.
  26
  27 =item quote_field_names
  28
  29 Controls whether quotes are being used around column names in generated DDL.
  30
  31 =item quote_table_names
  32
  33 Controls whether quotes are being used around table, sequence and trigger names in
  34 generated DDL.
  35
  36 =back
  37
  38 =head1 NOTES
  39
  40 =head2 Autoincremental primary keys
  41
  42 This producer uses sequences and triggers to autoincrement primary key
  43 columns, if necessary. SQLPlus and DBI expect a slightly different syntax
  44 of CREATE TRIGGER statement. You might have noticed that this
  45 producer returns a scalar containing all statements concatenated by
  46 newlines or an array of single statements depending on the context
  47 (scalar, array) it has been called in.
  48
  49 SQLPlus expects following trigger syntax:
  50
  51     CREATE OR REPLACE TRIGGER ai_person_id
  52     BEFORE INSERT ON person
  53     FOR EACH ROW WHEN (
  54      new.id IS NULL OR new.id = 0
  55     )
  56     BEGIN
  57      SELECT sq_person_id.nextval
  58      INTO :new.id
  59      FROM dual;
  60     END;
  61     /
  62
  63 Whereas if you want to create the same trigger using L<DBI/do>, you need
  64 to omit the last slash:
  65
  66     my $dbh = DBI->connect('dbi:Oracle:mysid', 'scott', 'tiger');
  67     $dbh->do("
  68         CREATE OR REPLACE TRIGGER ai_person_id
  69         BEFORE INSERT ON person
  70         FOR EACH ROW WHEN (
  71          new.id IS NULL OR new.id = 0
  72         )
  73         BEGIN
  74          SELECT sq_person_id.nextval
  75          INTO :new.id
  76          FROM dual;
  77         END;
  78     ");
  79
  80 If you call this producer in array context, we expect you want to process
  81 the returned array of statements using L<DBI> like
  82 L<DBIx::Class::Schema/deploy> does.
  83
  84 To get this working we removed the slash in those statements in version
  85 0.09002 of L<SQL::Translator> when called in array context. In scalar
  86 context the slash will be still there to ensure compatibility with SQLPlus.
  87
  88 =cut
  89
  90 use strict;
  91 use vars qw[ $VERSION $DEBUG $WARN ];
  92 $VERSION = '1.59';
  93 $DEBUG   = 0 unless defined $DEBUG;
  94
  95 use SQL::Translator::Schema::Constants;
  96 use SQL::Translator::Utils qw(header_comment);
  97
  98 my %translate  = (
  99     #
 100     # MySQL types
 101     #
 102     bigint     => 'number',
 103     double     => 'float',
 104     decimal    => 'number',
 105     float      => 'float',
 106     int        => 'number',
 107     integer    => 'number',
 108     mediumint  => 'number',
 109     smallint   => 'number',
 110     tinyint    => 'number',
 111     char       => 'char',
 112     varchar    => 'varchar2',
 113     tinyblob   => 'blob',
 114     blob       => 'blob',
 115     mediumblob => 'blob',
 116     longblob   => 'blob',
 117     tinytext   => 'varchar2',
 118     text       => 'clob',
 119     longtext   => 'clob',
 120     mediumtext => 'clob',
 121     enum       => 'varchar2',
 122     set        => 'varchar2',
 123     date       => 'date',
 124     datetime   => 'date',
 125     time       => 'date',
 126     timestamp  => 'date',
 127     year       => 'date',
 128
 129     #
 130     # PostgreSQL types
 131     #
 132     numeric             => 'number',
 133     'double precision'  => 'number',
 134     serial              => 'number',
 135     bigserial           => 'number',
 136     money               => 'number',
 137     character           => 'char',
 138     'character varying' => 'varchar2',
 139     bytea               => 'BLOB',
 140     interval            => 'number',
 141     boolean             => 'number',
 142     point               => 'number',
 143     line                => 'number',
 144     lseg                => 'number',
 145     box                 => 'number',
 146     path                => 'number',
 147     polygon             => 'number',
 148     circle              => 'number',
 149     cidr                => 'number',
 150     inet                => 'varchar2',
 151     macaddr             => 'varchar2',
 152     bit                 => 'number',
 153     'bit varying'       => 'number',
 154
 155     #
 156     # Oracle types
 157     #
 158     number              => 'number',
 159     varchar2            => 'varchar2',
 160     long                => 'clob',
 161 );
 162
 163 #
 164 # Oracle 8/9 max size of data types from:
 165 # http://www.ss64.com/orasyntax/datatypes.html
 166 #
 167 my %max_size = (
 168     char      => 2000,
 169     float     => 126,
 170     nchar     => 2000,
 171     nvarchar2 => 4000,
 172     number    => [ 38, 127 ],
 173     raw       => 2000,
 174     varchar   => 4000,          # only synonym for varchar2
 175     varchar2  => 4000,
 176 );
 177
 178 my $max_id_length    = 30;
 179 my %used_identifiers = ();
 180 my %global_names;
 181 my %truncated;
 182
 183 # Quote used to escape table, field, sequence and trigger names
 184 my $quote_char  = '"';
 185
 186 # -------------------------------------------------------------------
 187 sub produce {
 188     my $translator     = shift;
 189     $DEBUG             = $translator->debug;
 190     $WARN              = $translator->show_warnings || 0;
 191     my $no_comments    = $translator->no_comments;
 192     my $add_drop_table = $translator->add_drop_table;
 193     my $schema         = $translator->schema;
 194     my $oracle_version  = $translator->producer_args->{oracle_version} || 0;
 195     my $delay_constraints = $translator->producer_args->{delay_constraints};
 196     my ($output, $create, @table_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs);
 197
 198     $create .= header_comment unless ($no_comments);
 199     my $qt = 1 if $translator->quote_table_names;
 200     my $qf = 1 if $translator->quote_field_names;
 201
 202     if ( $translator->parser_type =~ /mysql/i ) {
 203         $create .=
 204             "-- We assume that default NLS_DATE_FORMAT has been changed\n".
 205             "-- but we set it here anyway to be self-consistent.\n"
 206             unless $no_comments;
 207
 208         $create .=
 209         "ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS';\n\n";
 210     }
 211
 212     for my $table ( $schema->get_tables ) {
 213         my ( $table_def, $fk_def, $trigger_def, $index_def, $constraint_def ) = create_table(
 214             $table,
 215             {
 216                 add_drop_table    => $add_drop_table,
 217                 show_warnings     => $WARN,
 218                 no_comments       => $no_comments,
 219                 delay_constraints => $delay_constraints,
 220                 quote_table_names => $qt,
 221                 quote_field_names => $qf,
 222             }
 223         );
 224         push @table_defs, @$table_def;
 225         push @fk_defs, @$fk_def;
 226         push @trigger_defs, @$trigger_def;
 227         push @index_defs, @$index_def;
 228         push @constraint_defs, @$constraint_def;
 229     }
 230
 231     my (@view_defs);
 232     foreach my $view ( $schema->get_views ) {
 233         my ( $view_def ) = create_view(
 234             $view,
 235             {
 236                 add_drop_view     => $add_drop_table,
 237                 quote_table_names => $qt,
 238             }
 239         );
 240         push @view_defs, @$view_def;
 241     }
 242
 243     if (wantarray) {
 244         return defined $create ? $create : (), @table_defs, @view_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs;
 245     }
 246     else {
 247         $create .= join (";\n\n", @table_defs, @view_defs, @fk_defs, @index_defs, @constraint_defs);
 248         $create .= ";\n\n";
 249         # If wantarray is not set we have to add "/" in this statement
 250         # DBI->do() needs them omitted
 251         # triggers may NOT end with a semicolon
 252         $create .= join "/\n\n", @trigger_defs;
 253         # for last trigger
 254         $create .= "/\n\n";
 255         return $create;
 256     }
 257 }
 258
 259 sub create_table {
 260     my ($table, $options) = @_;
 261     my $qt = $options->{quote_table_names};
 262     my $qf = $options->{quote_field_names};
 263     my $table_name = $table->name;
 264     my $table_name_q = quote($table_name,$qt);
 265
 266     my $item = '';
 267     my $drop;
 268     my (@create, @field_defs, @constraint_defs, @fk_defs, @trigger_defs);
 269
 270     push @create, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
 271     push @create, qq[DROP TABLE $table_name_q CASCADE CONSTRAINTS] if $options->{add_drop_table};
 272
 273         my ( %field_name_scope, @field_comments );
 274         for my $field ( $table->get_fields ) {
 275             my ($field_create, $field_defs, $trigger_defs, $field_comments) =
 276               create_field($field, $options, \%field_name_scope);
 277             push @create, @$field_create if ref $field_create;
 278             push @field_defs, @$field_defs if ref $field_defs;
 279             push @trigger_defs, @$trigger_defs if ref $trigger_defs;
 280             push @field_comments, @$field_comments if ref $field_comments;
 281         }
 282
 283         #
 284         # Table options
 285         #
 286         my @table_options;
 287         for my $opt ( $table->options ) {
 288             if ( ref $opt eq 'HASH' ) {
 289                 my ( $key, $value ) = each %$opt;
 290                 if ( ref $value eq 'ARRAY' ) {
 291                     push @table_options, "$key\n(\n".  join ("\n",
 292                         map { "  $_->[0]\t$_->[1]" }
 293                         map { [ each %$_ ] }
 294                         @$value
 295                     )."\n)";
 296                 }
 297                 elsif ( !defined $value ) {
 298                     push @table_options, $key;
 299                 }
 300                 else {
 301                     push @table_options, "$key    $value";
 302                 }
 303             }
 304         }
 305
 306         #
 307         # Table constraints
 308         #
 309         for my $c ( $table->get_constraints ) {
 310             my $name    = $c->name || '';
 311             my @fields  = map { quote($_,$qf) } $c->fields;
 312             my @rfields = map { quote($_,$qf) } $c->reference_fields;
 313
 314             next if !@fields && $c->type ne CHECK_C;
 315
 316             if ( $c->type eq PRIMARY_KEY ) {
 317                 # create a name if delay_constraints
 318                 $name ||= mk_name( $table_name, 'pk' )
 319                   if $options->{delay_constraints};
 320                 $name = quote($name,$qf);
 321                 push @constraint_defs, ($name ? "CONSTRAINT $name " : '') .
 322                   'PRIMARY KEY (' . join( ', ', @fields ) . ')';
 323             }
 324             elsif ( $c->type eq UNIQUE ) {
 325               # Don't create UNIQUE constraints identical to the primary key
 326               if ( my $pk = $table->primary_key ) {
 327                 my $u_fields = join(":", @fields);
 328                 my $pk_fields = join(":", $pk->fields);
 329                 next if $u_fields eq $pk_fields;
 330               }
 331
 332               if ($name) {
 333                 # Force prepend of table_name as ORACLE doesn't allow duplicate
 334                 # CONSTRAINT names even for different tables (ORA-02264)
 335                 $name = mk_name( "${table_name}_$name", 'u' ) unless $name =~ /^$table_name/;
 336               }
 337               else {
 338                 $name = mk_name( $table_name, 'u' );
 339               }
 340
 341               $name = quote($name, $qf);
 342
 343                 for my $f ( $c->fields ) {
 344                     my $field_def = $table->get_field( $f ) or next;
 345                     my $dtype     = $translate{ ref $field_def->data_type eq "ARRAY" ? $field_def->data_type->[0] : $field_def->data_type} or next;
 346                     if ( $WARN && $dtype =~ /clob/i ) {
 347                         warn "Oracle will not allow UNIQUE constraints on " .
 348                              "CLOB field '" . $field_def->table->name . '.' .
 349                              $field_def->name . ".'\n"
 350                     }
 351                 }
 352
 353                 push @constraint_defs, "CONSTRAINT $name UNIQUE " .
 354                     '(' . join( ', ', @fields ) . ')';
 355             }
 356             elsif ( $c->type eq CHECK_C ) {
 357                 $name ||= mk_name( $name || $table_name, 'ck' );
 358                 $name = quote($name, $qf);
 359                 my $expression = $c->expression || '';
 360                 push @constraint_defs, "CONSTRAINT $name CHECK ($expression)";
 361             }
 362             elsif ( $c->type eq FOREIGN_KEY ) {
 363                 $name = mk_name( join('_', $table_name, $c->fields). '_fk' );
 364                 $name = quote($name, $qf);
 365                 my $def = "CONSTRAINT $name FOREIGN KEY ";
 366
 367                 if ( @fields ) {
 368                     $def .= '(' . join( ', ', @fields ) . ')';
 369                 }
 370
 371                 my $ref_table = quote($c->reference_table,$qt);
 372
 373                 $def .= " REFERENCES $ref_table";
 374
 375                 if ( @rfields ) {
 376                     $def .= ' (' . join( ', ', @rfields ) . ')';
 377                 }
 378
 379                 if ( $c->match_type ) {
 380                     $def .= ' MATCH ' .
 381                         ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 382                 }
 383
 384                 if ( $c->on_delete ) {
 385                     $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 386                 }
 387
 388                 # disabled by plu 2007-12-29 - doesn't exist for oracle
 389                 #if ( $c->on_update ) {
 390                 #    $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 391                 #}
 392
 393                 push @fk_defs, sprintf("ALTER TABLE %s ADD %s", $table_name_q, $def);
 394             }
 395         }
 396
 397         #
 398         # Index Declarations
 399         #
 400         my @index_defs = ();
 401         for my $index ( $table->get_indices ) {
 402             my $index_name = $index->name || '';
 403             my $index_type = $index->type || NORMAL;
 404             my @fields     = map { quote($_, $qf) } $index->fields;
 405             next unless @fields;
 406
 407             my @index_options;
 408             for my $opt ( $index->options ) {
 409                 if ( ref $opt eq 'HASH' ) {
 410                     my ( $key, $value ) = each %$opt;
 411                     if ( ref $value eq 'ARRAY' ) {
 412                         push @table_options, "$key\n(\n".  join ("\n",
 413                             map { "  $_->[0]\t$_->[1]" }
 414                             map { [ each %$_ ] }
 415                            @$value
 416                         )."\n)";
 417                     }
 418                     elsif ( !defined $value ) {
 419                         push @index_options, $key;
 420                     }
 421                     else {
 422                         push @index_options, "$key    $value";
 423                     }
 424                 }
 425             }
 426             my $index_options = @index_options
 427               ? "\n".join("\n", @index_options) : '';
 428
 429             if ( $index_type eq PRIMARY_KEY ) {
 430                 $index_name = $index_name ? mk_name( $index_name )
 431                     : mk_name( $table_name, 'pk' );
 432                 $index_name = quote($index_name, $qf);
 433                 push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
 434                     '(' . join( ', ', @fields ) . ')';
 435             }
 436             elsif ( $index_type eq NORMAL ) {
 437                 $index_name = $index_name ? mk_name( $index_name )
 438                     : mk_name( $table_name, $index_name || 'i' );
 439                 $index_name = quote($index_name, $qf);
 440                 push @index_defs,
 441                     "CREATE INDEX $index_name on $table_name_q (".
 442                         join( ', ', @fields ).
 443                     ")$index_options";
 444             }
 445             elsif ( $index_type eq UNIQUE ) {
 446                 $index_name = $index_name ? mk_name( $index_name )
 447                     : mk_name( $table_name, $index_name || 'i' );
 448                 $index_name = quote($index_name, $qf);
 449                 push @index_defs,
 450                     "CREATE UNIQUE INDEX $index_name on $table_name_q (".
 451                         join( ', ', @fields ).
 452                     ")$index_options";
 453             }
 454             else {
 455                 warn "Unknown index type ($index_type) on table $table_name.\n"
 456                     if $WARN;
 457             }
 458         }
 459
 460         if ( my @table_comments = $table->comments ) {
 461             for my $comment ( @table_comments ) {
 462                 next unless $comment;
 463                 $comment =~ s/'/''/g;
 464                 push @field_comments, "COMMENT ON TABLE $table_name_q is\n '".
 465                 $comment . "'" unless $options->{no_comments}
 466                 ;
 467             }
 468         }
 469
 470         my $table_options = @table_options
 471             ? "\n".join("\n", @table_options) : '';
 472     push @create, "CREATE TABLE $table_name_q (\n" .
 473             join( ",\n", map { "  $_" } @field_defs,
 474             ($options->{delay_constraints} ? () : @constraint_defs) ) .
 475             "\n)$table_options";
 476
 477     @constraint_defs = map { "ALTER TABLE $table_name_q ADD $_"  }
 478       @constraint_defs;
 479
 480     if ( $WARN ) {
 481         if ( %truncated ) {
 482             warn "Truncated " . keys( %truncated ) . " names:\n";
 483             warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
 484         }
 485     }
 486
 487     return \@create, \@fk_defs, \@trigger_defs, \@index_defs, ($options->{delay_constraints} ? \@constraint_defs : []);
 488 }
 489
 490 sub alter_field {
 491     my ($from_field, $to_field, $options) = @_;
 492
 493     my $qt = $options->{quote_table_names};
 494     my ($field_create, $field_defs, $trigger_defs, $field_comments) =
 495       create_field($to_field, $options, {});
 496
 497     # Fix ORA-01442
 498     if ($to_field->is_nullable && !$from_field->is_nullable) {
 499         die 'Cannot remove NOT NULL from table field';
 500     } elsif (!$from_field->is_nullable && !$to_field->is_nullable) {
 501         @$field_defs = map { s/ NOT NULL//; $_} @$field_defs;
 502     }
 503
 504     my $table_name = quote($to_field->table->name,$qt);
 505
 506     return 'ALTER TABLE '.$table_name.' MODIFY ( '.join('', @$field_defs).' )';
 507 }
 508
 509 sub add_field {
 510     my ($new_field, $options) = @_;
 511
 512     my $qt = $options->{quote_table_names};
 513     my ($field_create, $field_defs, $trigger_defs, $field_comments) =
 514       create_field($new_field, $options, {});
 515
 516     my $table_name = quote($new_field->table->name,$qt);
 517
 518     my $out = sprintf('ALTER TABLE %s ADD ( %s )',
 519                       $table_name,
 520                       join('', @$field_defs));
 521     return $out;
 522 }
 523
 524 sub create_field {
 525     my ($field, $options, $field_name_scope) = @_;
 526     my $qf = $options->{quote_field_names};
 527     my $qt = $options->{quote_table_names};
 528
 529     my (@create, @field_defs, @trigger_defs, @field_comments);
 530
 531     my $table_name = $field->table->name;
 532     my $table_name_q = quote($table_name, $qt);
 533
 534     #
 535     # Field name
 536     #
 537     my $field_name    = mk_name(
 538                                 $field->name, '', $field_name_scope, 1
 539                                );
 540     my $field_name_q = quote($field_name, $qf);
 541     my $field_def     = quote($field_name, $qf);
 542     $field->name( $field_name );
 543
 544     #
 545     # Datatype
 546     #
 547     my $check;
 548     my $data_type = lc $field->data_type;
 549     my @size      = $field->size;
 550     my %extra     = $field->extra;
 551     my $list      = $extra{'list'} || [];
 552     # \todo deal with embedded quotes
 553     my $commalist = join( ', ', map { qq['$_'] } @$list );
 554
 555     if ( $data_type eq 'enum' ) {
 556         $check = "CHECK ($field_name_q IN ($commalist))";
 557         $data_type = 'varchar2';
 558     }
 559     elsif ( $data_type eq 'set' ) {
 560         # XXX add a CHECK constraint maybe
 561         # (trickier and slower, than enum :)
 562         $data_type = 'varchar2';
 563     }
 564     else {
 565       if (defined $translate{ $data_type }) {
 566         if (ref $translate{ $data_type } eq "ARRAY") {
 567           ($data_type,$size[0])  = @{$translate{ $data_type }};
 568         } else {
 569           $data_type  = $translate{ $data_type };
 570         }
 571       }
 572       $data_type ||= 'varchar2';
 573     }
 574
 575     # ensure size is not bigger than max size oracle allows for data type
 576     if ( defined $max_size{$data_type} ) {
 577         for ( my $i = 0 ; $i < scalar @size ; $i++ ) {
 578             my $max =
 579               ref( $max_size{$data_type} ) eq 'ARRAY'
 580               ? $max_size{$data_type}->[$i]
 581               : $max_size{$data_type};
 582             $size[$i] = $max if $size[$i] > $max;
 583         }
 584     }
 585
 586     #
 587     # Fixes ORA-02329: column of datatype LOB cannot be
 588     # unique or a primary key
 589     #
 590     if ( $data_type eq 'clob' && $field->is_primary_key ) {
 591         $data_type = 'varchar2';
 592         $size[0]   = 4000;
 593         warn "CLOB cannot be a primary key, changing to VARCHAR2\n"
 594           if $WARN;
 595     }
 596
 597     if ( $data_type eq 'clob' && $field->is_unique ) {
 598         $data_type = 'varchar2';
 599         $size[0]   = 4000;
 600         warn "CLOB cannot be a unique key, changing to VARCHAR2\n"
 601           if $WARN;
 602     }
 603
 604     #
 605     # Fixes ORA-00907: missing right parenthesis
 606     #
 607     if ( $data_type =~ /(date|clob)/i ) {
 608         undef @size;
 609     }
 610
 611     #
 612     # Fixes ORA-00906: missing right parenthesis
 613                 # if size is 0 or undefined
 614     #
 615     for (qw/varchar2/) {
 616         if ( $data_type =~ /^($_)$/i ) {
 617             $size[0] ||= $max_size{$_};
 618         }
 619     }
 620
 621     $field_def .= " $data_type";
 622     if ( defined $size[0] && $size[0] > 0 ) {
 623         $field_def .= '(' . join( ',', @size ) . ')';
 624     }
 625
 626     #
 627     # Default value
 628     #
 629     my $default = $field->default_value;
 630     if ( defined $default ) {
 631         #
 632         # Wherein we try to catch a string being used as
 633         # a default value for a numerical field.  If "true/false,"
 634         # then sub "1/0," otherwise just test the truthity of the
 635         # argument and use that (naive?).
 636         #
 637         if (ref $default and defined $$default) {
 638           $default = $$default;
 639         } elsif (ref $default) {
 640           $default = 'NULL';
 641         } elsif (
 642             $data_type =~ /^number$/i &&
 643             $default   !~ /^-?\d+$/     &&
 644             $default   !~ m/null/i
 645            ) {
 646             if ( $default =~ /^true$/i ) {
 647                 $default = "'1'";
 648             } elsif ( $default =~ /^false$/i ) {
 649                 $default = "'0'";
 650             } else {
 651                 $default = $default ? "'1'" : "'0'";
 652             }
 653         } elsif (
 654                  $data_type =~ /date/ && (
 655                                           $default eq 'current_timestamp'
 656                                           ||
 657                                           $default eq 'now()'
 658                                          )
 659                 ) {
 660             $default = 'SYSDATE';
 661         } else {
 662             $default = $default =~ m/null/i ? 'NULL' : "'$default'"
 663         }
 664
 665         $field_def .= " DEFAULT $default",
 666     }
 667
 668     #
 669     # Not null constraint
 670     #
 671     unless ( $field->is_nullable ) {
 672         $field_def .= ' NOT NULL';
 673     }
 674
 675     $field_def .= " $check" if $check;
 676
 677     #
 678     # Auto_increment
 679     #
 680     if ( $field->is_auto_increment ) {
 681         my $base_name    = $table_name . "_". $field_name;
 682         my $seq_name     = quote(mk_name( $base_name, 'sq' ),$qt);
 683         my $trigger_name = quote(mk_name( $base_name, 'ai' ),$qt);
 684
 685         push @create, qq[DROP SEQUENCE $seq_name] if $options->{add_drop_table};
 686         push @create, "CREATE SEQUENCE $seq_name";
 687         my $trigger =
 688           "CREATE OR REPLACE TRIGGER $trigger_name\n" .
 689           "BEFORE INSERT ON $table_name_q\n" .
 690           "FOR EACH ROW WHEN (\n" .
 691           " new.$field_name_q IS NULL".
 692           " OR new.$field_name_q = 0\n".
 693           ")\n".
 694           "BEGIN\n" .
 695           " SELECT $seq_name.nextval\n" .
 696           " INTO :new." . $field_name_q."\n" .
 697           " FROM dual;\n" .
 698           "END;\n";
 699
 700         push @trigger_defs, $trigger;
 701     }
 702
 703     if ( lc $field->data_type eq 'timestamp' ) {
 704         my $base_name = $table_name . "_". $field_name;
 705         my $trig_name = quote(mk_name( $base_name, 'ts' ), $qt);
 706         my $trigger =
 707           "CREATE OR REPLACE TRIGGER $trig_name\n".
 708           "BEFORE INSERT OR UPDATE ON $table_name_q\n".
 709           "FOR EACH ROW WHEN (new.$field_name_q IS NULL)\n".
 710           "BEGIN \n".
 711           " SELECT sysdate INTO :new.$field_name_q FROM dual;\n".
 712           "END;\n";
 713
 714           push @trigger_defs, $trigger;
 715     }
 716
 717     push @field_defs, $field_def;
 718
 719     if ( my $comment = $field->comments ) {
 720         $comment =~ s/'/''/g;
 721         push @field_comments,
 722           "COMMENT ON COLUMN $table_name_q.$field_name_q is\n '" .
 723             $comment . "';" unless $options->{no_comments};
 724     }
 725
 726     return \@create, \@field_defs, \@trigger_defs, \@field_comments;
 727
 728 }
 729
 730
 731 sub create_view {
 732     my ($view, $options) = @_;
 733     my $qt = $options->{quote_table_names};
 734     my $view_name = quote($view->name,$qt);
 735
 736     my @create;
 737     push @create, qq[DROP VIEW $view_name]
 738         if $options->{add_drop_view};
 739
 740     push @create, sprintf("CREATE VIEW %s AS\n%s",
 741                       $view_name,
 742                       $view->sql);
 743
 744     return \@create;
 745 }
 746
 747 # -------------------------------------------------------------------
 748 sub mk_name {
 749     my $basename      = shift || '';
 750     my $type          = shift || '';
 751        $type          = '' if $type =~ /^\d/;
 752     my $scope         = shift || '';
 753     my $critical      = shift || '';
 754     my $basename_orig = $basename;
 755     my $max_name      = $type
 756                         ? $max_id_length - (length($type) + 1)
 757                         : $max_id_length;
 758     $basename         = substr( $basename, 0, $max_name )
 759                         if length( $basename ) > $max_name;
 760     my $name          = $type ? "${type}_$basename" : $basename;
 761
 762     if ( $basename ne $basename_orig and $critical ) {
 763         my $show_type = $type ? "+'$type'" : "";
 764         warn "Truncating '$basename_orig'$show_type to $max_id_length ",
 765             "character limit to make '$name'\n" if $WARN;
 766         $truncated{ $basename_orig } = $name;
 767     }
 768
 769     $scope ||= \%global_names;
 770     if ( my $prev = $scope->{ $name } ) {
 771         my $name_orig = $name;
 772         substr($name, $max_id_length - 2) = ""
 773             if length( $name ) >= $max_id_length - 1;
 774         $name        .= sprintf( "%02d", $prev++ );
 775
 776         warn "The name '$name_orig' has been changed to ",
 777              "'$name' to make it unique.\n" if $WARN;
 778
 779         $scope->{ $name_orig }++;
 780     }
 781
 782     $scope->{ $name }++;
 783     return $name;
 784 }
 785
 786 1;
 787
 788 # -------------------------------------------------------------------
 789 sub quote {
 790   my ($name, $q) = @_;
 791   $q && $name ? "$quote_char$name$quote_char" : $name;
 792 }
 793
 794
 795 # -------------------------------------------------------------------
 796 # All bad art is the result of good intentions.
 797 # Oscar Wilde
 798 # -------------------------------------------------------------------
 799
 800 =pod
 801
 802 =head1 CREDITS
 803
 804 Mad props to Tim Bunce for much of the logic stolen from his "mysql2ora"
 805 script.
 806
 807 =head1 AUTHORS
 808
 809 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
 810 Alexander Hartmaier E<lt>abraxxa@cpan.orgE<gt>,
 811 Fabien Wernli E<lt>faxmodem@cpan.orgE<gt>.
 812
 813 =head1 SEE ALSO
 814
 815 SQL::Translator, DDL::Oracle, mysql2ora.
 816
 817 =cut