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