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(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     $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     for my $view ( $schema->get_views ) {
 212       push @table_defs, create_view($view, {
 213         add_replace_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
 420     my $view_name = $view->name;
 421     debug("PKG: Looking at view '${view_name}'\n");
 422
 423     my $create = '';
 424     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
 425         unless $options->{no_comments};
 426     $create .= 'CREATE';
 427     $create .= ' OR REPLACE' if $options->{add_replace_view};
 428
 429     my $extra = $view->extra;
 430     $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
 431     $create .= " VIEW ${qt}${view_name}${qt}";
 432
 433     if ( my @fields = $view->fields ) {
 434         my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
 435         $create .= " ( ${field_list} )";
 436     }
 437
 438     if ( my $sql = $view->sql ) {
 439         $create .= " AS (\n    ${sql}\n  )";
 440     }
 441
 442     if ( $extra->{check_option} ) {
 443         $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
 444     }
 445
 446     $create .= ";\n\n";
 447     return $create;
 448 }
 449
 450 {
 451
 452     my %field_name_scope;
 453
 454     sub create_field
 455     {
 456         my ($field, $options) = @_;
 457
 458         my $qt = $options->{quote_table_names} || '';
 459         my $qf = $options->{quote_field_names} || '';
 460         my $table_name = $field->table->name;
 461         my $constraint_defs = $options->{constraint_defs} || [];
 462         my $postgres_version = $options->{postgres_version} || 0;
 463         my $type_defs = $options->{type_defs} || [];
 464         my $type_drops = $options->{type_drops} || [];
 465
 466         $field_name_scope{$table_name} ||= {};
 467         my $field_name    = mk_name(
 468                                     $field->name, '', $field_name_scope{$table_name}, 1
 469                                     );
 470         my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
 471         $field->name($field_name_ur);
 472         my $field_comments = $field->comments
 473             ? "-- " . $field->comments . "\n  "
 474             : '';
 475
 476         my $field_def     = $field_comments.qq[$qf$field_name_ur$qf];
 477
 478         #
 479         # Datatype
 480         #
 481         my @size      = $field->size;
 482         my $data_type = lc $field->data_type;
 483         my %extra     = $field->extra;
 484         my $list      = $extra{'list'} || [];
 485         # todo deal with embedded quotes
 486         my $commalist = join( ', ', map { qq['$_'] } @$list );
 487         my $seq_name;
 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 -- disallow for timestamps
 500         #
 501 #        my $default = $data_type =~ /(timestamp|date)/i
 502 #            ? undef : $field->default_value;
 503         my $default = $field->default_value;
 504         if ( defined $default ) {
 505             my $qd = "'";
 506             $qd = '' if ($default eq 'now()' ||
 507                          $default eq 'CURRENT_TIMESTAMP');
 508             $field_def .= sprintf( ' DEFAULT %s',
 509                                    ( $field->is_auto_increment && $seq_name )
 510                                    ? qq[nextval('"$seq_name"'::text)] :
 511                                    ( $default =~ m/null/i ) ? 'NULL' : "$qd$default$qd"
 512                                    );
 513         }
 514
 515         #
 516         # Not null constraint
 517         #
 518         $field_def .= ' NOT NULL' unless $field->is_nullable;
 519
 520         return $field_def;
 521     }
 522 }
 523
 524     sub create_index
 525     {
 526         my ($index, $options) = @_;
 527
 528         my $qt = $options->{quote_table_names} ||'';
 529         my $qf = $options->{quote_field_names} ||'';
 530         my $table_name = $index->table->name;
 531 #        my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
 532
 533         my ($index_def, @constraint_defs);
 534
 535         my $name = $index->name || '';
 536         if ( $name ) {
 537             $name = next_unused_name($name);
 538         }
 539
 540         my $type = $index->type || NORMAL;
 541         my @fields     =
 542             map { $_ =~ s/\(.+\)//; $_ }
 543         map { $qt ? $_ : unreserve($_, $table_name ) }
 544         $index->fields;
 545         next unless @fields;
 546
 547         my $def_start = qq[Constraint "$name" ];
 548         if ( $type eq PRIMARY_KEY ) {
 549             push @constraint_defs, "${def_start}PRIMARY KEY ".
 550                 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
 551         }
 552         elsif ( $type eq UNIQUE ) {
 553             push @constraint_defs, "${def_start}UNIQUE " .
 554                 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
 555         }
 556         elsif ( $type eq NORMAL ) {
 557             $index_def =
 558                 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
 559                 join( ', ', map { qq[$qf$_$qf] } @fields ).
 560                 ');'
 561                 ;
 562         }
 563         else {
 564             warn "Unknown index type ($type) on table $table_name.\n"
 565                 if $WARN;
 566         }
 567
 568         return $index_def, \@constraint_defs;
 569     }
 570
 571     sub create_constraint
 572     {
 573         my ($c, $options) = @_;
 574
 575         my $qf = $options->{quote_field_names} ||'';
 576         my $qt = $options->{quote_table_names} ||'';
 577         my $table_name = $c->table->name;
 578         my (@constraint_defs, @fks);
 579
 580         my $name = $c->name || '';
 581         if ( $name ) {
 582             $name = next_unused_name($name);
 583         }
 584
 585         my @fields     =
 586             map { $_ =~ s/\(.+\)//; $_ }
 587         map { $qt ? $_ : unreserve( $_, $table_name )}
 588         $c->fields;
 589
 590         my @rfields     =
 591             map { $_ =~ s/\(.+\)//; $_ }
 592         map { $qt ? $_ : unreserve( $_, $table_name )}
 593         $c->reference_fields;
 594
 595         next if !@fields && $c->type ne CHECK_C;
 596         my $def_start = $name ? qq[Constraint "$name" ] : '';
 597         if ( $c->type eq PRIMARY_KEY ) {
 598             push @constraint_defs, "${def_start}PRIMARY KEY ".
 599                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 600         }
 601         elsif ( $c->type eq UNIQUE ) {
 602             $name = next_unused_name($name);
 603             push @constraint_defs, "${def_start}UNIQUE " .
 604                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 605         }
 606         elsif ( $c->type eq CHECK_C ) {
 607             my $expression = $c->expression;
 608             push @constraint_defs, "${def_start}CHECK ($expression)";
 609         }
 610         elsif ( $c->type eq FOREIGN_KEY ) {
 611             my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
 612                 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
 613                 "\n  REFERENCES " . $qt . $c->reference_table . $qt;
 614
 615             if ( @rfields ) {
 616                 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
 617             }
 618
 619             if ( $c->match_type ) {
 620                 $def .= ' MATCH ' .
 621                     ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 622             }
 623
 624             if ( $c->on_delete ) {
 625                 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 626             }
 627
 628             if ( $c->on_update ) {
 629                 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 630             }
 631
 632             if ( $c->deferrable ) {
 633                 $def .= ' DEFERRABLE';
 634             }
 635
 636             push @fks, "$def;";
 637         }
 638
 639         return \@constraint_defs, \@fks;
 640     }
 641
 642 sub convert_datatype
 643 {
 644     my ($field) = @_;
 645
 646     my @size      = $field->size;
 647     my $data_type = lc $field->data_type;
 648
 649     if ( $data_type eq 'enum' ) {
 650 #        my $len = 0;
 651 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
 652 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
 653 #        push @$constraint_defs,
 654 #        qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
 655 #           qq[IN ($commalist))];
 656         $data_type = 'character varying';
 657     }
 658     elsif ( $data_type eq 'set' ) {
 659         $data_type = 'character varying';
 660     }
 661     elsif ( $field->is_auto_increment ) {
 662         if ( defined $size[0] && $size[0] > 11 ) {
 663             $data_type = 'bigserial';
 664         }
 665         else {
 666             $data_type = 'serial';
 667         }
 668         undef @size;
 669     }
 670     else {
 671         $data_type  = defined $translate{ $data_type } ?
 672             $translate{ $data_type } :
 673             $data_type;
 674     }
 675
 676     if ( $data_type =~ /timestamp/i ) {
 677         if ( defined $size[0] && $size[0] > 6 ) {
 678             $size[0] = 6;
 679         }
 680     }
 681
 682     if ( $data_type eq 'integer' ) {
 683         if ( defined $size[0] && $size[0] > 0) {
 684             if ( $size[0] > 10 ) {
 685                 $data_type = 'bigint';
 686             }
 687             elsif ( $size[0] < 5 ) {
 688                 $data_type = 'smallint';
 689             }
 690             else {
 691                 $data_type = 'integer';
 692             }
 693         }
 694         else {
 695             $data_type = 'integer';
 696         }
 697     }
 698     my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
 699                                integer smallint text line lseg macaddr money
 700                                path point polygon real/;
 701     foreach (@type_without_size) {
 702         if ( $data_type =~ qr/$_/ ) {
 703             undef @size; last;
 704         }
 705     }
 706
 707     if ( defined $size[0] && $size[0] > 0 ) {
 708         $data_type .= '(' . join( ',', @size ) . ')';
 709     }
 710     elsif (defined $size[0] && $data_type eq 'timestamp' ) {
 711         $data_type .= '(' . join( ',', @size ) . ')';
 712     }
 713
 714
 715     return $data_type;
 716 }
 717
 718
 719 sub alter_field
 720 {
 721     my ($from_field, $to_field) = @_;
 722
 723     die "Can't alter field in another table"
 724         if($from_field->table->name ne $to_field->table->name);
 725
 726     my @out;
 727     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
 728                        $to_field->table->name,
 729                        $to_field->name) if(!$to_field->is_nullable and
 730                                            $from_field->is_nullable);
 731
 732     my $from_dt = convert_datatype($from_field);
 733     my $to_dt   = convert_datatype($to_field);
 734     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
 735                        $to_field->table->name,
 736                        $to_field->name,
 737                        $to_dt) if($to_dt ne $from_dt);
 738
 739     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
 740                        $to_field->table->name,
 741                        $from_field->name,
 742                        $to_field->name) if($from_field->name ne $to_field->name);
 743
 744     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
 745                        $to_field->table->name,
 746                        $to_field->name,
 747                        $to_field->default_value)
 748         if(defined $to_field->default_value &&
 749            $from_field->default_value ne $to_field->default_value);
 750
 751     return wantarray ? @out : join("\n", @out);
 752
 753 }
 754
 755 sub add_field
 756 {
 757     my ($new_field) = @_;
 758
 759     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
 760                       $new_field->table->name,
 761                       create_field($new_field));
 762     return $out;
 763
 764 }
 765
 766 sub drop_field
 767 {
 768     my ($old_field) = @_;
 769
 770     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
 771                       $old_field->table->name,
 772                       $old_field->name);
 773
 774     return $out;
 775 }
 776
 777 1;
 778
 779 # -------------------------------------------------------------------
 780 # Life is full of misery, loneliness, and suffering --
 781 # and it's all over much too soon.
 782 # Woody Allen
 783 # -------------------------------------------------------------------
 784
 785 =pod
 786
 787 =head1 SEE ALSO
 788
 789 SQL::Translator, SQL::Translator::Producer::Oracle.
 790
 791 =head1 AUTHOR
 792
 793 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 794
 795 =cut