lib/SQL/Translator/Producer/PostgreSQL.pm

   1 package SQL::Translator::Producer::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.25 2006-08-04 21:38:20 schiffbruechige 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.25 $ =~ /(\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 );
 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         if ( defined $default ) {
 436             $field_def .= sprintf( ' DEFAULT %s',
 437                                    ( $field->is_auto_increment && $seq_name )
 438                                    ? qq[nextval('"$seq_name"'::text)] :
 439                                    ( $default =~ m/null/i ) ? 'NULL' : "'$default'"
 440                                    );
 441         }
 442
 443         #
 444         # Not null constraint
 445         #
 446         $field_def .= ' NOT NULL' unless $field->is_nullable;
 447
 448         return $field_def;
 449     }
 450 }
 451
 452 {
 453     my %used_index_names;
 454
 455     sub create_index
 456     {
 457         my ($index, $options) = @_;
 458
 459         my $qt = $options->{quote_table_names} ||'';
 460         my $qf = $options->{quote_field_names} ||'';
 461         my $table_name = $index->table->name;
 462 #        my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
 463
 464         my ($index_def, @constraint_defs);
 465
 466         $used_index_names{$table_name} ||= {};
 467         my $name = $index->name || '';
 468         if ( $name ) {
 469             $name = next_unused_name($name, $used_index_names{$table_name});
 470             $used_index_names{$name} = $name;
 471         }
 472
 473         my $type = $index->type || NORMAL;
 474         my @fields     =
 475             map { $_ =~ s/\(.+\)//; $_ }
 476         map { $qt ? $_ : unreserve($_, $table_name ) }
 477         $index->fields;
 478         next unless @fields;
 479
 480         my $def_start = qq[Constraint "$name" ];
 481         if ( $type eq PRIMARY_KEY ) {
 482             push @constraint_defs, "${def_start}PRIMARY KEY ".
 483                 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
 484         }
 485         elsif ( $type eq UNIQUE ) {
 486             push @constraint_defs, "${def_start}UNIQUE " .
 487                 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
 488         }
 489         elsif ( $type eq NORMAL ) {
 490             $index_def =
 491                 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
 492                 join( ', ', map { qq[$qf$_$qf] } @fields ).
 493                 ');'
 494                 ;
 495         }
 496         else {
 497             warn "Unknown index type ($type) on table $table_name.\n"
 498                 if $WARN;
 499         }
 500
 501         return $index_def, \@constraint_defs;
 502     }
 503
 504     sub create_constraint
 505     {
 506         my ($c, $options) = @_;
 507
 508         my $qf = $options->{quote_field_names} ||'';
 509         my $qt = $options->{quote_table_names} ||'';
 510         my $table_name = $c->table->name;
 511         my (@constraint_defs, @fks);
 512
 513         my $name = $c->name || '';
 514         if ( $name ) {
 515             $name = next_unused_name($name, \%used_index_names);
 516             $used_index_names{$name} = $name;
 517         }
 518
 519         my @fields     =
 520             map { $_ =~ s/\(.+\)//; $_ }
 521         map { $qt ? $_ : unreserve( $_, $table_name )}
 522         $c->fields;
 523
 524         my @rfields     =
 525             map { $_ =~ s/\(.+\)//; $_ }
 526         map { $qt ? $_ : unreserve( $_, $table_name )}
 527         $c->reference_fields;
 528
 529         next if !@fields && $c->type ne CHECK_C;
 530         my $def_start = $name ? qq[Constraint "$name" ] : '';
 531         if ( $c->type eq PRIMARY_KEY ) {
 532             push @constraint_defs, "${def_start}PRIMARY KEY ".
 533                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 534         }
 535         elsif ( $c->type eq UNIQUE ) {
 536             $name = next_unused_name($name, \%used_index_names);
 537             $used_index_names{$name} = $name;
 538             push @constraint_defs, "${def_start}UNIQUE " .
 539                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 540         }
 541         elsif ( $c->type eq CHECK_C ) {
 542             my $expression = $c->expression;
 543             push @constraint_defs, "${def_start}CHECK ($expression)";
 544         }
 545         elsif ( $c->type eq FOREIGN_KEY ) {
 546             my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
 547                 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
 548                 "\n  REFERENCES " . $qt . $c->reference_table . $qt;
 549
 550             if ( @rfields ) {
 551                 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
 552             }
 553
 554             if ( $c->match_type ) {
 555                 $def .= ' MATCH ' .
 556                     ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 557             }
 558
 559             if ( $c->on_delete ) {
 560                 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 561             }
 562
 563             if ( $c->on_update ) {
 564                 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 565             }
 566
 567             push @fks, "$def;";
 568         }
 569
 570         return \@constraint_defs, \@fks;
 571     }
 572 }
 573
 574 sub convert_datatype
 575 {
 576     my ($field) = @_;
 577
 578     my @size      = $field->size;
 579     my $data_type = lc $field->data_type;
 580
 581     if ( $data_type eq 'enum' ) {
 582 #        my $len = 0;
 583 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
 584 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
 585 #        push @$constraint_defs,
 586 #        qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
 587 #           qq[IN ($commalist))];
 588         $data_type = 'character varying';
 589     }
 590     elsif ( $data_type eq 'set' ) {
 591         $data_type = 'character varying';
 592     }
 593     elsif ( $field->is_auto_increment ) {
 594         if ( defined $size[0] && $size[0] > 11 ) {
 595             $data_type = 'bigserial';
 596         }
 597         else {
 598             $data_type = 'serial';
 599         }
 600         undef @size;
 601     }
 602     else {
 603         $data_type  = defined $translate{ $data_type } ?
 604             $translate{ $data_type } :
 605             $data_type;
 606     }
 607
 608     if ( $data_type =~ /timestamp/i ) {
 609         if ( defined $size[0] && $size[0] > 6 ) {
 610             $size[0] = 6;
 611         }
 612     }
 613
 614     if ( $data_type eq 'integer' ) {
 615         if ( defined $size[0] && $size[0] > 0) {
 616             if ( $size[0] > 10 ) {
 617                 $data_type = 'bigint';
 618             }
 619             elsif ( $size[0] < 5 ) {
 620                 $data_type = 'smallint';
 621             }
 622             else {
 623                 $data_type = 'integer';
 624             }
 625         }
 626         else {
 627             $data_type = 'integer';
 628         }
 629     }
 630
 631     #
 632     # PG doesn't need a size for integers or text
 633     #
 634     undef @size if $data_type =~ m/(integer|smallint|bigint|text)/;
 635
 636     if ( defined $size[0] && $size[0] > 0 ) {
 637         $data_type .= '(' . join( ',', @size ) . ')';
 638     }
 639     elsif (defined $size[0] && $data_type eq 'timestamp' ) {
 640         $data_type .= '(' . join( ',', @size ) . ')';
 641     }
 642
 643
 644     return $data_type;
 645 }
 646
 647
 648 sub alter_field
 649 {
 650     my ($from_field, $to_field) = @_;
 651
 652     die "Can't alter field in another table"
 653         if($from_field->table->name ne $to_field->table->name);
 654
 655     my @out;
 656     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
 657                        $to_field->table->name,
 658                        $to_field->name) if(!$to_field->is_nullable and
 659                                            $from_field->is_nullable);
 660
 661     my $from_dt = convert_datatype($from_field);
 662     my $to_dt   = convert_datatype($to_field);
 663     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
 664                        $to_field->table->name,
 665                        $to_field->name,
 666                        $to_dt) if($to_dt ne $from_dt);
 667
 668     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
 669                        $to_field->table->name,
 670                        $from_field->name,
 671                        $to_field->name) if($from_field->name ne $to_field->name);
 672
 673     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
 674                        $to_field->table->name,
 675                        $to_field->name,
 676                        $to_field->default_value)
 677         if(defined $to_field->default_value &&
 678            $from_field->default_value ne $to_field->default_value);
 679
 680     return wantarray ? @out : join("\n", @out);
 681
 682 }
 683
 684 sub add_field
 685 {
 686     my ($new_field) = @_;
 687
 688     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
 689                       $new_field->table->name,
 690                       create_field($new_field));
 691     return $out;
 692
 693 }
 694
 695 sub drop_field
 696 {
 697     my ($old_field) = @_;
 698
 699     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
 700                       $old_field->table->name,
 701                       $old_field->name);
 702
 703     return $out;
 704 }
 705
 706 1;
 707
 708 # -------------------------------------------------------------------
 709 # Life is full of misery, loneliness, and suffering --
 710 # and it's all over much too soon.
 711 # Woody Allen
 712 # -------------------------------------------------------------------
 713
 714 =pod
 715
 716 =head1 SEE ALSO
 717
 718 SQL::Translator, SQL::Translator::Producer::Oracle.
 719
 720 =head1 AUTHOR
 721
 722 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 723
 724 =cut