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