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, %index_name );
  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     my $postgres_version = $pargs->{postgres_version} || 0;
 185
 186     my $qt = $translator->quote_table_names ? q{"} : q{};
 187     my $qf = $translator->quote_field_names ? q{"} : q{};
 188
 189     my @output;
 190     push @output, header_comment unless ($no_comments);
 191
 192     my (@table_defs, @fks);
 193     for my $table ( $schema->get_tables ) {
 194
 195         my ($table_def, $fks) = create_table($table, {
 196             quote_table_names => $qt,
 197             quote_field_names => $qf,
 198             no_comments       => $no_comments,
 199             postgres_version  => $postgres_version,
 200             add_drop_table    => $add_drop_table,
 201         });
 202
 203         push @table_defs, $table_def;
 204         push @fks, @$fks;
 205     }
 206
 207     for my $view ( $schema->get_views ) {
 208       push @table_defs, create_view($view, {
 209         add_drop_view     => $add_drop_table,
 210         quote_table_names => $qt,
 211         quote_field_names => $qf,
 212         no_comments       => $no_comments,
 213       });
 214     }
 215
 216     push @output, map { "$_;\n\n" } @table_defs;
 217     if ( @fks ) {
 218         push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
 219         push @output, map { "$_;\n\n" } @fks;
 220     }
 221
 222     if ( $WARN ) {
 223         if ( %truncated ) {
 224             warn "Truncated " . keys( %truncated ) . " names:\n";
 225             warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
 226         }
 227
 228         if ( %unreserve ) {
 229             warn "Encounted " . keys( %unreserve ) .
 230                 " unsafe names in schema (reserved or invalid):\n";
 231             warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
 232         }
 233     }
 234
 235     return wantarray
 236         ? @output
 237         : join ('', @output);
 238 }
 239
 240 # -------------------------------------------------------------------
 241 sub mk_name {
 242     my $basename      = shift || '';
 243     my $type          = shift || '';
 244     my $scope         = shift || '';
 245     my $critical      = shift || '';
 246     my $basename_orig = $basename;
 247 #    my $max_id_length = 62;
 248     my $max_name      = $type
 249                         ? $max_id_length - (length($type) + 1)
 250                         : $max_id_length;
 251     $basename         = substr( $basename, 0, $max_name )
 252                         if length( $basename ) > $max_name;
 253     my $name          = $type ? "${type}_$basename" : $basename;
 254
 255     if ( $basename ne $basename_orig and $critical ) {
 256         my $show_type = $type ? "+'$type'" : "";
 257         warn "Truncating '$basename_orig'$show_type to $max_id_length ",
 258             "character limit to make '$name'\n" if $WARN;
 259         $truncated{ $basename_orig } = $name;
 260     }
 261
 262     $scope ||= \%global_names;
 263     if ( my $prev = $scope->{ $name } ) {
 264         my $name_orig = $name;
 265         $name        .= sprintf( "%02d", ++$prev );
 266         substr($name, $max_id_length - 3) = "00"
 267             if length( $name ) > $max_id_length;
 268
 269         warn "The name '$name_orig' has been changed to ",
 270              "'$name' to make it unique.\n" if $WARN;
 271
 272         $scope->{ $name_orig }++;
 273     }
 274
 275     $scope->{ $name }++;
 276     return $name;
 277 }
 278
 279 # -------------------------------------------------------------------
 280 sub unreserve {
 281     my $name            = shift || '';
 282     my $schema_obj_name = shift || '';
 283
 284     my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
 285
 286     # also trap fields that don't begin with a letter
 287     return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
 288
 289     if ( $schema_obj_name ) {
 290         ++$unreserve{"$schema_obj_name.$name"};
 291     }
 292     else {
 293         ++$unreserve{"$name (table name)"};
 294     }
 295
 296     my $unreserve = sprintf '%s_', $name;
 297     return $unreserve.$suffix;
 298 }
 299
 300 # -------------------------------------------------------------------
 301 sub next_unused_name {
 302     my $orig_name = shift or return;
 303     my $name      = $orig_name;
 304
 305     my $suffix_gen = sub {
 306         my $suffix = 0;
 307         return ++$suffix ? '' : $suffix;
 308     };
 309
 310     for (;;) {
 311         $name = $orig_name . $suffix_gen->();
 312         last if $used_names{ $name }++;
 313     }
 314
 315     return $name;
 316 }
 317
 318 sub create_table
 319 {
 320     my ($table, $options) = @_;
 321
 322     my $qt = $options->{quote_table_names} || '';
 323     my $qf = $options->{quote_field_names} || '';
 324     my $no_comments = $options->{no_comments} || 0;
 325     my $add_drop_table = $options->{add_drop_table} || 0;
 326     my $postgres_version = $options->{postgres_version} || 0;
 327
 328     my $table_name = $table->name or next;
 329     my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
 330     my $table_name_ur = $qt ? $table_name
 331         : $fql_tbl_name ? join('.', $table_name, unreserve($fql_tbl_name))
 332         : 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
 393     my $temporary = "";
 394
 395     if(exists $table->{extra}{temporary}) {
 396         $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
 397     }
 398
 399     my $create_statement;
 400     $create_statement = join("\n", @comments);
 401     if ($add_drop_table) {
 402         if ($postgres_version >= 8.2) {
 403             $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
 404             $create_statement .= join (";\n", @type_drops) . ";\n"
 405                 if $postgres_version >= 8.3 && scalar @type_drops;
 406         } else {
 407             $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
 408         }
 409     }
 410     $create_statement .= join(";\n", @type_defs) . ";\n"
 411         if $postgres_version >= 8.3 && scalar @type_defs;
 412     $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
 413                             join( ",\n", map { "  $_" } @field_defs, @constraint_defs ).
 414                             "\n)"
 415                             ;
 416     $create_statement .= @index_defs ? ';' : q{};
 417     $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
 418         . join(";\n", @index_defs);
 419
 420     return $create_statement, \@fks;
 421 }
 422
 423 sub create_view {
 424     my ($view, $options) = @_;
 425     my $qt = $options->{quote_table_names} || '';
 426     my $qf = $options->{quote_field_names} || '';
 427     my $add_drop_view = $options->{add_drop_view};
 428
 429     my $view_name = $view->name;
 430     debug("PKG: Looking at view '${view_name}'\n");
 431
 432     my $create = '';
 433     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
 434         unless $options->{no_comments};
 435     $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
 436     $create .= 'CREATE';
 437
 438     my $extra = $view->extra;
 439     $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
 440     $create .= " VIEW ${qt}${view_name}${qt}";
 441
 442     if ( my @fields = $view->fields ) {
 443         my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
 444         $create .= " ( ${field_list} )";
 445     }
 446
 447     if ( my $sql = $view->sql ) {
 448         $create .= " AS\n    ${sql}\n";
 449     }
 450
 451     if ( $extra->{check_option} ) {
 452         $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
 453     }
 454
 455     return $create;
 456 }
 457
 458 {
 459
 460     my %field_name_scope;
 461
 462     sub create_field
 463     {
 464         my ($field, $options) = @_;
 465
 466         my $qt = $options->{quote_table_names} || '';
 467         my $qf = $options->{quote_field_names} || '';
 468         my $table_name = $field->table->name;
 469         my $constraint_defs = $options->{constraint_defs} || [];
 470         my $postgres_version = $options->{postgres_version} || 0;
 471         my $type_defs = $options->{type_defs} || [];
 472         my $type_drops = $options->{type_drops} || [];
 473
 474         $field_name_scope{$table_name} ||= {};
 475         my $field_name    = $field->name;
 476         my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
 477         $field->name($field_name_ur);
 478         my $field_comments = $field->comments
 479             ? "-- " . $field->comments . "\n  "
 480             : '';
 481
 482         my $field_def     = $field_comments.qq[$qf$field_name_ur$qf];
 483
 484         #
 485         # Datatype
 486         #
 487         my @size      = $field->size;
 488         my $data_type = lc $field->data_type;
 489         my %extra     = $field->extra;
 490         my $list      = $extra{'list'} || [];
 491         # todo deal with embedded quotes
 492         my $commalist = join( ', ', map { qq['$_'] } @$list );
 493
 494         if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
 495             my $type_name = $field->table->name . '_' . $field->name . '_type';
 496             $field_def .= ' '. $type_name;
 497             push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
 498             push @$type_drops, "DROP TYPE IF EXISTS $type_name";
 499         } else {
 500             $field_def .= ' '. convert_datatype($field);
 501         }
 502
 503         #
 504         # Default value
 505         #
 506         my $default = $field->default_value;
 507         if ( defined $default ) {
 508             SQL::Translator::Producer->_apply_default_value(
 509               \$field_def,
 510               $default,
 511               [
 512                 'NULL'              => \'NULL',
 513                 'now()'             => 'now()',
 514                 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
 515               ],
 516             );
 517         }
 518
 519         #
 520         # Not null constraint
 521         #
 522         $field_def .= ' NOT NULL' unless $field->is_nullable;
 523
 524         return $field_def;
 525     }
 526 }
 527
 528 sub create_index
 529 {
 530     my ($index, $options) = @_;
 531
 532     my $qt = $options->{quote_table_names} ||'';
 533     my $qf = $options->{quote_field_names} ||'';
 534     my $table_name = $index->table->name;
 535 #        my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
 536
 537     my ($index_def, @constraint_defs);
 538
 539     my $name = next_unused_name(
 540         $index->name
 541         || join('_', $table_name, 'idx', ++$index_name{ $table_name })
 542     );
 543
 544     my $type = $index->type || NORMAL;
 545     my @fields     =
 546         map { $_ =~ s/\(.+\)//; $_ }
 547     map { $qt ? $_ : unreserve($_, $table_name ) }
 548     $index->fields;
 549     next unless @fields;
 550
 551     my $def_start = qq[CONSTRAINT "$name" ];
 552     if ( $type eq PRIMARY_KEY ) {
 553         push @constraint_defs, "${def_start}PRIMARY KEY ".
 554             '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
 555     }
 556     elsif ( $type eq UNIQUE ) {
 557         push @constraint_defs, "${def_start}UNIQUE " .
 558             '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
 559     }
 560     elsif ( $type eq NORMAL ) {
 561         $index_def =
 562             "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
 563             join( ', ', map { qq[$qf$_$qf] } @fields ).
 564             ')'
 565             ;
 566     }
 567     else {
 568         warn "Unknown index type ($type) on table $table_name.\n"
 569             if $WARN;
 570     }
 571
 572     return $index_def, \@constraint_defs;
 573 }
 574
 575 sub create_constraint
 576 {
 577     my ($c, $options) = @_;
 578
 579     my $qf = $options->{quote_field_names} ||'';
 580     my $qt = $options->{quote_table_names} ||'';
 581     my $table_name = $c->table->name;
 582     my (@constraint_defs, @fks);
 583
 584     my $name = $c->name || '';
 585     if ( $name ) {
 586         $name = next_unused_name($name);
 587     }
 588
 589     my @fields     =
 590         map { $_ =~ s/\(.+\)//; $_ }
 591     map { $qt ? $_ : unreserve( $_, $table_name )}
 592     $c->fields;
 593
 594     my @rfields     =
 595         map { $_ =~ s/\(.+\)//; $_ }
 596     map { $qt ? $_ : unreserve( $_, $table_name )}
 597     $c->reference_fields;
 598
 599     next if !@fields && $c->type ne CHECK_C;
 600     my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
 601     if ( $c->type eq PRIMARY_KEY ) {
 602         push @constraint_defs, "${def_start}PRIMARY KEY ".
 603             '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 604     }
 605     elsif ( $c->type eq UNIQUE ) {
 606         $name = next_unused_name($name);
 607         push @constraint_defs, "${def_start}UNIQUE " .
 608             '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 609     }
 610     elsif ( $c->type eq CHECK_C ) {
 611         my $expression = $c->expression;
 612         push @constraint_defs, "${def_start}CHECK ($expression)";
 613     }
 614     elsif ( $c->type eq FOREIGN_KEY ) {
 615         my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
 616             join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
 617             "\n  REFERENCES " . $qt . $c->reference_table . $qt;
 618
 619         if ( @rfields ) {
 620             $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
 621         }
 622
 623         if ( $c->match_type ) {
 624             $def .= ' MATCH ' .
 625                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 626         }
 627
 628         if ( $c->on_delete ) {
 629             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 630         }
 631
 632         if ( $c->on_update ) {
 633             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 634         }
 635
 636         if ( $c->deferrable ) {
 637             $def .= ' DEFERRABLE';
 638         }
 639
 640         push @fks, "$def";
 641     }
 642
 643     return \@constraint_defs, \@fks;
 644 }
 645
 646 sub convert_datatype
 647 {
 648     my ($field) = @_;
 649
 650     my @size      = $field->size;
 651     my $data_type = lc $field->data_type;
 652
 653     if ( $data_type eq 'enum' ) {
 654 #        my $len = 0;
 655 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
 656 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
 657 #        push @$constraint_defs,
 658 #        qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
 659 #           qq[IN ($commalist))];
 660         $data_type = 'character varying';
 661     }
 662     elsif ( $data_type eq 'set' ) {
 663         $data_type = 'character varying';
 664     }
 665     elsif ( $field->is_auto_increment ) {
 666         if ( defined $size[0] && $size[0] > 11 ) {
 667             $data_type = 'bigserial';
 668         }
 669         else {
 670             $data_type = 'serial';
 671         }
 672         undef @size;
 673     }
 674     else {
 675         $data_type  = defined $translate{ $data_type } ?
 676             $translate{ $data_type } :
 677             $data_type;
 678     }
 679
 680     if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
 681         if ( defined $size[0] && $size[0] > 6 ) {
 682             $size[0] = 6;
 683         }
 684     }
 685
 686     if ( $data_type eq 'integer' ) {
 687         if ( defined $size[0] && $size[0] > 0) {
 688             if ( $size[0] > 10 ) {
 689                 $data_type = 'bigint';
 690             }
 691             elsif ( $size[0] < 5 ) {
 692                 $data_type = 'smallint';
 693             }
 694             else {
 695                 $data_type = 'integer';
 696             }
 697         }
 698         else {
 699             $data_type = 'integer';
 700         }
 701     }
 702
 703     my $type_with_size = join('|',
 704         'bit', 'varbit', 'character', 'bit varying', 'character varying',
 705         'time', 'timestamp', 'interval'
 706     );
 707
 708     if ( $data_type !~ /$type_with_size/ ) {
 709         @size = ();
 710     }
 711
 712     if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
 713         $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
 714         $data_type .= $2 if(defined $2);
 715     } elsif ( defined $size[0] && $size[0] > 0 ) {
 716         $data_type .= '(' . join( ',', @size ) . ')';
 717     }
 718
 719     return $data_type;
 720 }
 721
 722
 723 sub alter_field
 724 {
 725     my ($from_field, $to_field) = @_;
 726
 727     die "Can't alter field in another table"
 728         if($from_field->table->name ne $to_field->table->name);
 729
 730     my @out;
 731     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
 732                        $to_field->table->name,
 733                        $to_field->name) if(!$to_field->is_nullable and
 734                                            $from_field->is_nullable);
 735
 736     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
 737                       $to_field->table->name,
 738                       $to_field->name)
 739        if ( !$from_field->is_nullable and $to_field->is_nullable );
 740
 741
 742     my $from_dt = convert_datatype($from_field);
 743     my $to_dt   = convert_datatype($to_field);
 744     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
 745                        $to_field->table->name,
 746                        $to_field->name,
 747                        $to_dt) if($to_dt ne $from_dt);
 748
 749     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
 750                        $to_field->table->name,
 751                        $from_field->name,
 752                        $to_field->name) if($from_field->name ne $to_field->name);
 753
 754     my $old_default = $from_field->default_value;
 755     my $new_default = $to_field->default_value;
 756     my $default_value = $to_field->default_value;
 757
 758     # fixes bug where output like this was created:
 759     # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
 760     if(ref $default_value eq "SCALAR" ) {
 761         $default_value = $$default_value;
 762     } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
 763         $default_value =~ s/'/''/xsmg;
 764         $default_value = q(') . $default_value . q(');
 765     }
 766
 767     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
 768                        $to_field->table->name,
 769                        $to_field->name,
 770                        $default_value)
 771         if ( defined $new_default &&
 772              (!defined $old_default || $old_default ne $new_default) );
 773
 774      # fixes bug where removing the DEFAULT statement of a column
 775      # would result in no change
 776
 777      push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
 778                        $to_field->table->name,
 779                        $to_field->name)
 780         if ( !defined $new_default && defined $old_default );
 781
 782
 783     return wantarray ? @out : join("\n", @out);
 784 }
 785
 786 sub rename_field { alter_field(@_) }
 787
 788 sub add_field
 789 {
 790     my ($new_field) = @_;
 791
 792     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 793                       $new_field->table->name,
 794                       create_field($new_field));
 795     return $out;
 796
 797 }
 798
 799 sub drop_field
 800 {
 801     my ($old_field) = @_;
 802
 803     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 804                       $old_field->table->name,
 805                       $old_field->name);
 806
 807     return $out;
 808 }
 809
 810 sub alter_table {
 811     my ($to_table, $options) = @_;
 812     my $qt = $options->{quote_table_names} || '';
 813     my $out = sprintf('ALTER TABLE %s %s',
 814                       $qt . $to_table->name . $qt,
 815                       $options->{alter_table_action});
 816     return $out;
 817 }
 818
 819 sub rename_table {
 820     my ($old_table, $new_table, $options) = @_;
 821     my $qt = $options->{quote_table_names} || '';
 822     $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
 823     return alter_table($old_table, $options);
 824 }
 825
 826 sub alter_create_index {
 827     my ($index, $options) = @_;
 828     my $qt = $options->{quote_table_names} || '';
 829     my $qf = $options->{quote_field_names} || '';
 830     my ($idef, $constraints) = create_index($index, {
 831         quote_field_names => $qf,
 832         quote_table_names => $qt,
 833         table_name => $index->table->name,
 834     });
 835     return $index->type eq NORMAL ? $idef
 836         : sprintf('ALTER TABLE %s ADD %s',
 837               $qt . $index->table->name . $qt,
 838               join(q{}, @$constraints)
 839           );
 840 }
 841
 842 sub alter_drop_index {
 843     my ($index, $options) = @_;
 844     my $index_name = $index->name;
 845     return "DROP INDEX $index_name";
 846 }
 847
 848 sub alter_drop_constraint {
 849     my ($c, $options) = @_;
 850     my $qt = $options->{quote_table_names} || '';
 851     my $qc = $options->{quote_field_names} || '';
 852     my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
 853                       $qt . $c->table->name . $qt,
 854                       $qc . $c->name . $qc );
 855     return $out;
 856 }
 857
 858 sub alter_create_constraint {
 859     my ($index, $options) = @_;
 860     my $qt = $options->{quote_table_names} || '';
 861     my ($defs, $fks) = create_constraint(@_);
 862
 863     # return if there are no constraint definitions so we don't run
 864     # into output like this:
 865     # ALTER TABLE users ADD ;
 866
 867     return unless(@{$defs} || @{$fks});
 868     return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
 869         : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
 870               'ADD', join(q{}, @{$defs}, @{$fks})
 871           );
 872 }
 873
 874 sub drop_table {
 875     my ($table, $options) = @_;
 876     my $qt = $options->{quote_table_names} || '';
 877     return "DROP TABLE $qt$table$qt CASCADE";
 878 }
 879
 880 1;
 881
 882 # -------------------------------------------------------------------
 883 # Life is full of misery, loneliness, and suffering --
 884 # and it's all over much too soon.
 885 # Woody Allen
 886 # -------------------------------------------------------------------
 887
 888 =pod
 889
 890 =head1 SEE ALSO
 891
 892 SQL::Translator, SQL::Translator::Producer::Oracle.
 893
 894 =head1 AUTHOR
 895
 896 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 897
 898 =cut