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