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