lib/SQL/Translator/Producer/PostgreSQL.pm

   1 package SQL::Translator::Producer::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.27 2006-11-10 21:21:51 mwz444 Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =head1 NAME
  24
  25 SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator
  26
  27 =head1 SYNOPSIS
  28
  29   my $t = SQL::Translator->new( parser => '...', producer => 'PostgreSQL' );
  30   $t->translate;
  31
  32 =head1 DESCRIPTION
  33
  34 Creates a DDL suitable for PostgreSQL.  Very heavily based on the Oracle
  35 producer.
  36
  37 =cut
  38
  39 use strict;
  40 use warnings;
  41 use vars qw[ $DEBUG $WARN $VERSION ];
  42 $VERSION = sprintf "%d.%02d", q$Revision: 1.27 $ =~ /(\d+)\.(\d+)/;
  43 $DEBUG = 1 unless defined $DEBUG;
  44
  45 use SQL::Translator::Schema::Constants;
  46 use SQL::Translator::Utils qw(header_comment);
  47 use Data::Dumper;
  48
  49 my %translate;
  50 my $max_id_length;
  51
  52 BEGIN {
  53
  54  %translate  = (
  55     #
  56     # MySQL types
  57     #
  58     bigint     => 'bigint',
  59     double     => 'numeric',
  60     decimal    => 'numeric',
  61     float      => 'numeric',
  62     int        => 'integer',
  63     mediumint  => 'integer',
  64     smallint   => 'smallint',
  65     tinyint    => 'smallint',
  66     char       => 'character',
  67     varchar    => 'character varying',
  68     longtext   => 'text',
  69     mediumtext => 'text',
  70     text       => 'text',
  71     tinytext   => 'text',
  72     tinyblob   => 'bytea',
  73     blob       => 'bytea',
  74     mediumblob => 'bytea',
  75     longblob   => 'bytea',
  76     enum       => 'character varying',
  77     set        => 'character varying',
  78     date       => 'date',
  79     datetime   => 'timestamp',
  80     time       => 'date',
  81     timestamp  => 'timestamp',
  82     year       => 'date',
  83
  84     #
  85     # Oracle types
  86     #
  87     number     => 'integer',
  88     char       => 'character',
  89     varchar2   => 'character varying',
  90     long       => 'text',
  91     CLOB       => 'bytea',
  92     date       => 'date',
  93
  94     #
  95     # Sybase types
  96     #
  97     int        => 'integer',
  98     money      => 'money',
  99     varchar    => 'character varying',
 100     datetime   => 'timestamp',
 101     text       => 'text',
 102     real       => 'numeric',
 103     comment    => 'text',
 104     bit        => 'bit',
 105     tinyint    => 'smallint',
 106     float      => 'numeric',
 107 );
 108
 109  $max_id_length = 62;
 110 }
 111 my %reserved = map { $_, 1 } qw[
 112     ALL ANALYSE ANALYZE AND ANY AS ASC
 113     BETWEEN BINARY BOTH
 114     CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
 115     CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
 116     DEFAULT DEFERRABLE DESC DISTINCT DO
 117     ELSE END EXCEPT
 118     FALSE FOR FOREIGN FREEZE FROM FULL
 119     GROUP HAVING
 120     ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
 121     JOIN LEADING LEFT LIKE LIMIT
 122     NATURAL NEW NOT NOTNULL NULL
 123     OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
 124     PRIMARY PUBLIC REFERENCES RIGHT
 125     SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
 126     UNION UNIQUE USER USING VERBOSE WHEN WHERE
 127 ];
 128
 129 # my $max_id_length    = 62;
 130 my %used_identifiers = ();
 131 my %global_names;
 132 my %unreserve;
 133 my %truncated;
 134
 135 =pod
 136
 137 =head1 PostgreSQL Create Table Syntax
 138
 139   CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
 140       { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
 141       | table_constraint }  [, ... ]
 142   )
 143   [ INHERITS ( parent_table [, ... ] ) ]
 144   [ WITH OIDS | WITHOUT OIDS ]
 145
 146 where column_constraint is:
 147
 148   [ CONSTRAINT constraint_name ]
 149   { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
 150     CHECK (expression) |
 151     REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
 152       [ ON DELETE action ] [ ON UPDATE action ] }
 153   [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
 154
 155 and table_constraint is:
 156
 157   [ CONSTRAINT constraint_name ]
 158   { UNIQUE ( column_name [, ... ] ) |
 159     PRIMARY KEY ( column_name [, ... ] ) |
 160     CHECK ( expression ) |
 161     FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
 162       [ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
 163   [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
 164
 165 =head1 Create Index Syntax
 166
 167   CREATE [ UNIQUE ] INDEX index_name ON table
 168       [ USING acc_method ] ( column [ ops_name ] [, ...] )
 169       [ WHERE predicate ]
 170   CREATE [ UNIQUE ] INDEX index_name ON table
 171       [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
 172       [ WHERE predicate ]
 173
 174 =cut
 175
 176 # -------------------------------------------------------------------
 177 sub produce {
 178     my $translator     = shift;
 179     $DEBUG             = $translator->debug;
 180     $WARN              = $translator->show_warnings;
 181     my $no_comments    = $translator->no_comments;
 182     my $add_drop_table = $translator->add_drop_table;
 183     my $schema         = $translator->schema;
 184
 185     my $qt = '';
 186     $qt = '"' if ($translator->quote_table_names);
 187     my $qf = '';
 188     $qf = '"' if ($translator->quote_field_names);
 189
 190     my $output;
 191     $output .= header_comment unless ($no_comments);
 192 #    my %used_index_names;
 193
 194     my (@table_defs, @fks);
 195     for my $table ( $schema->get_tables ) {
 196
 197         my ($table_def, $fks) = create_table($table,
 198                                              { quote_table_names => $qt,
 199                                                quote_field_names => $qf,
 200                                                no_comments => $no_comments,
 201                                                add_drop_table => $add_drop_table,});
 202         push @table_defs, $table_def;
 203         push @fks, @$fks;
 204
 205     }
 206
 207     $output = join("\n\n", @table_defs);
 208     if ( @fks ) {
 209         $output .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
 210         $output .= join( "\n\n", @fks ) . "\n";
 211     }
 212
 213     if ( $WARN ) {
 214         if ( %truncated ) {
 215             warn "Truncated " . keys( %truncated ) . " names:\n";
 216             warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
 217         }
 218
 219         if ( %unreserve ) {
 220             warn "Encounted " . keys( %unreserve ) .
 221                 " unsafe names in schema (reserved or invalid):\n";
 222             warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
 223         }
 224     }
 225
 226     return $output;
 227 }
 228
 229 # -------------------------------------------------------------------
 230 sub mk_name {
 231     my $basename      = shift || '';
 232     my $type          = shift || '';
 233     my $scope         = shift || '';
 234     my $critical      = shift || '';
 235     my $basename_orig = $basename;
 236 #    my $max_id_length = 62;
 237     my $max_name      = $type
 238                         ? $max_id_length - (length($type) + 1)
 239                         : $max_id_length;
 240     $basename         = substr( $basename, 0, $max_name )
 241                         if length( $basename ) > $max_name;
 242     my $name          = $type ? "${type}_$basename" : $basename;
 243
 244     if ( $basename ne $basename_orig and $critical ) {
 245         my $show_type = $type ? "+'$type'" : "";
 246         warn "Truncating '$basename_orig'$show_type to $max_id_length ",
 247             "character limit to make '$name'\n" if $WARN;
 248         $truncated{ $basename_orig } = $name;
 249     }
 250
 251     $scope ||= \%global_names;
 252     if ( my $prev = $scope->{ $name } ) {
 253         my $name_orig = $name;
 254         $name        .= sprintf( "%02d", ++$prev );
 255         substr($name, $max_id_length - 3) = "00"
 256             if length( $name ) > $max_id_length;
 257
 258         warn "The name '$name_orig' has been changed to ",
 259              "'$name' to make it unique.\n" if $WARN;
 260
 261         $scope->{ $name_orig }++;
 262     }
 263
 264     $scope->{ $name }++;
 265     return $name;
 266 }
 267
 268 # -------------------------------------------------------------------
 269 sub unreserve {
 270     my $name            = shift || '';
 271     my $schema_obj_name = shift || '';
 272
 273     my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
 274
 275     # also trap fields that don't begin with a letter
 276     return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
 277
 278     if ( $schema_obj_name ) {
 279         ++$unreserve{"$schema_obj_name.$name"};
 280     }
 281     else {
 282         ++$unreserve{"$name (table name)"};
 283     }
 284
 285     my $unreserve = sprintf '%s_', $name;
 286     return $unreserve.$suffix;
 287 }
 288
 289 # -------------------------------------------------------------------
 290 sub next_unused_name {
 291     my $name       = shift || '';
 292     my $used_names = shift || '';
 293
 294     my %used_names = %$used_names;
 295
 296     if ( !defined($used_names{$name}) ) {
 297         $used_names{$name} = $name;
 298         return $name;
 299     }
 300
 301     my $i = 2;
 302     while ( defined($used_names{$name . $i}) ) {
 303         ++$i;
 304     }
 305     $name .= $i;
 306     $used_names{$name} = $name;
 307     return $name;
 308 }
 309
 310 sub create_table
 311 {
 312     my ($table, $options) = @_;
 313
 314     my $qt = $options->{quote_table_names} || '';
 315     my $qf = $options->{quote_field_names} || '';
 316     my $no_comments = $options->{no_comments} || 0;
 317     my $add_drop_table = $options->{add_drop_table} || 0;
 318
 319     my $table_name    = $table->name or next;
 320     $table_name       = mk_name( $table_name, '', undef, 1 );
 321     my $table_name_ur = $qt ? $table_name : unreserve($table_name);
 322     $table->name($table_name_ur);
 323
 324 # print STDERR "$table_name table_name\n";
 325     my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
 326
 327     push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments;
 328
 329     if ( $table->comments and !$no_comments ){
 330         my $c = "-- Comments: \n-- ";
 331         $c .= join "\n-- ",  $table->comments;
 332         $c .= "\n--";
 333         push @comments, $c;
 334     }
 335
 336     #
 337     # Fields
 338     #
 339     my %field_name_scope;
 340     for my $field ( $table->get_fields ) {
 341         push @field_defs, create_field($field, { quote_table_names => $qt,
 342                                                  quote_field_names => $qf,
 343                                                  table_name => $table_name_ur,
 344                                                  constraint_defs => \@constraint_defs,});
 345     }
 346
 347     #
 348     # Index Declarations
 349     #
 350     my @index_defs = ();
 351  #   my $idx_name_default;
 352     for my $index ( $table->get_indices ) {
 353         my ($idef, $constraints) = create_index($index,
 354                                               {
 355                                                   quote_field_names => $qf,
 356                                                   quote_table_names => $qt,
 357                                                   table_name => $table_name,
 358                                               });
 359         push @index_defs, $idef;
 360         push @constraint_defs, @$constraints;
 361     }
 362
 363     #
 364     # Table constraints
 365     #
 366     my $c_name_default;
 367     for my $c ( $table->get_constraints ) {
 368         my ($cdefs, $fks) = create_constraint($c,
 369                                               {
 370                                                   quote_field_names => $qf,
 371                                                   quote_table_names => $qt,
 372                                                   table_name => $table_name,
 373                                               });
 374         push @constraint_defs, @$cdefs;
 375         push @fks, @$fks;
 376     }
 377
 378     my $create_statement;
 379     $create_statement = join("\n", @comments);
 380     $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt;\n]
 381         if $add_drop_table;
 382     $create_statement .= qq[CREATE TABLE $qt$table_name_ur$qt (\n].
 383                             join( ",\n", map { "  $_" } @field_defs, @constraint_defs ).
 384                             "\n);"
 385                             ;
 386
 387     $create_statement .= "\n" . join(";\n", @index_defs) . "\n";
 388
 389     return $create_statement, \@fks;
 390 }
 391
 392 {
 393
 394     my %field_name_scope;
 395
 396     sub create_field
 397     {
 398         my ($field, $options) = @_;
 399
 400         my $qt = $options->{quote_table_names} || '';
 401         my $qf = $options->{quote_field_names} || '';
 402         my $table_name = $field->table->name;
 403         my $constraint_defs = $options->{constraint_defs} || [];
 404
 405         $field_name_scope{$table_name} ||= {};
 406         my $field_name    = mk_name(
 407                                     $field->name, '', $field_name_scope{$table_name}, 1
 408                                     );
 409         my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
 410         $field->name($field_name_ur);
 411         my $field_comments = $field->comments
 412             ? "-- " . $field->comments . "\n  "
 413             : '';
 414
 415         my $field_def     = $field_comments.qq[$qf$field_name_ur$qf];
 416
 417         #
 418         # Datatype
 419         #
 420         my @size      = $field->size;
 421         my $data_type = lc $field->data_type;
 422         my %extra     = $field->extra;
 423         my $list      = $extra{'list'} || [];
 424         # todo deal with embedded quotes
 425         my $commalist = join( ', ', map { qq['$_'] } @$list );
 426         my $seq_name;
 427
 428         $field_def .= ' '. convert_datatype($field);
 429
 430         #
 431         # Default value -- disallow for timestamps
 432         #
 433 #        my $default = $data_type =~ /(timestamp|date)/i
 434 #            ? undef : $field->default_value;
 435         my $default = $field->default_value;
 436         if ( defined $default ) {
 437             my $qd = "'";
 438             $qd = '' if ($default eq 'now()' ||
 439                          $default eq 'CURRENT_TIMESTAMP');
 440             $field_def .= sprintf( ' DEFAULT %s',
 441                                    ( $field->is_auto_increment && $seq_name )
 442                                    ? qq[nextval('"$seq_name"'::text)] :
 443                                    ( $default =~ m/null/i ) ? 'NULL' : "$qd$default$qd"
 444                                    );
 445         }
 446
 447         #
 448         # Not null constraint
 449         #
 450         $field_def .= ' NOT NULL' unless $field->is_nullable;
 451
 452         return $field_def;
 453     }
 454 }
 455
 456 {
 457     my %used_index_names;
 458
 459     sub create_index
 460     {
 461         my ($index, $options) = @_;
 462
 463         my $qt = $options->{quote_table_names} ||'';
 464         my $qf = $options->{quote_field_names} ||'';
 465         my $table_name = $index->table->name;
 466 #        my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
 467
 468         my ($index_def, @constraint_defs);
 469
 470         $used_index_names{$table_name} ||= {};
 471         my $name = $index->name || '';
 472         if ( $name ) {
 473             $name = next_unused_name($name, $used_index_names{$table_name});
 474             $used_index_names{$name} = $name;
 475         }
 476
 477         my $type = $index->type || NORMAL;
 478         my @fields     =
 479             map { $_ =~ s/\(.+\)//; $_ }
 480         map { $qt ? $_ : unreserve($_, $table_name ) }
 481         $index->fields;
 482         next unless @fields;
 483
 484         my $def_start = qq[Constraint "$name" ];
 485         if ( $type eq PRIMARY_KEY ) {
 486             push @constraint_defs, "${def_start}PRIMARY KEY ".
 487                 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
 488         }
 489         elsif ( $type eq UNIQUE ) {
 490             push @constraint_defs, "${def_start}UNIQUE " .
 491                 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
 492         }
 493         elsif ( $type eq NORMAL ) {
 494             $index_def =
 495                 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
 496                 join( ', ', map { qq[$qf$_$qf] } @fields ).
 497                 ');'
 498                 ;
 499         }
 500         else {
 501             warn "Unknown index type ($type) on table $table_name.\n"
 502                 if $WARN;
 503         }
 504
 505         return $index_def, \@constraint_defs;
 506     }
 507
 508     sub create_constraint
 509     {
 510         my ($c, $options) = @_;
 511
 512         my $qf = $options->{quote_field_names} ||'';
 513         my $qt = $options->{quote_table_names} ||'';
 514         my $table_name = $c->table->name;
 515         my (@constraint_defs, @fks);
 516
 517         my $name = $c->name || '';
 518         if ( $name ) {
 519             $name = next_unused_name($name, \%used_index_names);
 520             $used_index_names{$name} = $name;
 521         }
 522
 523         my @fields     =
 524             map { $_ =~ s/\(.+\)//; $_ }
 525         map { $qt ? $_ : unreserve( $_, $table_name )}
 526         $c->fields;
 527
 528         my @rfields     =
 529             map { $_ =~ s/\(.+\)//; $_ }
 530         map { $qt ? $_ : unreserve( $_, $table_name )}
 531         $c->reference_fields;
 532
 533         next if !@fields && $c->type ne CHECK_C;
 534         my $def_start = $name ? qq[Constraint "$name" ] : '';
 535         if ( $c->type eq PRIMARY_KEY ) {
 536             push @constraint_defs, "${def_start}PRIMARY KEY ".
 537                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 538         }
 539         elsif ( $c->type eq UNIQUE ) {
 540             $name = next_unused_name($name, \%used_index_names);
 541             $used_index_names{$name} = $name;
 542             push @constraint_defs, "${def_start}UNIQUE " .
 543                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 544         }
 545         elsif ( $c->type eq CHECK_C ) {
 546             my $expression = $c->expression;
 547             push @constraint_defs, "${def_start}CHECK ($expression)";
 548         }
 549         elsif ( $c->type eq FOREIGN_KEY ) {
 550             my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
 551                 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
 552                 "\n  REFERENCES " . $qt . $c->reference_table . $qt;
 553
 554             if ( @rfields ) {
 555                 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
 556             }
 557
 558             if ( $c->match_type ) {
 559                 $def .= ' MATCH ' .
 560                     ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 561             }
 562
 563             if ( $c->on_delete ) {
 564                 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 565             }
 566
 567             if ( $c->on_update ) {
 568                 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 569             }
 570
 571             push @fks, "$def;";
 572         }
 573
 574         return \@constraint_defs, \@fks;
 575     }
 576 }
 577
 578 sub convert_datatype
 579 {
 580     my ($field) = @_;
 581
 582     my @size      = $field->size;
 583     my $data_type = lc $field->data_type;
 584
 585     if ( $data_type eq 'enum' ) {
 586 #        my $len = 0;
 587 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
 588 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
 589 #        push @$constraint_defs,
 590 #        qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
 591 #           qq[IN ($commalist))];
 592         $data_type = 'character varying';
 593     }
 594     elsif ( $data_type eq 'set' ) {
 595         $data_type = 'character varying';
 596     }
 597     elsif ( $field->is_auto_increment ) {
 598         if ( defined $size[0] && $size[0] > 11 ) {
 599             $data_type = 'bigserial';
 600         }
 601         else {
 602             $data_type = 'serial';
 603         }
 604         undef @size;
 605     }
 606     else {
 607         $data_type  = defined $translate{ $data_type } ?
 608             $translate{ $data_type } :
 609             $data_type;
 610     }
 611
 612     if ( $data_type =~ /timestamp/i ) {
 613         if ( defined $size[0] && $size[0] > 6 ) {
 614             $size[0] = 6;
 615         }
 616     }
 617
 618     if ( $data_type eq 'integer' ) {
 619         if ( defined $size[0] && $size[0] > 0) {
 620             if ( $size[0] > 10 ) {
 621                 $data_type = 'bigint';
 622             }
 623             elsif ( $size[0] < 5 ) {
 624                 $data_type = 'smallint';
 625             }
 626             else {
 627                 $data_type = 'integer';
 628             }
 629         }
 630         else {
 631             $data_type = 'integer';
 632         }
 633     }
 634
 635     #
 636     # PG doesn't need a size for integers or text
 637     #
 638     undef @size if $data_type =~ m/(integer|smallint|bigint|text)/;
 639
 640     if ( defined $size[0] && $size[0] > 0 ) {
 641         $data_type .= '(' . join( ',', @size ) . ')';
 642     }
 643     elsif (defined $size[0] && $data_type eq 'timestamp' ) {
 644         $data_type .= '(' . join( ',', @size ) . ')';
 645     }
 646
 647
 648     return $data_type;
 649 }
 650
 651
 652 sub alter_field
 653 {
 654     my ($from_field, $to_field) = @_;
 655
 656     die "Can't alter field in another table"
 657         if($from_field->table->name ne $to_field->table->name);
 658
 659     my @out;
 660     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
 661                        $to_field->table->name,
 662                        $to_field->name) if(!$to_field->is_nullable and
 663                                            $from_field->is_nullable);
 664
 665     my $from_dt = convert_datatype($from_field);
 666     my $to_dt   = convert_datatype($to_field);
 667     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
 668                        $to_field->table->name,
 669                        $to_field->name,
 670                        $to_dt) if($to_dt ne $from_dt);
 671
 672     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
 673                        $to_field->table->name,
 674                        $from_field->name,
 675                        $to_field->name) if($from_field->name ne $to_field->name);
 676
 677     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
 678                        $to_field->table->name,
 679                        $to_field->name,
 680                        $to_field->default_value)
 681         if(defined $to_field->default_value &&
 682            $from_field->default_value ne $to_field->default_value);
 683
 684     return wantarray ? @out : join("\n", @out);
 685
 686 }
 687
 688 sub add_field
 689 {
 690     my ($new_field) = @_;
 691
 692     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
 693                       $new_field->table->name,
 694                       create_field($new_field));
 695     return $out;
 696
 697 }
 698
 699 sub drop_field
 700 {
 701     my ($old_field) = @_;
 702
 703     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
 704                       $old_field->table->name,
 705                       $old_field->name);
 706
 707     return $out;
 708 }
 709
 710 1;
 711
 712 # -------------------------------------------------------------------
 713 # Life is full of misery, loneliness, and suffering --
 714 # and it's all over much too soon.
 715 # Woody Allen
 716 # -------------------------------------------------------------------
 717
 718 =pod
 719
 720 =head1 SEE ALSO
 721
 722 SQL::Translator, SQL::Translator::Producer::Oracle.
 723
 724 =head1 AUTHOR
 725
 726 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 727
 728 =cut