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