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