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