lib/SQL/Translator/Producer/PostgreSQL.pm

   1 package SQL::Translator::Producer::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.29 2007-06-04 04:01:14 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.29 $ =~ /(\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       => 'time',
  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     my $pargs          = $translator->producer_args;
 185
 186     my $postgres_version = $pargs->{postgres_version} || 0;
 187
 188     my $qt = '';
 189     $qt = '"' if ($translator->quote_table_names);
 190     my $qf = '';
 191     $qf = '"' if ($translator->quote_field_names);
 192
 193     my $output;
 194     $output .= header_comment unless ($no_comments);
 195 #    my %used_index_names;
 196
 197     my (@table_defs, @fks);
 198     for my $table ( $schema->get_tables ) {
 199
 200         my ($table_def, $fks) = create_table($table,
 201                                              { quote_table_names => $qt,
 202                                                quote_field_names => $qf,
 203                                                no_comments => $no_comments,
 204                                                postgres_version => $postgres_version,
 205                                                add_drop_table => $add_drop_table,});
 206         push @table_defs, $table_def;
 207         push @fks, @$fks;
 208
 209     }
 210
 211     $output = join("\n\n", @table_defs);
 212     if ( @fks ) {
 213         $output .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
 214         $output .= join( "\n\n", @fks ) . "\n";
 215     }
 216
 217     if ( $WARN ) {
 218         if ( %truncated ) {
 219             warn "Truncated " . keys( %truncated ) . " names:\n";
 220             warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
 221         }
 222
 223         if ( %unreserve ) {
 224             warn "Encounted " . keys( %unreserve ) .
 225                 " unsafe names in schema (reserved or invalid):\n";
 226             warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
 227         }
 228     }
 229
 230     return $output;
 231 }
 232
 233 # -------------------------------------------------------------------
 234 sub mk_name {
 235     my $basename      = shift || '';
 236     my $type          = shift || '';
 237     my $scope         = shift || '';
 238     my $critical      = shift || '';
 239     my $basename_orig = $basename;
 240 #    my $max_id_length = 62;
 241     my $max_name      = $type
 242                         ? $max_id_length - (length($type) + 1)
 243                         : $max_id_length;
 244     $basename         = substr( $basename, 0, $max_name )
 245                         if length( $basename ) > $max_name;
 246     my $name          = $type ? "${type}_$basename" : $basename;
 247
 248     if ( $basename ne $basename_orig and $critical ) {
 249         my $show_type = $type ? "+'$type'" : "";
 250         warn "Truncating '$basename_orig'$show_type to $max_id_length ",
 251             "character limit to make '$name'\n" if $WARN;
 252         $truncated{ $basename_orig } = $name;
 253     }
 254
 255     $scope ||= \%global_names;
 256     if ( my $prev = $scope->{ $name } ) {
 257         my $name_orig = $name;
 258         $name        .= sprintf( "%02d", ++$prev );
 259         substr($name, $max_id_length - 3) = "00"
 260             if length( $name ) > $max_id_length;
 261
 262         warn "The name '$name_orig' has been changed to ",
 263              "'$name' to make it unique.\n" if $WARN;
 264
 265         $scope->{ $name_orig }++;
 266     }
 267
 268     $scope->{ $name }++;
 269     return $name;
 270 }
 271
 272 # -------------------------------------------------------------------
 273 sub unreserve {
 274     my $name            = shift || '';
 275     my $schema_obj_name = shift || '';
 276
 277     my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
 278
 279     # also trap fields that don't begin with a letter
 280     return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
 281
 282     if ( $schema_obj_name ) {
 283         ++$unreserve{"$schema_obj_name.$name"};
 284     }
 285     else {
 286         ++$unreserve{"$name (table name)"};
 287     }
 288
 289     my $unreserve = sprintf '%s_', $name;
 290     return $unreserve.$suffix;
 291 }
 292
 293 # -------------------------------------------------------------------
 294 sub next_unused_name {
 295     my $name       = shift || '';
 296     my $used_names = shift || '';
 297
 298     my %used_names = %$used_names;
 299
 300     if ( !defined($used_names{$name}) ) {
 301         $used_names{$name} = $name;
 302         return $name;
 303     }
 304
 305     my $i = 2;
 306     while ( defined($used_names{$name . $i}) ) {
 307         ++$i;
 308     }
 309     $name .= $i;
 310     $used_names{$name} = $name;
 311     return $name;
 312 }
 313
 314 sub create_table
 315 {
 316     my ($table, $options) = @_;
 317
 318     my $qt = $options->{quote_table_names} || '';
 319     my $qf = $options->{quote_field_names} || '';
 320     my $no_comments = $options->{no_comments} || 0;
 321     my $add_drop_table = $options->{add_drop_table} || 0;
 322     my $postgres_version = $options->{postgres_version} || 0;
 323
 324     my $table_name    = $table->name or next;
 325     $table_name       = mk_name( $table_name, '', undef, 1 );
 326     my $table_name_ur = $qt ? $table_name : unreserve($table_name);
 327     $table->name($table_name_ur);
 328
 329 # print STDERR "$table_name table_name\n";
 330     my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
 331
 332     push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
 333
 334     if ( $table->comments and !$no_comments ){
 335         my $c = "-- Comments: \n-- ";
 336         $c .= join "\n-- ",  $table->comments;
 337         $c .= "\n--\n";
 338         push @comments, $c;
 339     }
 340
 341     #
 342     # Fields
 343     #
 344     my %field_name_scope;
 345     for my $field ( $table->get_fields ) {
 346         push @field_defs, create_field($field, { quote_table_names => $qt,
 347                                                  quote_field_names => $qf,
 348                                                  table_name => $table_name_ur,
 349                                                  postgres_version => $postgres_version,
 350                                                  type_defs => \@type_defs,
 351                                                  type_drops => \@type_drops,
 352                                                  constraint_defs => \@constraint_defs,});
 353     }
 354
 355     #
 356     # Index Declarations
 357     #
 358     my @index_defs = ();
 359  #   my $idx_name_default;
 360     for my $index ( $table->get_indices ) {
 361         my ($idef, $constraints) = create_index($index,
 362                                               {
 363                                                   quote_field_names => $qf,
 364                                                   quote_table_names => $qt,
 365                                                   table_name => $table_name,
 366                                               });
 367         $idef and push @index_defs, $idef;
 368         push @constraint_defs, @$constraints;
 369     }
 370
 371     #
 372     # Table constraints
 373     #
 374     my $c_name_default;
 375     for my $c ( $table->get_constraints ) {
 376         my ($cdefs, $fks) = create_constraint($c,
 377                                               {
 378                                                   quote_field_names => $qf,
 379                                                   quote_table_names => $qt,
 380                                                   table_name => $table_name,
 381                                               });
 382         push @constraint_defs, @$cdefs;
 383         push @fks, @$fks;
 384     }
 385
 386     my $create_statement;
 387     $create_statement = join("\n", @comments);
 388     if ($add_drop_table) {
 389         if ($postgres_version >= 8.2) {
 390             $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
 391             $create_statement .= join ("\n", @type_drops) . "\n"
 392                 if $postgres_version >= 8.3;
 393         } else {
 394             $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
 395         }
 396     }
 397     $create_statement .= join("\n", @type_defs) . "\n"
 398         if $postgres_version >= 8.3;
 399     $create_statement .= qq[CREATE TABLE $qt$table_name_ur$qt (\n].
 400                             join( ",\n", map { "  $_" } @field_defs, @constraint_defs ).
 401                             "\n);"
 402                             ;
 403
 404     $create_statement .= "\n" . join(";\n", @index_defs) . "\n";
 405
 406     return $create_statement, \@fks;
 407 }
 408
 409 {
 410
 411     my %field_name_scope;
 412
 413     sub create_field
 414     {
 415         my ($field, $options) = @_;
 416
 417         my $qt = $options->{quote_table_names} || '';
 418         my $qf = $options->{quote_field_names} || '';
 419         my $table_name = $field->table->name;
 420         my $constraint_defs = $options->{constraint_defs} || [];
 421         my $postgres_version = $options->{postgres_version} || 0;
 422         my $type_defs = $options->{type_defs} || [];
 423         my $type_drops = $options->{type_drops} || [];
 424
 425         $field_name_scope{$table_name} ||= {};
 426         my $field_name    = mk_name(
 427                                     $field->name, '', $field_name_scope{$table_name}, 1
 428                                     );
 429         my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
 430         $field->name($field_name_ur);
 431         my $field_comments = $field->comments
 432             ? "-- " . $field->comments . "\n  "
 433             : '';
 434
 435         my $field_def     = $field_comments.qq[$qf$field_name_ur$qf];
 436
 437         #
 438         # Datatype
 439         #
 440         my @size      = $field->size;
 441         my $data_type = lc $field->data_type;
 442         my %extra     = $field->extra;
 443         my $list      = $extra{'list'} || [];
 444         # todo deal with embedded quotes
 445         my $commalist = join( ', ', map { qq['$_'] } @$list );
 446         my $seq_name;
 447
 448         if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
 449             my $type_name = $field->table->name . '_' . $field->name . '_type';
 450             $field_def .= ' '. $type_name;
 451             push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist);";
 452             push @$type_drops, "DROP TYPE IF EXISTS $type_name;";
 453         } else {
 454             $field_def .= ' '. convert_datatype($field);
 455         }
 456
 457         #
 458         # Default value -- disallow for timestamps
 459         #
 460 #        my $default = $data_type =~ /(timestamp|date)/i
 461 #            ? undef : $field->default_value;
 462         my $default = $field->default_value;
 463         if ( defined $default ) {
 464             my $qd = "'";
 465             $qd = '' if ($default eq 'now()' ||
 466                          $default eq 'CURRENT_TIMESTAMP');
 467             $field_def .= sprintf( ' DEFAULT %s',
 468                                    ( $field->is_auto_increment && $seq_name )
 469                                    ? qq[nextval('"$seq_name"'::text)] :
 470                                    ( $default =~ m/null/i ) ? 'NULL' : "$qd$default$qd"
 471                                    );
 472         }
 473
 474         #
 475         # Not null constraint
 476         #
 477         $field_def .= ' NOT NULL' unless $field->is_nullable;
 478
 479         return $field_def;
 480     }
 481 }
 482
 483 {
 484     my %used_index_names;
 485
 486     sub create_index
 487     {
 488         my ($index, $options) = @_;
 489
 490         my $qt = $options->{quote_table_names} ||'';
 491         my $qf = $options->{quote_field_names} ||'';
 492         my $table_name = $index->table->name;
 493 #        my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
 494
 495         my ($index_def, @constraint_defs);
 496
 497         $used_index_names{$table_name} ||= {};
 498         my $name = $index->name || '';
 499         if ( $name ) {
 500             $name = next_unused_name($name, $used_index_names{$table_name});
 501             $used_index_names{$name} = $name;
 502         }
 503
 504         my $type = $index->type || NORMAL;
 505         my @fields     =
 506             map { $_ =~ s/\(.+\)//; $_ }
 507         map { $qt ? $_ : unreserve($_, $table_name ) }
 508         $index->fields;
 509         next unless @fields;
 510
 511         my $def_start = qq[Constraint "$name" ];
 512         if ( $type eq PRIMARY_KEY ) {
 513             push @constraint_defs, "${def_start}PRIMARY KEY ".
 514                 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
 515         }
 516         elsif ( $type eq UNIQUE ) {
 517             push @constraint_defs, "${def_start}UNIQUE " .
 518                 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
 519         }
 520         elsif ( $type eq NORMAL ) {
 521             $index_def =
 522                 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
 523                 join( ', ', map { qq[$qf$_$qf] } @fields ).
 524                 ');'
 525                 ;
 526         }
 527         else {
 528             warn "Unknown index type ($type) on table $table_name.\n"
 529                 if $WARN;
 530         }
 531
 532         return $index_def, \@constraint_defs;
 533     }
 534
 535     sub create_constraint
 536     {
 537         my ($c, $options) = @_;
 538
 539         my $qf = $options->{quote_field_names} ||'';
 540         my $qt = $options->{quote_table_names} ||'';
 541         my $table_name = $c->table->name;
 542         my (@constraint_defs, @fks);
 543
 544         my $name = $c->name || '';
 545         if ( $name ) {
 546             $name = next_unused_name($name, \%used_index_names);
 547             $used_index_names{$name} = $name;
 548         }
 549
 550         my @fields     =
 551             map { $_ =~ s/\(.+\)//; $_ }
 552         map { $qt ? $_ : unreserve( $_, $table_name )}
 553         $c->fields;
 554
 555         my @rfields     =
 556             map { $_ =~ s/\(.+\)//; $_ }
 557         map { $qt ? $_ : unreserve( $_, $table_name )}
 558         $c->reference_fields;
 559
 560         next if !@fields && $c->type ne CHECK_C;
 561         my $def_start = $name ? qq[Constraint "$name" ] : '';
 562         if ( $c->type eq PRIMARY_KEY ) {
 563             push @constraint_defs, "${def_start}PRIMARY KEY ".
 564                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 565         }
 566         elsif ( $c->type eq UNIQUE ) {
 567             $name = next_unused_name($name, \%used_index_names);
 568             $used_index_names{$name} = $name;
 569             push @constraint_defs, "${def_start}UNIQUE " .
 570                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 571         }
 572         elsif ( $c->type eq CHECK_C ) {
 573             my $expression = $c->expression;
 574             push @constraint_defs, "${def_start}CHECK ($expression)";
 575         }
 576         elsif ( $c->type eq FOREIGN_KEY ) {
 577             my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
 578                 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
 579                 "\n  REFERENCES " . $qt . $c->reference_table . $qt;
 580
 581             if ( @rfields ) {
 582                 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
 583             }
 584
 585             if ( $c->match_type ) {
 586                 $def .= ' MATCH ' .
 587                     ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 588             }
 589
 590             if ( $c->on_delete ) {
 591                 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 592             }
 593
 594             if ( $c->on_update ) {
 595                 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 596             }
 597
 598             if ( $c->deferrable ) {
 599                 $def .= ' DEFERRABLE';
 600             }
 601
 602             push @fks, "$def;";
 603         }
 604
 605         return \@constraint_defs, \@fks;
 606     }
 607 }
 608
 609 sub convert_datatype
 610 {
 611     my ($field) = @_;
 612
 613     my @size      = $field->size;
 614     my $data_type = lc $field->data_type;
 615
 616     if ( $data_type eq 'enum' ) {
 617 #        my $len = 0;
 618 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
 619 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
 620 #        push @$constraint_defs,
 621 #        qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
 622 #           qq[IN ($commalist))];
 623         $data_type = 'character varying';
 624     }
 625     elsif ( $data_type eq 'set' ) {
 626         $data_type = 'character varying';
 627     }
 628     elsif ( $field->is_auto_increment ) {
 629         if ( defined $size[0] && $size[0] > 11 ) {
 630             $data_type = 'bigserial';
 631         }
 632         else {
 633             $data_type = 'serial';
 634         }
 635         undef @size;
 636     }
 637     else {
 638         $data_type  = defined $translate{ $data_type } ?
 639             $translate{ $data_type } :
 640             $data_type;
 641     }
 642
 643     if ( $data_type =~ /timestamp/i ) {
 644         if ( defined $size[0] && $size[0] > 6 ) {
 645             $size[0] = 6;
 646         }
 647     }
 648
 649     if ( $data_type eq 'integer' ) {
 650         if ( defined $size[0] && $size[0] > 0) {
 651             if ( $size[0] > 10 ) {
 652                 $data_type = 'bigint';
 653             }
 654             elsif ( $size[0] < 5 ) {
 655                 $data_type = 'smallint';
 656             }
 657             else {
 658                 $data_type = 'integer';
 659             }
 660         }
 661         else {
 662             $data_type = 'integer';
 663         }
 664     }
 665     my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
 666                                integer smallint text line lseg macaddr money
 667                                path point polygon real/;
 668     foreach (@type_without_size) {
 669         if ( $data_type =~ qr/$_/ ) {
 670             undef @size; last;
 671         }
 672     }
 673
 674     if ( defined $size[0] && $size[0] > 0 ) {
 675         $data_type .= '(' . join( ',', @size ) . ')';
 676     }
 677     elsif (defined $size[0] && $data_type eq 'timestamp' ) {
 678         $data_type .= '(' . join( ',', @size ) . ')';
 679     }
 680
 681
 682     return $data_type;
 683 }
 684
 685
 686 sub alter_field
 687 {
 688     my ($from_field, $to_field) = @_;
 689
 690     die "Can't alter field in another table"
 691         if($from_field->table->name ne $to_field->table->name);
 692
 693     my @out;
 694     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
 695                        $to_field->table->name,
 696                        $to_field->name) if(!$to_field->is_nullable and
 697                                            $from_field->is_nullable);
 698
 699     my $from_dt = convert_datatype($from_field);
 700     my $to_dt   = convert_datatype($to_field);
 701     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
 702                        $to_field->table->name,
 703                        $to_field->name,
 704                        $to_dt) if($to_dt ne $from_dt);
 705
 706     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
 707                        $to_field->table->name,
 708                        $from_field->name,
 709                        $to_field->name) if($from_field->name ne $to_field->name);
 710
 711     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
 712                        $to_field->table->name,
 713                        $to_field->name,
 714                        $to_field->default_value)
 715         if(defined $to_field->default_value &&
 716            $from_field->default_value ne $to_field->default_value);
 717
 718     return wantarray ? @out : join("\n", @out);
 719
 720 }
 721
 722 sub add_field
 723 {
 724     my ($new_field) = @_;
 725
 726     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
 727                       $new_field->table->name,
 728                       create_field($new_field));
 729     return $out;
 730
 731 }
 732
 733 sub drop_field
 734 {
 735     my ($old_field) = @_;
 736
 737     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
 738                       $old_field->table->name,
 739                       $old_field->name);
 740
 741     return $out;
 742 }
 743
 744 1;
 745
 746 # -------------------------------------------------------------------
 747 # Life is full of misery, loneliness, and suffering --
 748 # and it's all over much too soon.
 749 # Woody Allen
 750 # -------------------------------------------------------------------
 751
 752 =pod
 753
 754 =head1 SEE ALSO
 755
 756 SQL::Translator, SQL::Translator::Producer::Oracle.
 757
 758 =head1 AUTHOR
 759
 760 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 761
 762 =cut