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