lib/SQL/Translator/Producer/PostgreSQL.pm

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