lib/SQL/Translator/Producer/PostgreSQL.pm

   1 package SQL::Translator::Producer::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm 1440 2009-01-17 16:31:57Z jawnsy $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-2009 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 %used_names ];
  42 $DEBUG = 0 unless defined $DEBUG;
  43
  44 use base qw(SQL::Translator::Producer);
  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) . ";\n\n";
 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 ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
 333     my $table_name_ur = $qt ? $table_name
 334         : $fql_tbl_name ? join('.', $table_name, unreserve($fql_tbl_name))
 335         : unreserve($table_name);
 336     $table->name($table_name_ur);
 337
 338 # print STDERR "$table_name table_name\n";
 339     my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
 340
 341     push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
 342
 343     if ( $table->comments and !$no_comments ){
 344         my $c = "-- Comments: \n-- ";
 345         $c .= join "\n-- ",  $table->comments;
 346         $c .= "\n--\n";
 347         push @comments, $c;
 348     }
 349
 350     #
 351     # Fields
 352     #
 353     my %field_name_scope;
 354     for my $field ( $table->get_fields ) {
 355         push @field_defs, create_field($field, { quote_table_names => $qt,
 356                                                  quote_field_names => $qf,
 357                                                  table_name => $table_name_ur,
 358                                                  postgres_version => $postgres_version,
 359                                                  type_defs => \@type_defs,
 360                                                  type_drops => \@type_drops,
 361                                                  constraint_defs => \@constraint_defs,});
 362     }
 363
 364     #
 365     # Index Declarations
 366     #
 367     my @index_defs = ();
 368  #   my $idx_name_default;
 369     for my $index ( $table->get_indices ) {
 370         my ($idef, $constraints) = create_index($index,
 371                                               {
 372                                                   quote_field_names => $qf,
 373                                                   quote_table_names => $qt,
 374                                                   table_name => $table_name,
 375                                               });
 376         $idef and push @index_defs, $idef;
 377         push @constraint_defs, @$constraints;
 378     }
 379
 380     #
 381     # Table constraints
 382     #
 383     my $c_name_default;
 384     for my $c ( $table->get_constraints ) {
 385         my ($cdefs, $fks) = create_constraint($c,
 386                                               {
 387                                                   quote_field_names => $qf,
 388                                                   quote_table_names => $qt,
 389                                                   table_name => $table_name,
 390                                               });
 391         push @constraint_defs, @$cdefs;
 392         push @fks, @$fks;
 393     }
 394
 395
 396     my $temporary = "";
 397
 398     if(exists $table->{extra}{temporary}) {
 399         $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
 400     }
 401
 402     my $create_statement;
 403     $create_statement = join("\n", @comments);
 404     if ($add_drop_table) {
 405         if ($postgres_version >= 8.2) {
 406             $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
 407             $create_statement .= join ("\n", @type_drops) . "\n"
 408                 if $postgres_version >= 8.3;
 409         } else {
 410             $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
 411         }
 412     }
 413     $create_statement .= join("\n", @type_defs) . "\n"
 414         if $postgres_version >= 8.3;
 415     $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
 416                             join( ",\n", map { "  $_" } @field_defs, @constraint_defs ).
 417                             "\n)"
 418                             ;
 419     $create_statement .= @index_defs ? ';' : q{};
 420     $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
 421         . join(";\n", @index_defs);
 422
 423     return $create_statement, \@fks;
 424 }
 425
 426 sub create_view {
 427     my ($view, $options) = @_;
 428     my $qt = $options->{quote_table_names} || '';
 429     my $qf = $options->{quote_field_names} || '';
 430     my $add_drop_view = $options->{add_drop_view};
 431
 432     my $view_name = $view->name;
 433     debug("PKG: Looking at view '${view_name}'\n");
 434
 435     my $create = '';
 436     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
 437         unless $options->{no_comments};
 438     $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
 439     $create .= 'CREATE';
 440
 441     my $extra = $view->extra;
 442     $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
 443     $create .= " VIEW ${qt}${view_name}${qt}";
 444
 445     if ( my @fields = $view->fields ) {
 446         my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
 447         $create .= " ( ${field_list} )";
 448     }
 449
 450     if ( my $sql = $view->sql ) {
 451         $create .= " AS (\n    ${sql}\n  )";
 452     }
 453
 454     if ( $extra->{check_option} ) {
 455         $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
 456     }
 457
 458     return $create;
 459 }
 460
 461 {
 462
 463     my %field_name_scope;
 464
 465     sub create_field
 466     {
 467         my ($field, $options) = @_;
 468
 469         my $qt = $options->{quote_table_names} || '';
 470         my $qf = $options->{quote_field_names} || '';
 471         my $table_name = $field->table->name;
 472         my $constraint_defs = $options->{constraint_defs} || [];
 473         my $postgres_version = $options->{postgres_version} || 0;
 474         my $type_defs = $options->{type_defs} || [];
 475         my $type_drops = $options->{type_drops} || [];
 476
 477         $field_name_scope{$table_name} ||= {};
 478         my $field_name    = mk_name(
 479                                     $field->name, '', $field_name_scope{$table_name}, 1
 480                                     );
 481         my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
 482         $field->name($field_name_ur);
 483         my $field_comments = $field->comments
 484             ? "-- " . $field->comments . "\n  "
 485             : '';
 486
 487         my $field_def     = $field_comments.qq[$qf$field_name_ur$qf];
 488
 489         #
 490         # Datatype
 491         #
 492         my @size      = $field->size;
 493         my $data_type = lc $field->data_type;
 494         my %extra     = $field->extra;
 495         my $list      = $extra{'list'} || [];
 496         # todo deal with embedded quotes
 497         my $commalist = join( ', ', map { qq['$_'] } @$list );
 498
 499         if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
 500             my $type_name = $field->table->name . '_' . $field->name . '_type';
 501             $field_def .= ' '. $type_name;
 502             push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
 503             push @$type_drops, "DROP TYPE IF EXISTS $type_name";
 504         } else {
 505             $field_def .= ' '. convert_datatype($field);
 506         }
 507
 508         #
 509         # Default value
 510         #
 511         my $default = $field->default_value;
 512         if ( defined $default ) {
 513             SQL::Translator::Producer->_apply_default_value(
 514               \$field_def,
 515               $default,
 516               [
 517                 'NULL'              => \'NULL',
 518                 'now()'             => 'now()',
 519                 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
 520               ],
 521             );
 522         }
 523
 524         #
 525         # Not null constraint
 526         #
 527         $field_def .= ' NOT NULL' unless $field->is_nullable;
 528
 529         return $field_def;
 530     }
 531 }
 532
 533     sub create_index
 534     {
 535         my ($index, $options) = @_;
 536
 537         my $qt = $options->{quote_table_names} ||'';
 538         my $qf = $options->{quote_field_names} ||'';
 539         my $table_name = $index->table->name;
 540 #        my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
 541
 542         my ($index_def, @constraint_defs);
 543
 544         my $name = $index->name || '';
 545         if ( $name ) {
 546             $name = next_unused_name($name);
 547         }
 548
 549         my $type = $index->type || NORMAL;
 550         my @fields     =
 551             map { $_ =~ s/\(.+\)//; $_ }
 552         map { $qt ? $_ : unreserve($_, $table_name ) }
 553         $index->fields;
 554         next unless @fields;
 555
 556         my $def_start = qq[CONSTRAINT "$name" ];
 557         if ( $type eq PRIMARY_KEY ) {
 558             push @constraint_defs, "${def_start}PRIMARY KEY ".
 559                 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
 560         }
 561         elsif ( $type eq UNIQUE ) {
 562             push @constraint_defs, "${def_start}UNIQUE " .
 563                 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
 564         }
 565         elsif ( $type eq NORMAL ) {
 566             $index_def =
 567                 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
 568                 join( ', ', map { qq[$qf$_$qf] } @fields ).
 569                 ')'
 570                 ;
 571         }
 572         else {
 573             warn "Unknown index type ($type) on table $table_name.\n"
 574                 if $WARN;
 575         }
 576
 577         return $index_def, \@constraint_defs;
 578     }
 579
 580     sub create_constraint
 581     {
 582         my ($c, $options) = @_;
 583
 584         my $qf = $options->{quote_field_names} ||'';
 585         my $qt = $options->{quote_table_names} ||'';
 586         my $table_name = $c->table->name;
 587         my (@constraint_defs, @fks);
 588
 589         my $name = $c->name || '';
 590         if ( $name ) {
 591             $name = next_unused_name($name);
 592         }
 593
 594         my @fields     =
 595             map { $_ =~ s/\(.+\)//; $_ }
 596         map { $qt ? $_ : unreserve( $_, $table_name )}
 597         $c->fields;
 598
 599         my @rfields     =
 600             map { $_ =~ s/\(.+\)//; $_ }
 601         map { $qt ? $_ : unreserve( $_, $table_name )}
 602         $c->reference_fields;
 603
 604         next if !@fields && $c->type ne CHECK_C;
 605         my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
 606         if ( $c->type eq PRIMARY_KEY ) {
 607             push @constraint_defs, "${def_start}PRIMARY KEY ".
 608                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 609         }
 610         elsif ( $c->type eq UNIQUE ) {
 611             $name = next_unused_name($name);
 612             push @constraint_defs, "${def_start}UNIQUE " .
 613                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 614         }
 615         elsif ( $c->type eq CHECK_C ) {
 616             my $expression = $c->expression;
 617             push @constraint_defs, "${def_start}CHECK ($expression)";
 618         }
 619         elsif ( $c->type eq FOREIGN_KEY ) {
 620             my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
 621                 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
 622                 "\n  REFERENCES " . $qt . $c->reference_table . $qt;
 623
 624             if ( @rfields ) {
 625                 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
 626             }
 627
 628             if ( $c->match_type ) {
 629                 $def .= ' MATCH ' .
 630                     ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 631             }
 632
 633             if ( $c->on_delete ) {
 634                 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 635             }
 636
 637             if ( $c->on_update ) {
 638                 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 639             }
 640
 641             if ( $c->deferrable ) {
 642                 $def .= ' DEFERRABLE';
 643             }
 644
 645             push @fks, "$def";
 646         }
 647
 648         return \@constraint_defs, \@fks;
 649     }
 650
 651 sub convert_datatype
 652 {
 653     my ($field) = @_;
 654
 655     my @size      = $field->size;
 656     my $data_type = lc $field->data_type;
 657
 658     if ( $data_type eq 'enum' ) {
 659 #        my $len = 0;
 660 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
 661 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
 662 #        push @$constraint_defs,
 663 #        qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
 664 #           qq[IN ($commalist))];
 665         $data_type = 'character varying';
 666     }
 667     elsif ( $data_type eq 'set' ) {
 668         $data_type = 'character varying';
 669     }
 670     elsif ( $field->is_auto_increment ) {
 671         if ( defined $size[0] && $size[0] > 11 ) {
 672             $data_type = 'bigserial';
 673         }
 674         else {
 675             $data_type = 'serial';
 676         }
 677         undef @size;
 678     }
 679     else {
 680         $data_type  = defined $translate{ $data_type } ?
 681             $translate{ $data_type } :
 682             $data_type;
 683     }
 684
 685     if ( $data_type =~ /timestamp/i ) {
 686         if ( defined $size[0] && $size[0] > 6 ) {
 687             $size[0] = 6;
 688         }
 689     }
 690
 691     if ( $data_type eq 'integer' ) {
 692         if ( defined $size[0] && $size[0] > 0) {
 693             if ( $size[0] > 10 ) {
 694                 $data_type = 'bigint';
 695             }
 696             elsif ( $size[0] < 5 ) {
 697                 $data_type = 'smallint';
 698             }
 699             else {
 700                 $data_type = 'integer';
 701             }
 702         }
 703         else {
 704             $data_type = 'integer';
 705         }
 706     }
 707     my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
 708                                integer smallint text line lseg macaddr money
 709                                path point polygon real/;
 710     foreach (@type_without_size) {
 711         if ( $data_type =~ qr/$_/ ) {
 712             undef @size; last;
 713         }
 714     }
 715
 716     if ( defined $size[0] && $size[0] > 0 ) {
 717         $data_type .= '(' . join( ',', @size ) . ')';
 718     }
 719     elsif (defined $size[0] && $data_type eq 'timestamp' ) {
 720         $data_type .= '(' . join( ',', @size ) . ')';
 721     }
 722
 723
 724     return $data_type;
 725 }
 726
 727
 728 sub alter_field
 729 {
 730     my ($from_field, $to_field) = @_;
 731
 732     die "Can't alter field in another table"
 733         if($from_field->table->name ne $to_field->table->name);
 734
 735     my @out;
 736     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
 737                        $to_field->table->name,
 738                        $to_field->name) if(!$to_field->is_nullable and
 739                                            $from_field->is_nullable);
 740
 741     my $from_dt = convert_datatype($from_field);
 742     my $to_dt   = convert_datatype($to_field);
 743     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
 744                        $to_field->table->name,
 745                        $to_field->name,
 746                        $to_dt) if($to_dt ne $from_dt);
 747
 748     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
 749                        $to_field->table->name,
 750                        $from_field->name,
 751                        $to_field->name) if($from_field->name ne $to_field->name);
 752
 753     my $old_default = $from_field->default_value;
 754     my $new_default = $to_field->default_value;
 755     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
 756                        $to_field->table->name,
 757                        $to_field->name,
 758                        $to_field->default_value)
 759         if ( defined $new_default &&
 760              (!defined $old_default || $old_default ne $new_default) );
 761
 762     return wantarray ? @out : join("\n", @out);
 763 }
 764
 765 sub rename_field { alter_field(@_) }
 766
 767 sub add_field
 768 {
 769     my ($new_field) = @_;
 770
 771     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 772                       $new_field->table->name,
 773                       create_field($new_field));
 774     return $out;
 775
 776 }
 777
 778 sub drop_field
 779 {
 780     my ($old_field) = @_;
 781
 782     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 783                       $old_field->table->name,
 784                       $old_field->name);
 785
 786     return $out;
 787 }
 788
 789 sub alter_table {
 790     my ($to_table, $options) = @_;
 791     my $qt = $options->{quote_table_names} || '';
 792     my $out = sprintf('ALTER TABLE %s %s',
 793                       $qt . $to_table->name . $qt,
 794                       $options->{alter_table_action});
 795     return $out;
 796 }
 797
 798 sub rename_table {
 799     my ($old_table, $new_table, $options) = @_;
 800     my $qt = $options->{quote_table_names} || '';
 801     $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
 802     return alter_table($old_table, $options);
 803 }
 804
 805 sub alter_create_index {
 806     my ($index, $options) = @_;
 807     my $qt = $options->{quote_table_names} || '';
 808     my $qf = $options->{quote_field_names} || '';
 809     my ($idef, $constraints) = create_index($index, {
 810         quote_field_names => $qf,
 811         quote_table_names => $qt,
 812         table_name => $index->table->name,
 813     });
 814     return $index->type eq NORMAL ? $idef
 815         : sprintf('ALTER TABLE %s ADD %s',
 816               $qt . $index->table->name . $qt,
 817               join(q{}, @$constraints)
 818           );
 819 }
 820
 821 sub alter_drop_index {
 822     my ($index, $options) = @_;
 823     my $index_name = $index->name;
 824     return "DROP INDEX $index_name";
 825 }
 826
 827 sub alter_drop_constraint {
 828     my ($c, $options) = @_;
 829     my $qt = $options->{quote_table_names} || '';
 830     my $qc = $options->{quote_field_names} || '';
 831     my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
 832                       $qt . $c->table->name . $qt,
 833                       $qc . $c->name . $qc );
 834     return $out;
 835 }
 836
 837 sub alter_create_constraint {
 838     my ($index, $options) = @_;
 839     my $qt = $options->{quote_table_names} || '';
 840     return $index->type eq FOREIGN_KEY ? join(q{}, @{create_constraint(@_)})
 841         : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
 842               'ADD', join(q{}, map { @{$_} } create_constraint(@_))
 843           );
 844 }
 845
 846 sub drop_table {
 847     my ($table, $options) = @_;
 848     my $qt = $options->{quote_table_names} || '';
 849     return "DROP TABLE $qt$table$qt CASCADE";
 850 }
 851
 852 1;
 853
 854 # -------------------------------------------------------------------
 855 # Life is full of misery, loneliness, and suffering --
 856 # and it's all over much too soon.
 857 # Woody Allen
 858 # -------------------------------------------------------------------
 859
 860 =pod
 861
 862 =head1 SEE ALSO
 863
 864 SQL::Translator, SQL::Translator::Producer::Oracle.
 865
 866 =head1 AUTHOR
 867
 868 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 869
 870 =cut