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 %used_names ];
  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     local %used_names  = ();
 186
 187     my $postgres_version = $pargs->{postgres_version} || 0;
 188
 189     my $qt = '';
 190     $qt = '"' if ($translator->quote_table_names);
 191     my $qf = '';
 192     $qf = '"' if ($translator->quote_field_names);
 193
 194     my $output;
 195     $output .= header_comment unless ($no_comments);
 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     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
 311 sub create_table
 312 {
 313     my ($table, $options) = @_;
 314
 315     my $qt = $options->{quote_table_names} || '';
 316     my $qf = $options->{quote_field_names} || '';
 317     my $no_comments = $options->{no_comments} || 0;
 318     my $add_drop_table = $options->{add_drop_table} || 0;
 319     my $postgres_version = $options->{postgres_version} || 0;
 320
 321     my $table_name    = $table->name or next;
 322     $table_name       = mk_name( $table_name, '', undef, 1 );
 323     my $table_name_ur = $qt ? $table_name : unreserve($table_name);
 324     $table->name($table_name_ur);
 325
 326 # print STDERR "$table_name table_name\n";
 327     my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
 328
 329     push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
 330
 331     if ( $table->comments and !$no_comments ){
 332         my $c = "-- Comments: \n-- ";
 333         $c .= join "\n-- ",  $table->comments;
 334         $c .= "\n--\n";
 335         push @comments, $c;
 336     }
 337
 338     #
 339     # Fields
 340     #
 341     my %field_name_scope;
 342     for my $field ( $table->get_fields ) {
 343         push @field_defs, create_field($field, { quote_table_names => $qt,
 344                                                  quote_field_names => $qf,
 345                                                  table_name => $table_name_ur,
 346                                                  postgres_version => $postgres_version,
 347                                                  type_defs => \@type_defs,
 348                                                  type_drops => \@type_drops,
 349                                                  constraint_defs => \@constraint_defs,});
 350     }
 351
 352     #
 353     # Index Declarations
 354     #
 355     my @index_defs = ();
 356  #   my $idx_name_default;
 357     for my $index ( $table->get_indices ) {
 358         my ($idef, $constraints) = create_index($index,
 359                                               {
 360                                                   quote_field_names => $qf,
 361                                                   quote_table_names => $qt,
 362                                                   table_name => $table_name,
 363                                               });
 364         $idef and push @index_defs, $idef;
 365         push @constraint_defs, @$constraints;
 366     }
 367
 368     #
 369     # Table constraints
 370     #
 371     my $c_name_default;
 372     for my $c ( $table->get_constraints ) {
 373         my ($cdefs, $fks) = create_constraint($c,
 374                                               {
 375                                                   quote_field_names => $qf,
 376                                                   quote_table_names => $qt,
 377                                                   table_name => $table_name,
 378                                               });
 379         push @constraint_defs, @$cdefs;
 380         push @fks, @$fks;
 381     }
 382
 383     my $create_statement;
 384     $create_statement = join("\n", @comments);
 385     if ($add_drop_table) {
 386         if ($postgres_version >= 8.2) {
 387             $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
 388             $create_statement .= join ("\n", @type_drops) . "\n"
 389                 if $postgres_version >= 8.3;
 390         } else {
 391             $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
 392         }
 393     }
 394     $create_statement .= join("\n", @type_defs) . "\n"
 395         if $postgres_version >= 8.3;
 396     $create_statement .= qq[CREATE TABLE $qt$table_name_ur$qt (\n].
 397                             join( ",\n", map { "  $_" } @field_defs, @constraint_defs ).
 398                             "\n);"
 399                             ;
 400
 401     $create_statement .= "\n" . join("\n", @index_defs) . "\n";
 402
 403     return $create_statement, \@fks;
 404 }
 405
 406 {
 407
 408     my %field_name_scope;
 409
 410     sub create_field
 411     {
 412         my ($field, $options) = @_;
 413
 414         my $qt = $options->{quote_table_names} || '';
 415         my $qf = $options->{quote_field_names} || '';
 416         my $table_name = $field->table->name;
 417         my $constraint_defs = $options->{constraint_defs} || [];
 418         my $postgres_version = $options->{postgres_version} || 0;
 419         my $type_defs = $options->{type_defs} || [];
 420         my $type_drops = $options->{type_drops} || [];
 421
 422         $field_name_scope{$table_name} ||= {};
 423         my $field_name    = mk_name(
 424                                     $field->name, '', $field_name_scope{$table_name}, 1
 425                                     );
 426         my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
 427         $field->name($field_name_ur);
 428         my $field_comments = $field->comments
 429             ? "-- " . $field->comments . "\n  "
 430             : '';
 431
 432         my $field_def     = $field_comments.qq[$qf$field_name_ur$qf];
 433
 434         #
 435         # Datatype
 436         #
 437         my @size      = $field->size;
 438         my $data_type = lc $field->data_type;
 439         my %extra     = $field->extra;
 440         my $list      = $extra{'list'} || [];
 441         # todo deal with embedded quotes
 442         my $commalist = join( ', ', map { qq['$_'] } @$list );
 443         my $seq_name;
 444
 445         if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
 446             my $type_name = $field->table->name . '_' . $field->name . '_type';
 447             $field_def .= ' '. $type_name;
 448             push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist);";
 449             push @$type_drops, "DROP TYPE IF EXISTS $type_name;";
 450         } else {
 451             $field_def .= ' '. convert_datatype($field);
 452         }
 453
 454         #
 455         # Default value -- disallow for timestamps
 456         #
 457 #        my $default = $data_type =~ /(timestamp|date)/i
 458 #            ? undef : $field->default_value;
 459         my $default = $field->default_value;
 460         if ( defined $default ) {
 461             my $qd = "'";
 462             $qd = '' if ($default eq 'now()' ||
 463                          $default eq 'CURRENT_TIMESTAMP');
 464             $field_def .= sprintf( ' DEFAULT %s',
 465                                    ( $field->is_auto_increment && $seq_name )
 466                                    ? qq[nextval('"$seq_name"'::text)] :
 467                                    ( $default =~ m/null/i ) ? 'NULL' : "$qd$default$qd"
 468                                    );
 469         }
 470
 471         #
 472         # Not null constraint
 473         #
 474         $field_def .= ' NOT NULL' unless $field->is_nullable;
 475
 476         return $field_def;
 477     }
 478 }
 479
 480     sub create_index
 481     {
 482         my ($index, $options) = @_;
 483
 484         my $qt = $options->{quote_table_names} ||'';
 485         my $qf = $options->{quote_field_names} ||'';
 486         my $table_name = $index->table->name;
 487 #        my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
 488
 489         my ($index_def, @constraint_defs);
 490
 491         my $name = $index->name || '';
 492         if ( $name ) {
 493             $name = next_unused_name($name);
 494         }
 495
 496         my $type = $index->type || NORMAL;
 497         my @fields     =
 498             map { $_ =~ s/\(.+\)//; $_ }
 499         map { $qt ? $_ : unreserve($_, $table_name ) }
 500         $index->fields;
 501         next unless @fields;
 502
 503         my $def_start = qq[Constraint "$name" ];
 504         if ( $type eq PRIMARY_KEY ) {
 505             push @constraint_defs, "${def_start}PRIMARY KEY ".
 506                 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
 507         }
 508         elsif ( $type eq UNIQUE ) {
 509             push @constraint_defs, "${def_start}UNIQUE " .
 510                 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
 511         }
 512         elsif ( $type eq NORMAL ) {
 513             $index_def =
 514                 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
 515                 join( ', ', map { qq[$qf$_$qf] } @fields ).
 516                 ');'
 517                 ;
 518         }
 519         else {
 520             warn "Unknown index type ($type) on table $table_name.\n"
 521                 if $WARN;
 522         }
 523
 524         return $index_def, \@constraint_defs;
 525     }
 526
 527     sub create_constraint
 528     {
 529         my ($c, $options) = @_;
 530
 531         my $qf = $options->{quote_field_names} ||'';
 532         my $qt = $options->{quote_table_names} ||'';
 533         my $table_name = $c->table->name;
 534         my (@constraint_defs, @fks);
 535
 536         my $name = $c->name || '';
 537         if ( $name ) {
 538             $name = next_unused_name($name);
 539         }
 540
 541         my @fields     =
 542             map { $_ =~ s/\(.+\)//; $_ }
 543         map { $qt ? $_ : unreserve( $_, $table_name )}
 544         $c->fields;
 545
 546         my @rfields     =
 547             map { $_ =~ s/\(.+\)//; $_ }
 548         map { $qt ? $_ : unreserve( $_, $table_name )}
 549         $c->reference_fields;
 550
 551         next if !@fields && $c->type ne CHECK_C;
 552         my $def_start = $name ? qq[Constraint "$name" ] : '';
 553         if ( $c->type eq PRIMARY_KEY ) {
 554             push @constraint_defs, "${def_start}PRIMARY KEY ".
 555                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 556         }
 557         elsif ( $c->type eq UNIQUE ) {
 558             $name = next_unused_name($name);
 559             push @constraint_defs, "${def_start}UNIQUE " .
 560                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 561         }
 562         elsif ( $c->type eq CHECK_C ) {
 563             my $expression = $c->expression;
 564             push @constraint_defs, "${def_start}CHECK ($expression)";
 565         }
 566         elsif ( $c->type eq FOREIGN_KEY ) {
 567             my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
 568                 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
 569                 "\n  REFERENCES " . $qt . $c->reference_table . $qt;
 570
 571             if ( @rfields ) {
 572                 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
 573             }
 574
 575             if ( $c->match_type ) {
 576                 $def .= ' MATCH ' .
 577                     ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 578             }
 579
 580             if ( $c->on_delete ) {
 581                 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 582             }
 583
 584             if ( $c->on_update ) {
 585                 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 586             }
 587
 588             if ( $c->deferrable ) {
 589                 $def .= ' DEFERRABLE';
 590             }
 591
 592             push @fks, "$def;";
 593         }
 594
 595         return \@constraint_defs, \@fks;
 596     }
 597
 598 sub convert_datatype
 599 {
 600     my ($field) = @_;
 601
 602     my @size      = $field->size;
 603     my $data_type = lc $field->data_type;
 604
 605     if ( $data_type eq 'enum' ) {
 606 #        my $len = 0;
 607 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
 608 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
 609 #        push @$constraint_defs,
 610 #        qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
 611 #           qq[IN ($commalist))];
 612         $data_type = 'character varying';
 613     }
 614     elsif ( $data_type eq 'set' ) {
 615         $data_type = 'character varying';
 616     }
 617     elsif ( $field->is_auto_increment ) {
 618         if ( defined $size[0] && $size[0] > 11 ) {
 619             $data_type = 'bigserial';
 620         }
 621         else {
 622             $data_type = 'serial';
 623         }
 624         undef @size;
 625     }
 626     else {
 627         $data_type  = defined $translate{ $data_type } ?
 628             $translate{ $data_type } :
 629             $data_type;
 630     }
 631
 632     if ( $data_type =~ /timestamp/i ) {
 633         if ( defined $size[0] && $size[0] > 6 ) {
 634             $size[0] = 6;
 635         }
 636     }
 637
 638     if ( $data_type eq 'integer' ) {
 639         if ( defined $size[0] && $size[0] > 0) {
 640             if ( $size[0] > 10 ) {
 641                 $data_type = 'bigint';
 642             }
 643             elsif ( $size[0] < 5 ) {
 644                 $data_type = 'smallint';
 645             }
 646             else {
 647                 $data_type = 'integer';
 648             }
 649         }
 650         else {
 651             $data_type = 'integer';
 652         }
 653     }
 654     my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
 655                                integer smallint text line lseg macaddr money
 656                                path point polygon real/;
 657     foreach (@type_without_size) {
 658         if ( $data_type =~ qr/$_/ ) {
 659             undef @size; last;
 660         }
 661     }
 662
 663     if ( defined $size[0] && $size[0] > 0 ) {
 664         $data_type .= '(' . join( ',', @size ) . ')';
 665     }
 666     elsif (defined $size[0] && $data_type eq 'timestamp' ) {
 667         $data_type .= '(' . join( ',', @size ) . ')';
 668     }
 669
 670
 671     return $data_type;
 672 }
 673
 674
 675 sub alter_field
 676 {
 677     my ($from_field, $to_field) = @_;
 678
 679     die "Can't alter field in another table"
 680         if($from_field->table->name ne $to_field->table->name);
 681
 682     my @out;
 683     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
 684                        $to_field->table->name,
 685                        $to_field->name) if(!$to_field->is_nullable and
 686                                            $from_field->is_nullable);
 687
 688     my $from_dt = convert_datatype($from_field);
 689     my $to_dt   = convert_datatype($to_field);
 690     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
 691                        $to_field->table->name,
 692                        $to_field->name,
 693                        $to_dt) if($to_dt ne $from_dt);
 694
 695     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
 696                        $to_field->table->name,
 697                        $from_field->name,
 698                        $to_field->name) if($from_field->name ne $to_field->name);
 699
 700     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
 701                        $to_field->table->name,
 702                        $to_field->name,
 703                        $to_field->default_value)
 704         if(defined $to_field->default_value &&
 705            $from_field->default_value ne $to_field->default_value);
 706
 707     return wantarray ? @out : join("\n", @out);
 708
 709 }
 710
 711 sub add_field
 712 {
 713     my ($new_field) = @_;
 714
 715     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
 716                       $new_field->table->name,
 717                       create_field($new_field));
 718     return $out;
 719
 720 }
 721
 722 sub drop_field
 723 {
 724     my ($old_field) = @_;
 725
 726     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
 727                       $old_field->table->name,
 728                       $old_field->name);
 729
 730     return $out;
 731 }
 732
 733 1;
 734
 735 # -------------------------------------------------------------------
 736 # Life is full of misery, loneliness, and suffering --
 737 # and it's all over much too soon.
 738 # Woody Allen
 739 # -------------------------------------------------------------------
 740
 741 =pod
 742
 743 =head1 SEE ALSO
 744
 745 SQL::Translator, SQL::Translator::Producer::Oracle.
 746
 747 =head1 AUTHOR
 748
 749 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 750
 751 =cut