lib/SQL/Translator/Producer/PostgreSQL.pm

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