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