lib/SQL/Translator/Producer/PostgreSQL.pm

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