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