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         # todo deal with embedded quotes
 464         my $commalist = join( ', ', map { qq['$_'] } @$list );
 465
 466         if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
 467             my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
 468             $field_def .= ' '. $type_name;
 469             my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
 470                                "CREATE TYPE $type_name AS ENUM ($commalist)";
 471             if (! exists $type_defs->{$type_name} ) {
 472                 $type_defs->{$type_name} = $new_type_def;
 473             } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
 474                 die "Attempted to redefine type name '$type_name' as a different type.\n";
 475             }
 476         } else {
 477             $field_def .= ' '. convert_datatype($field);
 478         }
 479
 480         #
 481         # Default value
 482         #
 483         SQL::Translator::Producer->_apply_default_value(
 484           $field,
 485           \$field_def,
 486           [
 487             'NULL'              => \'NULL',
 488             'now()'             => 'now()',
 489             'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
 490           ],
 491         );
 492
 493         #
 494         # Not null constraint
 495         #
 496         $field_def .= ' NOT NULL' unless $field->is_nullable;
 497
 498       #
 499       # Geometry constraints
 500       #
 501       if(is_geometry($field)){
 502          foreach ( create_geometry_constraints($field) ) {
 503             my ($cdefs, $fks) = create_constraint($_, {
 504                 generator => $generator,
 505             });
 506             push @$constraint_defs, @$cdefs;
 507             push @$fks, @$fks;
 508          }
 509         }
 510
 511         return $field_def;
 512     }
 513 }
 514
 515 sub create_geometry_constraints{
 516    my $field = shift;
 517
 518    my @constraints;
 519    push @constraints, SQL::Translator::Schema::Constraint->new(
 520                      name       => "enforce_dims_".$field->name,
 521                      expression => "(ST_NDims($field) = ".$field->extra->{dimensions}.")",
 522                      table       => $field->table,
 523                      type       => CHECK_C,
 524                   );
 525
 526    push @constraints, SQL::Translator::Schema::Constraint->new(
 527                      name       => "enforce_srid_".$field->name,
 528                      expression => "(ST_SRID($field) = ".$field->extra->{srid}.")",
 529                      table       => $field->table,
 530                      type       => CHECK_C,
 531                   );
 532    push @constraints, SQL::Translator::Schema::Constraint->new(
 533                      name       => "enforce_geotype_".$field->name,
 534                      expression => "(GeometryType($field) = '".$field->extra->{geometry_type}."'::text OR $field IS NULL)",
 535                      table       => $field->table,
 536                      type       => CHECK_C,
 537                   );
 538
 539    return @constraints;
 540 }
 541
 542 sub create_index
 543 {
 544     my ($index, $options) = @_;
 545
 546     my $generator = _generator($options);
 547     my $table_name = $index->table->name;
 548
 549     my ($index_def, @constraint_defs);
 550
 551     my $name
 552         = $index->name
 553         || join('_', $table_name, 'idx', ++$index_name{ $table_name });
 554
 555     my $type = $index->type || NORMAL;
 556     my @fields     =  $index->fields;
 557     return unless @fields;
 558
 559     my $def_start = 'CONSTRAINT ' . $generator->quote($name) . ' ';
 560     my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')';
 561     if ( $type eq PRIMARY_KEY ) {
 562         push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
 563     }
 564     elsif ( $type eq UNIQUE ) {
 565         push @constraint_defs, "${def_start}UNIQUE " .$field_names;
 566     }
 567     elsif ( $type eq NORMAL ) {
 568         $index_def =
 569             'CREATE INDEX ' . $generator->quote($name) . ' on ' . $generator->quote($table_name) . ' ' . $field_names
 570             ;
 571     }
 572     else {
 573         warn "Unknown index type ($type) on table $table_name.\n"
 574             if $WARN;
 575     }
 576
 577     return $index_def, \@constraint_defs;
 578 }
 579
 580 sub create_constraint
 581 {
 582     my ($c, $options) = @_;
 583
 584     my $generator = _generator($options);
 585     my $table_name = $c->table->name;
 586     my (@constraint_defs, @fks);
 587
 588     my $name = $c->name || '';
 589
 590     my @fields = grep { defined } $c->fields;
 591
 592     my @rfields = grep { defined } $c->reference_fields;
 593
 594     next if !@fields && $c->type ne CHECK_C;
 595     my $def_start = $name ? 'CONSTRAINT ' . $generator->quote($name) . ' ' : '';
 596     my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')';
 597     if ( $c->type eq PRIMARY_KEY ) {
 598         push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
 599     }
 600     elsif ( $c->type eq UNIQUE ) {
 601         push @constraint_defs, "${def_start}UNIQUE " .$field_names;
 602     }
 603     elsif ( $c->type eq CHECK_C ) {
 604         my $expression = $c->expression;
 605         push @constraint_defs, "${def_start}CHECK ($expression)";
 606     }
 607     elsif ( $c->type eq FOREIGN_KEY ) {
 608         my $def .= "ALTER TABLE " . $generator->quote($table_name) . " ADD ${def_start}FOREIGN KEY $field_names"
 609             . "\n  REFERENCES " . $generator->quote($c->reference_table);
 610
 611         if ( @rfields ) {
 612             $def .= ' (' . join( ', ', map { $generator->quote($_) } @rfields ) . ')';
 613         }
 614
 615         if ( $c->match_type ) {
 616             $def .= ' MATCH ' .
 617                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 618         }
 619
 620         if ( $c->on_delete ) {
 621             $def .= ' ON DELETE '. $c->on_delete;
 622         }
 623
 624         if ( $c->on_update ) {
 625             $def .= ' ON UPDATE '. $c->on_update;
 626         }
 627
 628         if ( $c->deferrable ) {
 629             $def .= ' DEFERRABLE';
 630         }
 631
 632         push @fks, "$def";
 633     }
 634
 635     return \@constraint_defs, \@fks;
 636 }
 637
 638 sub create_trigger {
 639   my ($trigger,$options) = @_;
 640
 641   my @statements;
 642
 643   push @statements, sprintf( 'DROP TRIGGER IF EXISTS %s', $trigger->name )
 644     if $options->{add_drop_trigger};
 645
 646   my $scope = $trigger->scope || '';
 647   $scope = " FOR EACH $scope" if $scope;
 648
 649   push @statements, sprintf(
 650     'CREATE TRIGGER %s %s %s ON %s%s %s',
 651     $trigger->name,
 652     $trigger->perform_action_when,
 653     join( ' OR ', @{ $trigger->database_events } ),
 654     $trigger->on_table,
 655     $scope,
 656     $trigger->action,
 657   );
 658
 659   return @statements;
 660 }
 661
 662 sub convert_datatype
 663 {
 664     my ($field) = @_;
 665
 666     my @size      = $field->size;
 667     my $data_type = lc $field->data_type;
 668     my $array = $data_type =~ s/\[\]$//;
 669
 670     if ( $data_type eq 'enum' ) {
 671 #        my $len = 0;
 672 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
 673 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
 674 #        push @$constraint_defs,
 675 #        'CONSTRAINT "$chk_name" CHECK (' . $generator->quote(field_name) .
 676 #           qq[IN ($commalist))];
 677         $data_type = 'character varying';
 678     }
 679     elsif ( $data_type eq 'set' ) {
 680         $data_type = 'character varying';
 681     }
 682     elsif ( $field->is_auto_increment ) {
 683         if ( defined $size[0] && $size[0] > 11 ) {
 684             $data_type = 'bigserial';
 685         }
 686         else {
 687             $data_type = 'serial';
 688         }
 689         undef @size;
 690     }
 691     else {
 692         $data_type  = defined $translate{ $data_type } ?
 693             $translate{ $data_type } :
 694             $data_type;
 695     }
 696
 697     if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
 698         if ( defined $size[0] && $size[0] > 6 ) {
 699             $size[0] = 6;
 700         }
 701     }
 702
 703     if ( $data_type eq 'integer' ) {
 704         if ( defined $size[0] && $size[0] > 0) {
 705             if ( $size[0] > 10 ) {
 706                 $data_type = 'bigint';
 707             }
 708             elsif ( $size[0] < 5 ) {
 709                 $data_type = 'smallint';
 710             }
 711             else {
 712                 $data_type = 'integer';
 713             }
 714         }
 715         else {
 716             $data_type = 'integer';
 717         }
 718     }
 719
 720     my $type_with_size = join('|',
 721         'bit', 'varbit', 'character', 'bit varying', 'character varying',
 722         'time', 'timestamp', 'interval', 'numeric'
 723     );
 724
 725     if ( $data_type !~ /$type_with_size/ ) {
 726         @size = ();
 727     }
 728
 729     if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
 730         $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
 731         $data_type .= $2 if(defined $2);
 732     } elsif ( defined $size[0] && $size[0] > 0 ) {
 733         $data_type .= '(' . join( ',', @size ) . ')';
 734     }
 735     if($array)
 736     {
 737         $data_type .= '[]';
 738     }
 739
 740     #
 741     # Geography
 742     #
 743     if($data_type eq 'geography'){
 744         $data_type .= '('.$field->extra->{geography_type}.','. $field->extra->{srid} .')'
 745     }
 746
 747     return $data_type;
 748 }
 749
 750
 751 sub alter_field
 752 {
 753     my ($from_field, $to_field) = @_;
 754
 755     die "Can't alter field in another table"
 756         if($from_field->table->name ne $to_field->table->name);
 757
 758     my @out;
 759
 760     # drop geometry column and constraints
 761     push @out, drop_geometry_column($from_field) if is_geometry($from_field);
 762     push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
 763
 764     # it's necessary to start with rename column cause this would affect
 765     # all of the following statements which would be broken if do the
 766     # rename later
 767     # BUT: drop geometry is done before the rename, cause it work's on the
 768     # $from_field directly
 769     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
 770                        $to_field->table->name,
 771                        $from_field->name,
 772                        $to_field->name) if($from_field->name ne $to_field->name);
 773
 774     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
 775                        $to_field->table->name,
 776                        $to_field->name) if(!$to_field->is_nullable and
 777                                            $from_field->is_nullable);
 778
 779     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
 780                       $to_field->table->name,
 781                       $to_field->name)
 782        if ( !$from_field->is_nullable and $to_field->is_nullable );
 783
 784
 785     my $from_dt = convert_datatype($from_field);
 786     my $to_dt   = convert_datatype($to_field);
 787     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
 788                        $to_field->table->name,
 789                        $to_field->name,
 790                        $to_dt) if($to_dt ne $from_dt);
 791
 792     my $old_default = $from_field->default_value;
 793     my $new_default = $to_field->default_value;
 794     my $default_value = $to_field->default_value;
 795
 796     # fixes bug where output like this was created:
 797     # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
 798     if(ref $default_value eq "SCALAR" ) {
 799         $default_value = $$default_value;
 800     } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
 801         $default_value =~ s/'/''/xsmg;
 802         $default_value = q(') . $default_value . q(');
 803     }
 804
 805     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
 806                        $to_field->table->name,
 807                        $to_field->name,
 808                        $default_value)
 809         if ( defined $new_default &&
 810              (!defined $old_default || $old_default ne $new_default) );
 811
 812     # fixes bug where removing the DEFAULT statement of a column
 813     # would result in no change
 814
 815     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
 816                        $to_field->table->name,
 817                        $to_field->name)
 818         if ( !defined $new_default && defined $old_default );
 819
 820     # add geometry column and constraints
 821     push @out, add_geometry_column($to_field) if is_geometry($to_field);
 822     push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
 823
 824     return wantarray ? @out : join(";\n", @out);
 825 }
 826
 827 sub rename_field { alter_field(@_) }
 828
 829 sub add_field
 830 {
 831     my ($new_field) = @_;
 832
 833     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 834                       $new_field->table->name,
 835                       create_field($new_field));
 836     $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
 837     $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
 838     return $out;
 839
 840 }
 841
 842 sub drop_field
 843 {
 844     my ($old_field, $options) = @_;
 845
 846     my $generator = _generator($options);
 847
 848     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 849                       $generator->quote($old_field->table->name),
 850                       $generator->quote($old_field->name));
 851         $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
 852     return $out;
 853 }
 854
 855 sub add_geometry_column{
 856    my ($field,$options) = @_;
 857
 858    my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
 859                   '',
 860                   $field->table->schema->name,
 861                   $options->{table} ? $options->{table} : $field->table->name,
 862                   $field->name,
 863                   $field->extra->{dimensions},
 864                   $field->extra->{srid},
 865                   $field->extra->{geometry_type});
 866     return $out;
 867 }
 868
 869 sub drop_geometry_column
 870 {
 871    my $field = shift;
 872
 873    my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
 874                   $field->table->schema->name,
 875                   $field->table->name,
 876                   $field->name);
 877     return $out;
 878 }
 879
 880 sub add_geometry_constraints{
 881    my $field = shift;
 882
 883    my @constraints = create_geometry_constraints($field);
 884
 885    my $out = join("\n", map { alter_create_constraint($_); } @constraints);
 886
 887    return $out;
 888 }
 889
 890 sub drop_geometry_constraints{
 891    my $field = shift;
 892
 893    my @constraints = create_geometry_constraints($field);
 894
 895    my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
 896
 897    return $out;
 898 }
 899
 900 sub alter_table {
 901     my ($to_table, $options) = @_;
 902     my $generator = _generator($options);
 903     my $out = sprintf('ALTER TABLE %s %s',
 904                       $generator->quote($to_table->name),
 905                       $options->{alter_table_action});
 906     $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
 907     return $out;
 908 }
 909
 910 sub rename_table {
 911     my ($old_table, $new_table, $options) = @_;
 912     my $generator = _generator($options);
 913     $options->{alter_table_action} = "RENAME TO " . $generator->quote($new_table);
 914
 915    my @geometry_changes;
 916    push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
 917    push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
 918
 919     $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
 920
 921     return alter_table($old_table, $options);
 922 }
 923
 924 sub alter_create_index {
 925     my ($index, $options) = @_;
 926     my $generator = _generator($options);
 927     my ($idef, $constraints) = create_index($index, {
 928         generator => $generator,
 929     });
 930     return $index->type eq NORMAL ? $idef
 931         : sprintf('ALTER TABLE %s ADD %s',
 932               $generator->quote($index->table->name),
 933               join(q{}, @$constraints)
 934           );
 935 }
 936
 937 sub alter_drop_index {
 938     my ($index, $options) = @_;
 939     my $index_name = $index->name;
 940     return "DROP INDEX $index_name";
 941 }
 942
 943 sub alter_drop_constraint {
 944     my ($c, $options) = @_;
 945     my $generator = _generator($options);
 946
 947     # attention: Postgres  has a very special naming structure for naming
 948     # foreign keys and primary keys.  It names them using the name of the
 949     # table as prefix and fkey or pkey as suffix, concatenated by an underscore
 950     my $c_name;
 951     if( $c->name ) {
 952         # Already has a name, just quote it
 953         $c_name = $generator->quote($c->name);
 954     } elsif ( $c->type eq FOREIGN_KEY ) {
 955         # Doesn't have a name, and is foreign key, append '_fkey'
 956         $c_name = $generator->quote($c->table->name . '_' .
 957                                     ($c->fields)[0] . '_fkey');
 958     } elsif ( $c->type eq PRIMARY_KEY ) {
 959         # Doesn't have a name, and is primary key, append '_pkey'
 960         $c_name = $generator->quote($c->table->name . '_pkey');
 961     }
 962
 963     return sprintf(
 964         'ALTER TABLE %s DROP CONSTRAINT %s',
 965         $generator->quote($c->table->name), $c_name
 966     );
 967 }
 968
 969 sub alter_create_constraint {
 970     my ($index, $options) = @_;
 971     my $generator = _generator($options);
 972     my ($defs, $fks) = create_constraint(@_);
 973
 974     # return if there are no constraint definitions so we don't run
 975     # into output like this:
 976     # ALTER TABLE users ADD ;
 977
 978     return unless(@{$defs} || @{$fks});
 979     return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
 980         : join( ' ', 'ALTER TABLE', $generator->quote($index->table->name),
 981               'ADD', join(q{}, @{$defs}, @{$fks})
 982           );
 983 }
 984
 985 sub drop_table {
 986     my ($table, $options) = @_;
 987     my $generator = _generator($options);
 988     my $out = "DROP TABLE " . $generator->quote($table) . " CASCADE";
 989
 990     my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
 991
 992     $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
 993     return $out;
 994 }
 995
 996 sub batch_alter_table {
 997   my ( $table, $diff_hash, $options ) = @_;
 998
 999   # as long as we're not renaming the table we don't need to be here
1000   if ( @{$diff_hash->{rename_table}} == 0 ) {
1001     return batch_alter_table_statements($diff_hash, $options);
1002   }
1003
1004   # first we need to perform drops which are on old table
1005   my @sql = batch_alter_table_statements($diff_hash, $options, qw(
1006     alter_drop_constraint
1007     alter_drop_index
1008     drop_field
1009   ));
1010
1011   # next comes the rename_table
1012   my $old_table = $diff_hash->{rename_table}[0][0];
1013   push @sql, rename_table( $old_table, $table, $options );
1014
1015   # for alter_field (and so also rename_field) we need to make sure old
1016   # field has table name set to new table otherwise calling alter_field dies
1017   $diff_hash->{alter_field} =
1018     [map { $_->[0]->table($table) && $_ } @{$diff_hash->{alter_field}}];
1019   $diff_hash->{rename_field} =
1020     [map { $_->[0]->table($table) && $_ } @{$diff_hash->{rename_field}}];
1021
1022   # now add everything else
1023   push @sql, batch_alter_table_statements($diff_hash, $options, qw(
1024     add_field
1025     alter_field
1026     rename_field
1027     alter_create_index
1028     alter_create_constraint
1029     alter_table
1030   ));
1031
1032   return @sql;
1033 }
1034
1035 1;
1036
1037 # -------------------------------------------------------------------
1038 # Life is full of misery, loneliness, and suffering --
1039 # and it's all over much too soon.
1040 # Woody Allen
1041 # -------------------------------------------------------------------
1042
1043 =pod
1044
1045 =head1 SEE ALSO
1046
1047 SQL::Translator, SQL::Translator::Producer::Oracle.
1048
1049 =head1 AUTHOR
1050
1051 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
1052
1053 =cut