lib/SQL/Translator/Producer/PostgreSQL.pm

   1 package SQL::Translator::Producer::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # Copyright (C) 2002-2009 SQLFairy Authors
   5 #
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License as
   8 # published by the Free Software Foundation; version 2.
   9 #
  10 # This program is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  18 # 02111-1307  USA
  19 # -------------------------------------------------------------------
  20
  21 =head1 NAME
  22
  23 SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator
  24
  25 =head1 SYNOPSIS
  26
  27   my $t = SQL::Translator->new( parser => '...', producer => 'PostgreSQL' );
  28   $t->translate;
  29
  30 =head1 DESCRIPTION
  31
  32 Creates a DDL suitable for PostgreSQL.  Very heavily based on the Oracle
  33 producer.
  34
  35 =cut
  36
  37 use strict;
  38 use warnings;
  39 use vars qw[ $DEBUG $WARN $VERSION %used_names ];
  40 $VERSION = '1.59';
  41 $DEBUG = 0 unless defined $DEBUG;
  42
  43 use base qw(SQL::Translator::Producer);
  44 use SQL::Translator::Schema::Constants;
  45 use SQL::Translator::Utils qw(debug header_comment);
  46 use Data::Dumper;
  47
  48 my %translate;
  49 my $max_id_length;
  50
  51 BEGIN {
  52
  53  %translate  = (
  54     #
  55     # MySQL types
  56     #
  57     bigint     => 'bigint',
  58     double     => 'numeric',
  59     decimal    => 'numeric',
  60     float      => 'numeric',
  61     int        => 'integer',
  62     mediumint  => 'integer',
  63     smallint   => 'smallint',
  64     tinyint    => 'smallint',
  65     char       => 'character',
  66     varchar    => 'character varying',
  67     longtext   => 'text',
  68     mediumtext => 'text',
  69     text       => 'text',
  70     tinytext   => 'text',
  71     tinyblob   => 'bytea',
  72     blob       => 'bytea',
  73     mediumblob => 'bytea',
  74     longblob   => 'bytea',
  75     enum       => 'character varying',
  76     set        => 'character varying',
  77     date       => 'date',
  78     datetime   => 'timestamp',
  79     time       => 'time',
  80     timestamp  => 'timestamp',
  81     year       => 'date',
  82
  83     #
  84     # Oracle types
  85     #
  86     number     => 'integer',
  87     char       => 'character',
  88     varchar2   => 'character varying',
  89     long       => 'text',
  90     CLOB       => 'bytea',
  91     date       => 'date',
  92
  93     #
  94     # Sybase types
  95     #
  96     int        => 'integer',
  97     money      => 'money',
  98     varchar    => 'character varying',
  99     datetime   => 'timestamp',
 100     text       => 'text',
 101     real       => 'numeric',
 102     comment    => 'text',
 103     bit        => 'bit',
 104     tinyint    => 'smallint',
 105     float      => 'numeric',
 106 );
 107
 108  $max_id_length = 62;
 109 }
 110 my %reserved = map { $_, 1 } qw[
 111     ALL ANALYSE ANALYZE AND ANY AS ASC
 112     BETWEEN BINARY BOTH
 113     CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
 114     CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
 115     DEFAULT DEFERRABLE DESC DISTINCT DO
 116     ELSE END EXCEPT
 117     FALSE FOR FOREIGN FREEZE FROM FULL
 118     GROUP HAVING
 119     ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
 120     JOIN LEADING LEFT LIKE LIMIT
 121     NATURAL NEW NOT NOTNULL NULL
 122     OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
 123     PRIMARY PUBLIC REFERENCES RIGHT
 124     SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
 125     UNION UNIQUE USER USING VERBOSE WHEN WHERE
 126 ];
 127
 128 # my $max_id_length    = 62;
 129 my %used_identifiers = ();
 130 my %global_names;
 131 my %unreserve;
 132 my %truncated;
 133
 134 =pod
 135
 136 =head1 PostgreSQL Create Table Syntax
 137
 138   CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
 139       { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
 140       | table_constraint }  [, ... ]
 141   )
 142   [ INHERITS ( parent_table [, ... ] ) ]
 143   [ WITH OIDS | WITHOUT OIDS ]
 144
 145 where column_constraint is:
 146
 147   [ CONSTRAINT constraint_name ]
 148   { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
 149     CHECK (expression) |
 150     REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
 151       [ ON DELETE action ] [ ON UPDATE action ] }
 152   [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
 153
 154 and table_constraint is:
 155
 156   [ CONSTRAINT constraint_name ]
 157   { UNIQUE ( column_name [, ... ] ) |
 158     PRIMARY KEY ( column_name [, ... ] ) |
 159     CHECK ( expression ) |
 160     FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
 161       [ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
 162   [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
 163
 164 =head1 Create Index Syntax
 165
 166   CREATE [ UNIQUE ] INDEX index_name ON table
 167       [ USING acc_method ] ( column [ ops_name ] [, ...] )
 168       [ WHERE predicate ]
 169   CREATE [ UNIQUE ] INDEX index_name ON table
 170       [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
 171       [ WHERE predicate ]
 172
 173 =cut
 174
 175 # -------------------------------------------------------------------
 176 sub produce {
 177     my $translator     = shift;
 178     local $DEBUG             = $translator->debug;
 179     local $WARN              = $translator->show_warnings;
 180     my $no_comments    = $translator->no_comments;
 181     my $add_drop_table = $translator->add_drop_table;
 182     my $schema         = $translator->schema;
 183     my $pargs          = $translator->producer_args;
 184     local %used_names  = ();
 185
 186     my $postgres_version = $pargs->{postgres_version} || 0;
 187
 188     my $qt = '';
 189     $qt = '"' if ($translator->quote_table_names);
 190     my $qf = '';
 191     $qf = '"' if ($translator->quote_field_names);
 192
 193     my @output;
 194     push @output, header_comment unless ($no_comments);
 195
 196     my (@table_defs, @fks);
 197     for my $table ( $schema->get_tables ) {
 198
 199         my ($table_def, $fks) = create_table($table,
 200                                              { quote_table_names => $qt,
 201                                                quote_field_names => $qf,
 202                                                no_comments => $no_comments,
 203                                                postgres_version => $postgres_version,
 204                                                add_drop_table => $add_drop_table,});
 205         push @table_defs, $table_def;
 206         push @fks, @$fks;
 207
 208     }
 209
 210     for my $view ( $schema->get_views ) {
 211       push @table_defs, create_view($view, {
 212         add_drop_view     => $add_drop_table,
 213         quote_table_names => $qt,
 214         quote_field_names => $qf,
 215         no_comments       => $no_comments,
 216       });
 217     }
 218
 219     push @output, map { "$_;\n\n" } @table_defs;
 220     if ( @fks ) {
 221         push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
 222         push @output, map { "$_;\n\n" } @fks;
 223     }
 224
 225     if ( $WARN ) {
 226         if ( %truncated ) {
 227             warn "Truncated " . keys( %truncated ) . " names:\n";
 228             warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
 229         }
 230
 231         if ( %unreserve ) {
 232             warn "Encounted " . keys( %unreserve ) .
 233                 " unsafe names in schema (reserved or invalid):\n";
 234             warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
 235         }
 236     }
 237
 238     return wantarray
 239         ? @output
 240         : join ('', @output);
 241 }
 242
 243 # -------------------------------------------------------------------
 244 sub mk_name {
 245     my $basename      = shift || '';
 246     my $type          = shift || '';
 247     my $scope         = shift || '';
 248     my $critical      = shift || '';
 249     my $basename_orig = $basename;
 250 #    my $max_id_length = 62;
 251     my $max_name      = $type
 252                         ? $max_id_length - (length($type) + 1)
 253                         : $max_id_length;
 254     $basename         = substr( $basename, 0, $max_name )
 255                         if length( $basename ) > $max_name;
 256     my $name          = $type ? "${type}_$basename" : $basename;
 257
 258     if ( $basename ne $basename_orig and $critical ) {
 259         my $show_type = $type ? "+'$type'" : "";
 260         warn "Truncating '$basename_orig'$show_type to $max_id_length ",
 261             "character limit to make '$name'\n" if $WARN;
 262         $truncated{ $basename_orig } = $name;
 263     }
 264
 265     $scope ||= \%global_names;
 266     if ( my $prev = $scope->{ $name } ) {
 267         my $name_orig = $name;
 268         $name        .= sprintf( "%02d", ++$prev );
 269         substr($name, $max_id_length - 3) = "00"
 270             if length( $name ) > $max_id_length;
 271
 272         warn "The name '$name_orig' has been changed to ",
 273              "'$name' to make it unique.\n" if $WARN;
 274
 275         $scope->{ $name_orig }++;
 276     }
 277
 278     $scope->{ $name }++;
 279     return $name;
 280 }
 281
 282 # -------------------------------------------------------------------
 283 sub unreserve {
 284     my $name            = shift || '';
 285     my $schema_obj_name = shift || '';
 286
 287     my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
 288
 289     # also trap fields that don't begin with a letter
 290     return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
 291
 292     if ( $schema_obj_name ) {
 293         ++$unreserve{"$schema_obj_name.$name"};
 294     }
 295     else {
 296         ++$unreserve{"$name (table name)"};
 297     }
 298
 299     my $unreserve = sprintf '%s_', $name;
 300     return $unreserve.$suffix;
 301 }
 302
 303 # -------------------------------------------------------------------
 304 sub next_unused_name {
 305     my $name = shift || '';
 306     if ( !defined( $used_names{$name} ) ) {
 307         $used_names{$name} = $name;
 308         return $name;
 309     }
 310
 311     my $i = 2;
 312     while ( defined( $used_names{ $name . $i } ) ) {
 313         ++$i;
 314     }
 315     $name .= $i;
 316     $used_names{$name} = $name;
 317     return $name;
 318 }
 319
 320
 321 sub create_table
 322 {
 323     my ($table, $options) = @_;
 324
 325     my $qt = $options->{quote_table_names} || '';
 326     my $qf = $options->{quote_field_names} || '';
 327     my $no_comments = $options->{no_comments} || 0;
 328     my $add_drop_table = $options->{add_drop_table} || 0;
 329     my $postgres_version = $options->{postgres_version} || 0;
 330
 331     my $table_name = $table->name or next;
 332     $table_name    = mk_name( $table_name, '', undef, 1 );
 333     my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
 334     my $table_name_ur = $qt ? $table_name
 335         : $fql_tbl_name ? join('.', $table_name, unreserve($fql_tbl_name))
 336         : unreserve($table_name);
 337     $table->name($table_name_ur);
 338
 339 # print STDERR "$table_name table_name\n";
 340     my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
 341
 342     push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
 343
 344     if ( $table->comments and !$no_comments ){
 345         my $c = "-- Comments: \n-- ";
 346         $c .= join "\n-- ",  $table->comments;
 347         $c .= "\n--\n";
 348         push @comments, $c;
 349     }
 350
 351     #
 352     # Fields
 353     #
 354     my %field_name_scope;
 355     for my $field ( $table->get_fields ) {
 356         push @field_defs, create_field($field, { quote_table_names => $qt,
 357                                                  quote_field_names => $qf,
 358                                                  table_name => $table_name_ur,
 359                                                  postgres_version => $postgres_version,
 360                                                  type_defs => \@type_defs,
 361                                                  type_drops => \@type_drops,
 362                                                  constraint_defs => \@constraint_defs,});
 363     }
 364
 365     #
 366     # Index Declarations
 367     #
 368     my @index_defs = ();
 369  #   my $idx_name_default;
 370     for my $index ( $table->get_indices ) {
 371         my ($idef, $constraints) = create_index($index,
 372                                               {
 373                                                   quote_field_names => $qf,
 374                                                   quote_table_names => $qt,
 375                                                   table_name => $table_name,
 376                                               });
 377         $idef and push @index_defs, $idef;
 378         push @constraint_defs, @$constraints;
 379     }
 380
 381     #
 382     # Table constraints
 383     #
 384     my $c_name_default;
 385     for my $c ( $table->get_constraints ) {
 386         my ($cdefs, $fks) = create_constraint($c,
 387                                               {
 388                                                   quote_field_names => $qf,
 389                                                   quote_table_names => $qt,
 390                                                   table_name => $table_name,
 391                                               });
 392         push @constraint_defs, @$cdefs;
 393         push @fks, @$fks;
 394     }
 395
 396
 397     my $temporary = "";
 398
 399     if(exists $table->{extra}{temporary}) {
 400         $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
 401     }
 402
 403     my $create_statement;
 404     $create_statement = join("\n", @comments);
 405     if ($add_drop_table) {
 406         if ($postgres_version >= 8.2) {
 407             $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
 408             $create_statement .= join (";\n", @type_drops) . ";\n"
 409                 if $postgres_version >= 8.3 && scalar @type_drops;
 410         } else {
 411             $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
 412         }
 413     }
 414     $create_statement .= join(";\n", @type_defs) . ";\n"
 415         if $postgres_version >= 8.3 && scalar @type_defs;
 416     $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
 417                             join( ",\n", map { "  $_" } @field_defs, @constraint_defs ).
 418                             "\n)"
 419                             ;
 420     $create_statement .= @index_defs ? ';' : q{};
 421     $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
 422         . join(";\n", @index_defs);
 423
 424     return $create_statement, \@fks;
 425 }
 426
 427 sub create_view {
 428     my ($view, $options) = @_;
 429     my $qt = $options->{quote_table_names} || '';
 430     my $qf = $options->{quote_field_names} || '';
 431     my $add_drop_view = $options->{add_drop_view};
 432
 433     my $view_name = $view->name;
 434     debug("PKG: Looking at view '${view_name}'\n");
 435
 436     my $create = '';
 437     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
 438         unless $options->{no_comments};
 439     $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
 440     $create .= 'CREATE';
 441
 442     my $extra = $view->extra;
 443     $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
 444     $create .= " VIEW ${qt}${view_name}${qt}";
 445
 446     if ( my @fields = $view->fields ) {
 447         my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
 448         $create .= " ( ${field_list} )";
 449     }
 450
 451     if ( my $sql = $view->sql ) {
 452         $create .= " AS (\n    ${sql}\n  )";
 453     }
 454
 455     if ( $extra->{check_option} ) {
 456         $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
 457     }
 458
 459     return $create;
 460 }
 461
 462 {
 463
 464     my %field_name_scope;
 465
 466     sub create_field
 467     {
 468         my ($field, $options) = @_;
 469
 470         my $qt = $options->{quote_table_names} || '';
 471         my $qf = $options->{quote_field_names} || '';
 472         my $table_name = $field->table->name;
 473         my $constraint_defs = $options->{constraint_defs} || [];
 474         my $postgres_version = $options->{postgres_version} || 0;
 475         my $type_defs = $options->{type_defs} || [];
 476         my $type_drops = $options->{type_drops} || [];
 477
 478         $field_name_scope{$table_name} ||= {};
 479         my $field_name    = mk_name(
 480                                     $field->name, '', $field_name_scope{$table_name}, 1
 481                                     );
 482         my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
 483         $field->name($field_name_ur);
 484         my $field_comments = $field->comments
 485             ? "-- " . $field->comments . "\n  "
 486             : '';
 487
 488         my $field_def     = $field_comments.qq[$qf$field_name_ur$qf];
 489
 490         #
 491         # Datatype
 492         #
 493         my @size      = $field->size;
 494         my $data_type = lc $field->data_type;
 495         my %extra     = $field->extra;
 496         my $list      = $extra{'list'} || [];
 497         # todo deal with embedded quotes
 498         my $commalist = join( ', ', map { qq['$_'] } @$list );
 499
 500         if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
 501             my $type_name = $field->table->name . '_' . $field->name . '_type';
 502             $field_def .= ' '. $type_name;
 503             push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
 504             push @$type_drops, "DROP TYPE IF EXISTS $type_name";
 505         } else {
 506             $field_def .= ' '. convert_datatype($field);
 507         }
 508
 509         #
 510         # Default value
 511         #
 512         my $default = $field->default_value;
 513         if ( defined $default ) {
 514             SQL::Translator::Producer->_apply_default_value(
 515               \$field_def,
 516               $default,
 517               [
 518                 'NULL'              => \'NULL',
 519                 'now()'             => 'now()',
 520                 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
 521               ],
 522             );
 523         }
 524
 525         #
 526         # Not null constraint
 527         #
 528         $field_def .= ' NOT NULL' unless $field->is_nullable;
 529
 530         return $field_def;
 531     }
 532 }
 533
 534     sub create_index
 535     {
 536         my ($index, $options) = @_;
 537
 538         my $qt = $options->{quote_table_names} ||'';
 539         my $qf = $options->{quote_field_names} ||'';
 540         my $table_name = $index->table->name;
 541 #        my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
 542
 543         my ($index_def, @constraint_defs);
 544
 545         my $name = $index->name || '';
 546         if ( $name ) {
 547             $name = next_unused_name($name);
 548         }
 549
 550         my $type = $index->type || NORMAL;
 551         my @fields     =
 552             map { $_ =~ s/\(.+\)//; $_ }
 553         map { $qt ? $_ : unreserve($_, $table_name ) }
 554         $index->fields;
 555         next unless @fields;
 556
 557         my $def_start = qq[CONSTRAINT "$name" ];
 558         if ( $type eq PRIMARY_KEY ) {
 559             push @constraint_defs, "${def_start}PRIMARY KEY ".
 560                 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
 561         }
 562         elsif ( $type eq UNIQUE ) {
 563             push @constraint_defs, "${def_start}UNIQUE " .
 564                 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
 565         }
 566         elsif ( $type eq NORMAL ) {
 567             $index_def =
 568                 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
 569                 join( ', ', map { qq[$qf$_$qf] } @fields ).
 570                 ')'
 571                 ;
 572         }
 573         else {
 574             warn "Unknown index type ($type) on table $table_name.\n"
 575                 if $WARN;
 576         }
 577
 578         return $index_def, \@constraint_defs;
 579     }
 580
 581     sub create_constraint
 582     {
 583         my ($c, $options) = @_;
 584
 585         my $qf = $options->{quote_field_names} ||'';
 586         my $qt = $options->{quote_table_names} ||'';
 587         my $table_name = $c->table->name;
 588         my (@constraint_defs, @fks);
 589
 590         my $name = $c->name || '';
 591         if ( $name ) {
 592             $name = next_unused_name($name);
 593         }
 594
 595         my @fields     =
 596             map { $_ =~ s/\(.+\)//; $_ }
 597         map { $qt ? $_ : unreserve( $_, $table_name )}
 598         $c->fields;
 599
 600         my @rfields     =
 601             map { $_ =~ s/\(.+\)//; $_ }
 602         map { $qt ? $_ : unreserve( $_, $table_name )}
 603         $c->reference_fields;
 604
 605         next if !@fields && $c->type ne CHECK_C;
 606         my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
 607         if ( $c->type eq PRIMARY_KEY ) {
 608             push @constraint_defs, "${def_start}PRIMARY KEY ".
 609                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 610         }
 611         elsif ( $c->type eq UNIQUE ) {
 612             $name = next_unused_name($name);
 613             push @constraint_defs, "${def_start}UNIQUE " .
 614                 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 615         }
 616         elsif ( $c->type eq CHECK_C ) {
 617             my $expression = $c->expression;
 618             push @constraint_defs, "${def_start}CHECK ($expression)";
 619         }
 620         elsif ( $c->type eq FOREIGN_KEY ) {
 621             my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
 622                 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
 623                 "\n  REFERENCES " . $qt . $c->reference_table . $qt;
 624
 625             if ( @rfields ) {
 626                 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
 627             }
 628
 629             if ( $c->match_type ) {
 630                 $def .= ' MATCH ' .
 631                     ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 632             }
 633
 634             if ( $c->on_delete ) {
 635                 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 636             }
 637
 638             if ( $c->on_update ) {
 639                 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 640             }
 641
 642             if ( $c->deferrable ) {
 643                 $def .= ' DEFERRABLE';
 644             }
 645
 646             push @fks, "$def";
 647         }
 648
 649         return \@constraint_defs, \@fks;
 650     }
 651
 652 sub convert_datatype
 653 {
 654     my ($field) = @_;
 655
 656     my @size      = $field->size;
 657     my $data_type = lc $field->data_type;
 658
 659     if ( $data_type eq 'enum' ) {
 660 #        my $len = 0;
 661 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
 662 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
 663 #        push @$constraint_defs,
 664 #        qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
 665 #           qq[IN ($commalist))];
 666         $data_type = 'character varying';
 667     }
 668     elsif ( $data_type eq 'set' ) {
 669         $data_type = 'character varying';
 670     }
 671     elsif ( $field->is_auto_increment ) {
 672         if ( defined $size[0] && $size[0] > 11 ) {
 673             $data_type = 'bigserial';
 674         }
 675         else {
 676             $data_type = 'serial';
 677         }
 678         undef @size;
 679     }
 680     else {
 681         $data_type  = defined $translate{ $data_type } ?
 682             $translate{ $data_type } :
 683             $data_type;
 684     }
 685
 686     if ( $data_type =~ /timestamp/i ) {
 687         if ( defined $size[0] && $size[0] > 6 ) {
 688             $size[0] = 6;
 689         }
 690     }
 691
 692     if ( $data_type eq 'integer' ) {
 693         if ( defined $size[0] && $size[0] > 0) {
 694             if ( $size[0] > 10 ) {
 695                 $data_type = 'bigint';
 696             }
 697             elsif ( $size[0] < 5 ) {
 698                 $data_type = 'smallint';
 699             }
 700             else {
 701                 $data_type = 'integer';
 702             }
 703         }
 704         else {
 705             $data_type = 'integer';
 706         }
 707     }
 708     my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
 709                                integer smallint text line lseg macaddr money
 710                                path point polygon real/;
 711     foreach (@type_without_size) {
 712         if ( $data_type =~ qr/$_/ ) {
 713             undef @size; last;
 714         }
 715     }
 716
 717     if ( defined $size[0] && $size[0] > 0 ) {
 718         $data_type .= '(' . join( ',', @size ) . ')';
 719     }
 720     elsif (defined $size[0] && $data_type eq 'timestamp' ) {
 721         $data_type .= '(' . join( ',', @size ) . ')';
 722     }
 723
 724
 725     return $data_type;
 726 }
 727
 728
 729 sub alter_field
 730 {
 731     my ($from_field, $to_field) = @_;
 732
 733     die "Can't alter field in another table"
 734         if($from_field->table->name ne $to_field->table->name);
 735
 736     my @out;
 737     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
 738                        $to_field->table->name,
 739                        $to_field->name) if(!$to_field->is_nullable and
 740                                            $from_field->is_nullable);
 741
 742     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
 743                       $to_field->table->name,
 744                       $to_field->name)
 745        if ( !$from_field->is_nullable and $to_field->is_nullable );
 746
 747
 748     my $from_dt = convert_datatype($from_field);
 749     my $to_dt   = convert_datatype($to_field);
 750     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
 751                        $to_field->table->name,
 752                        $to_field->name,
 753                        $to_dt) if($to_dt ne $from_dt);
 754
 755     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
 756                        $to_field->table->name,
 757                        $from_field->name,
 758                        $to_field->name) if($from_field->name ne $to_field->name);
 759
 760     my $old_default = $from_field->default_value;
 761     my $new_default = $to_field->default_value;
 762     my $default_value = $to_field->default_value;
 763
 764     # fixes bug where output like this was created:
 765     # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
 766     if(ref $default_value eq "SCALAR" ) {
 767         $default_value = $$default_value;
 768     } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
 769         $default_value =~ s/'/''/xsmg;
 770         $default_value = q(') . $default_value . q(');
 771     }
 772
 773     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
 774                        $to_field->table->name,
 775                        $to_field->name,
 776                        $default_value)
 777         if ( defined $new_default &&
 778              (!defined $old_default || $old_default ne $new_default) );
 779
 780      # fixes bug where removing the DEFAULT statement of a column
 781      # would result in no change
 782
 783      push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
 784                        $to_field->table->name,
 785                        $to_field->name)
 786         if ( !defined $new_default && defined $old_default );
 787
 788
 789     return wantarray ? @out : join("\n", @out);
 790 }
 791
 792 sub rename_field { alter_field(@_) }
 793
 794 sub add_field
 795 {
 796     my ($new_field) = @_;
 797
 798     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 799                       $new_field->table->name,
 800                       create_field($new_field));
 801     return $out;
 802
 803 }
 804
 805 sub drop_field
 806 {
 807     my ($old_field) = @_;
 808
 809     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 810                       $old_field->table->name,
 811                       $old_field->name);
 812
 813     return $out;
 814 }
 815
 816 sub alter_table {
 817     my ($to_table, $options) = @_;
 818     my $qt = $options->{quote_table_names} || '';
 819     my $out = sprintf('ALTER TABLE %s %s',
 820                       $qt . $to_table->name . $qt,
 821                       $options->{alter_table_action});
 822     return $out;
 823 }
 824
 825 sub rename_table {
 826     my ($old_table, $new_table, $options) = @_;
 827     my $qt = $options->{quote_table_names} || '';
 828     $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
 829     return alter_table($old_table, $options);
 830 }
 831
 832 sub alter_create_index {
 833     my ($index, $options) = @_;
 834     my $qt = $options->{quote_table_names} || '';
 835     my $qf = $options->{quote_field_names} || '';
 836     my ($idef, $constraints) = create_index($index, {
 837         quote_field_names => $qf,
 838         quote_table_names => $qt,
 839         table_name => $index->table->name,
 840     });
 841     return $index->type eq NORMAL ? $idef
 842         : sprintf('ALTER TABLE %s ADD %s',
 843               $qt . $index->table->name . $qt,
 844               join(q{}, @$constraints)
 845           );
 846 }
 847
 848 sub alter_drop_index {
 849     my ($index, $options) = @_;
 850     my $index_name = $index->name;
 851     return "DROP INDEX $index_name";
 852 }
 853
 854 sub alter_drop_constraint {
 855     my ($c, $options) = @_;
 856     my $qt = $options->{quote_table_names} || '';
 857     my $qc = $options->{quote_field_names} || '';
 858     my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
 859                       $qt . $c->table->name . $qt,
 860                       $qc . $c->name . $qc );
 861     return $out;
 862 }
 863
 864 sub alter_create_constraint {
 865     my ($index, $options) = @_;
 866     my $qt = $options->{quote_table_names} || '';
 867     my ($defs, $fks) = create_constraint(@_);
 868
 869     # return if there are no constraint definitions so we don't run
 870     # into output like this:
 871     # ALTER TABLE users ADD ;
 872
 873     return unless(@{$defs} || @{$fks});
 874     return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
 875         : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
 876               'ADD', join(q{}, @{$defs}, @{$fks})
 877           );
 878 }
 879
 880 sub drop_table {
 881     my ($table, $options) = @_;
 882     my $qt = $options->{quote_table_names} || '';
 883     return "DROP TABLE $qt$table$qt CASCADE";
 884 }
 885
 886 1;
 887
 888 # -------------------------------------------------------------------
 889 # Life is full of misery, loneliness, and suffering --
 890 # and it's all over much too soon.
 891 # Woody Allen
 892 # -------------------------------------------------------------------
 893
 894 =pod
 895
 896 =head1 SEE ALSO
 897
 898 SQL::Translator, SQL::Translator::Producer::Oracle.
 899
 900 =head1 AUTHOR
 901
 902 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 903
 904 =cut