2a71463257c19c5defcfca297a26d66541b639f0
[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 {
251    my $field = shift;
252    return 1 if $field->data_type eq 'geometry';
253 }
254
255 sub is_geography
256 {
257     my $field = shift;
258     return 1 if $field->data_type eq 'geography';
259 }
260
261 sub create_table
262 {
263     my ($table, $options) = @_;
264
265     my $generator = _generator($options);
266     my $no_comments = $options->{no_comments} || 0;
267     my $add_drop_table = $options->{add_drop_table} || 0;
268     my $postgres_version = $options->{postgres_version} || 0;
269     my $type_defs = $options->{type_defs} || {};
270
271     my $table_name = $table->name or next;
272     my $table_name_qt = $generator->quote($table_name);
273
274 # print STDERR "$table_name table_name\n";
275     my ( @comments, @field_defs, @index_defs, @sequence_defs, @constraint_defs, @fks );
276
277     push @comments, "--\n-- Table: $table_name\n--\n" unless $no_comments;
278
279     if ( !$no_comments and my $comments = $table->comments ) {
280         $comments =~ s/^/-- /mg;
281         push @comments, "-- Comments:\n$comments\n--\n";
282     }
283
284     #
285     # Fields
286     #
287     for my $field ( $table->get_fields ) {
288         push @field_defs, create_field($field, {
289             generator => $generator,
290             postgres_version => $postgres_version,
291             type_defs => $type_defs,
292             constraint_defs => \@constraint_defs,
293         });
294     }
295
296     #
297     # Index Declarations
298     #
299     for my $index ( $table->get_indices ) {
300         my ($idef, $constraints) = create_index($index, {
301             generator => $generator,
302         });
303         $idef and push @index_defs, $idef;
304         push @constraint_defs, @$constraints;
305     }
306
307     #
308     # Table constraints
309     #
310     for my $c ( $table->get_constraints ) {
311         my ($cdefs, $fks) = create_constraint($c, {
312             generator => $generator,
313         });
314         push @constraint_defs, @$cdefs;
315         push @fks, @$fks;
316     }
317
318
319     my $create_statement = join("\n", @comments);
320     if ($add_drop_table) {
321         if ($postgres_version >= 8.002) {
322             $create_statement .= "DROP TABLE IF EXISTS $table_name_qt CASCADE;\n";
323         } else {
324             $create_statement .= "DROP TABLE $table_name_qt CASCADE;\n";
325         }
326     }
327     my $temporary = $table->extra->{temporary} ? "TEMPORARY " : "";
328     $create_statement .= "CREATE ${temporary}TABLE $table_name_qt (\n" .
329                             join( ",\n", map { "  $_" } @field_defs, @constraint_defs ).
330                             "\n)"
331                             ;
332     $create_statement .= @index_defs ? ';' : q{};
333     $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
334         . join(";\n", @index_defs);
335
336    #
337    # Geometry
338    #
339    if(grep { is_geometry($_) } $table->get_fields){
340         $create_statement .= ";";
341         my @geometry_columns;
342         foreach my $col ($table->get_fields) { push(@geometry_columns,$col) if is_geometry($col); }
343       $create_statement .= "\n".join("\n", map{ drop_geometry_column($_) } @geometry_columns) if $options->{add_drop_table};
344       $create_statement .= "\n".join("\n", map{ add_geometry_column($_) } @geometry_columns);
345    }
346
347     return $create_statement, \@fks;
348 }
349
350 sub create_view {
351     my ($view, $options) = @_;
352     my $generator = _generator($options);
353     my $postgres_version = $options->{postgres_version} || 0;
354     my $add_drop_view = $options->{add_drop_view};
355
356     my $view_name = $view->name;
357     debug("PKG: Looking at view '${view_name}'\n");
358
359     my $create = '';
360     $create .= "--\n-- View: " . $generator->quote($view_name) . "\n--\n"
361         unless $options->{no_comments};
362     if ($add_drop_view) {
363         if ($postgres_version >= 8.002) {
364             $create .= "DROP VIEW IF EXISTS " . $generator->quote($view_name) . ";\n";
365         } else {
366             $create .= "DROP VIEW " . $generator->quote($view_name) . ";\n";
367         }
368     }
369     $create .= 'CREATE';
370
371     my $extra = $view->extra;
372     $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
373     $create .= " VIEW " . $generator->quote($view_name);
374
375     if ( my @fields = $view->fields ) {
376         my $field_list = join ', ', map { $generator->quote($_) } @fields;
377         $create .= " ( ${field_list} )";
378     }
379
380     if ( my $sql = $view->sql ) {
381         $create .= " AS\n    ${sql}\n";
382     }
383
384     if ( $extra->{check_option} ) {
385         $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
386     }
387
388     return $create;
389 }
390
391 {
392
393     my %field_name_scope;
394
395     sub create_field
396     {
397         my ($field, $options) = @_;
398
399         my $generator = _generator($options);
400         my $table_name = $field->table->name;
401         my $constraint_defs = $options->{constraint_defs} || [];
402         my $postgres_version = $options->{postgres_version} || 0;
403         my $type_defs = $options->{type_defs} || {};
404
405         $field_name_scope{$table_name} ||= {};
406         my $field_name    = $field->name;
407         my $field_comments = '';
408         if (my $comments = $field->comments) {
409             $comments =~ s/(?<!\A)^/  -- /mg;
410             $field_comments = "-- $comments\n  ";
411         }
412
413         my $field_def     = $field_comments . $generator->quote($field_name);
414
415         #
416         # Datatype
417         #
418         my @size      = $field->size;
419         my $data_type = lc $field->data_type;
420         my %extra     = $field->extra;
421         my $list      = $extra{'list'} || [];
422         my $commalist = join( ', ', map { __PACKAGE__->_quote_string($_) } @$list );
423
424         if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
425             my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
426             $field_def .= ' '. $type_name;
427             my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
428                                "CREATE TYPE $type_name AS ENUM ($commalist)";
429             if (! exists $type_defs->{$type_name} ) {
430                 $type_defs->{$type_name} = $new_type_def;
431             } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
432                 die "Attempted to redefine type name '$type_name' as a different type.\n";
433             }
434         } else {
435             $field_def .= ' '. convert_datatype($field);
436         }
437
438         #
439         # Default value
440         #
441         __PACKAGE__->_apply_default_value(
442           $field,
443           \$field_def,
444           [
445             'NULL'              => \'NULL',
446             'now()'             => 'now()',
447             'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
448           ],
449         );
450
451         #
452         # Not null constraint
453         #
454         $field_def .= ' NOT NULL' unless $field->is_nullable;
455
456       #
457       # Geometry constraints
458       #
459       if(is_geometry($field)){
460          foreach ( create_geometry_constraints($field) ) {
461             my ($cdefs, $fks) = create_constraint($_, {
462                 generator => $generator,
463             });
464             push @$constraint_defs, @$cdefs;
465             push @$fks, @$fks;
466          }
467         }
468
469         return $field_def;
470     }
471 }
472
473 sub create_geometry_constraints{
474    my $field = shift;
475
476    my @constraints;
477    push @constraints, SQL::Translator::Schema::Constraint->new(
478                      name       => "enforce_dims_".$field->name,
479                      expression => "(ST_NDims($field) = ".$field->extra->{dimensions}.")",
480                      table       => $field->table,
481                      type       => CHECK_C,
482                   );
483
484    push @constraints, SQL::Translator::Schema::Constraint->new(
485                      name       => "enforce_srid_".$field->name,
486                      expression => "(ST_SRID($field) = ".$field->extra->{srid}.")",
487                      table       => $field->table,
488                      type       => CHECK_C,
489                   );
490    push @constraints, SQL::Translator::Schema::Constraint->new(
491                      name       => "enforce_geotype_".$field->name,
492                      expression => "(GeometryType($field) = '".$field->extra->{geometry_type}."'::text OR $field IS NULL)",
493                      table       => $field->table,
494                      type       => CHECK_C,
495                   );
496
497    return @constraints;
498 }
499
500 {
501     my %index_name;
502     sub create_index
503     {
504         my ($index, $options) = @_;
505
506         my $generator = _generator($options);
507         my $table_name = $index->table->name;
508
509         my ($index_def, @constraint_defs);
510
511         my $name
512             = $index->name
513             || join('_', $table_name, 'idx', ++$index_name{ $table_name });
514
515         my $type = $index->type || NORMAL;
516         my @fields     =  $index->fields;
517         return unless @fields;
518
519         my $index_using;
520         my $index_where;
521         for my $opt ( $index->options ) {
522             if ( ref $opt eq 'HASH' ) {
523                 foreach my $key (keys %$opt) {
524                     my $value = $opt->{$key};
525                     next unless defined $value;
526                     if ( uc($key) eq 'USING' ) {
527                         $index_using = "USING $value";
528                     }
529                     elsif ( uc($key) eq 'WHERE' ) {
530                         $index_where = "WHERE $value";
531                     }
532                 }
533             }
534         }
535
536         my $def_start = 'CONSTRAINT ' . $generator->quote($name) . ' ';
537         my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')';
538         if ( $type eq PRIMARY_KEY ) {
539             push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
540         }
541         elsif ( $type eq UNIQUE ) {
542             push @constraint_defs, "${def_start}UNIQUE " .$field_names;
543         }
544         elsif ( $type eq NORMAL ) {
545             $index_def =
546                 'CREATE INDEX ' . $generator->quote($name) . ' on ' . $generator->quote($table_name) . ' ' .
547                 join ' ', grep { defined } $index_using, $field_names, $index_where;
548         }
549         else {
550             warn "Unknown index type ($type) on table $table_name.\n"
551                 if $WARN;
552         }
553
554         return $index_def, \@constraint_defs;
555     }
556 }
557
558 sub create_constraint
559 {
560     my ($c, $options) = @_;
561
562     my $generator = _generator($options);
563     my $table_name = $c->table->name;
564     my (@constraint_defs, @fks);
565
566     my $name = $c->name || '';
567
568     my @fields = grep { defined } $c->fields;
569
570     my @rfields = grep { defined } $c->reference_fields;
571
572     next if !@fields && $c->type ne CHECK_C;
573     my $def_start = $name ? 'CONSTRAINT ' . $generator->quote($name) . ' ' : '';
574     my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')';
575     if ( $c->type eq PRIMARY_KEY ) {
576         push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
577     }
578     elsif ( $c->type eq UNIQUE ) {
579         push @constraint_defs, "${def_start}UNIQUE " .$field_names;
580     }
581     elsif ( $c->type eq CHECK_C ) {
582         my $expression = $c->expression;
583         push @constraint_defs, "${def_start}CHECK ($expression)";
584     }
585     elsif ( $c->type eq FOREIGN_KEY ) {
586         my $def .= "ALTER TABLE " . $generator->quote($table_name) . " ADD ${def_start}FOREIGN KEY $field_names"
587             . "\n  REFERENCES " . $generator->quote($c->reference_table);
588
589         if ( @rfields ) {
590             $def .= ' (' . join( ', ', map { $generator->quote($_) } @rfields ) . ')';
591         }
592
593         if ( $c->match_type ) {
594             $def .= ' MATCH ' .
595                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
596         }
597
598         if ( $c->on_delete ) {
599             $def .= ' ON DELETE '. $c->on_delete;
600         }
601
602         if ( $c->on_update ) {
603             $def .= ' ON UPDATE '. $c->on_update;
604         }
605
606         if ( $c->deferrable ) {
607             $def .= ' DEFERRABLE';
608         }
609
610         push @fks, "$def";
611     }
612
613     return \@constraint_defs, \@fks;
614 }
615
616 sub create_trigger {
617   my ($trigger,$options) = @_;
618   my $generator = _generator($options);
619
620   my @statements;
621
622   push @statements, sprintf( 'DROP TRIGGER IF EXISTS %s', $generator->quote($trigger->name) )
623     if $options->{add_drop_trigger};
624
625   my $scope = $trigger->scope || '';
626   $scope = " FOR EACH $scope" if $scope;
627
628   push @statements, sprintf(
629     'CREATE TRIGGER %s %s %s ON %s%s %s',
630     $generator->quote($trigger->name),
631     $trigger->perform_action_when,
632     join( ' OR ', @{ $trigger->database_events } ),
633     $generator->quote($trigger->on_table),
634     $scope,
635     $trigger->action,
636   );
637
638   return @statements;
639 }
640
641 sub convert_datatype
642 {
643     my ($field) = @_;
644
645     my @size      = $field->size;
646     my $data_type = lc $field->data_type;
647     my $array = $data_type =~ s/\[\]$//;
648
649     if ( $data_type eq 'enum' ) {
650 #        my $len = 0;
651 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
652 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
653 #        push @$constraint_defs,
654 #        'CONSTRAINT "$chk_name" CHECK (' . $generator->quote(field_name) .
655 #           qq[IN ($commalist))];
656         $data_type = 'character varying';
657     }
658     elsif ( $data_type eq 'set' ) {
659         $data_type = 'character varying';
660     }
661     elsif ( $field->is_auto_increment ) {
662         if ( defined $size[0] && $size[0] > 11 ) {
663             $data_type = 'bigserial';
664         }
665         else {
666             $data_type = 'serial';
667         }
668         undef @size;
669     }
670     else {
671         $data_type  = defined $translate{ lc $data_type } ?
672             $translate{ lc $data_type } :
673             $data_type;
674     }
675
676     if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
677         if ( defined $size[0] && $size[0] > 6 ) {
678             $size[0] = 6;
679         }
680     }
681
682     if ( $data_type eq 'integer' ) {
683         if ( defined $size[0] && $size[0] > 0) {
684             if ( $size[0] > 10 ) {
685                 $data_type = 'bigint';
686             }
687             elsif ( $size[0] < 5 ) {
688                 $data_type = 'smallint';
689             }
690             else {
691                 $data_type = 'integer';
692             }
693         }
694         else {
695             $data_type = 'integer';
696         }
697     }
698
699     my $type_with_size = join('|',
700         'bit', 'varbit', 'character', 'bit varying', 'character varying',
701         'time', 'timestamp', 'interval', 'numeric', 'float'
702     );
703
704     if ( $data_type !~ /$type_with_size/ ) {
705         @size = ();
706     }
707
708     if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
709         $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
710         $data_type .= $2 if(defined $2);
711     } elsif ( defined $size[0] && $size[0] > 0 ) {
712         $data_type .= '(' . join( ',', @size ) . ')';
713     }
714     if($array)
715     {
716         $data_type .= '[]';
717     }
718
719     #
720     # Geography
721     #
722     if($data_type eq 'geography'){
723         $data_type .= '('.$field->extra->{geography_type}.','. $field->extra->{srid} .')'
724     }
725
726     return $data_type;
727 }
728
729
730 sub alter_field
731 {
732     my ($from_field, $to_field) = @_;
733
734     die "Can't alter field in another table"
735         if($from_field->table->name ne $to_field->table->name);
736
737     my @out;
738
739     # drop geometry column and constraints
740     push @out, drop_geometry_column($from_field) if is_geometry($from_field);
741     push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
742
743     # it's necessary to start with rename column cause this would affect
744     # all of the following statements which would be broken if do the
745     # rename later
746     # BUT: drop geometry is done before the rename, cause it work's on the
747     # $from_field directly
748     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
749                        $to_field->table->name,
750                        $from_field->name,
751                        $to_field->name) if($from_field->name ne $to_field->name);
752
753     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
754                        $to_field->table->name,
755                        $to_field->name) if(!$to_field->is_nullable and
756                                            $from_field->is_nullable);
757
758     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
759                       $to_field->table->name,
760                       $to_field->name)
761        if ( !$from_field->is_nullable and $to_field->is_nullable );
762
763
764     my $from_dt = convert_datatype($from_field);
765     my $to_dt   = convert_datatype($to_field);
766     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
767                        $to_field->table->name,
768                        $to_field->name,
769                        $to_dt) if($to_dt ne $from_dt);
770
771     my $old_default = $from_field->default_value;
772     my $new_default = $to_field->default_value;
773     my $default_value = $to_field->default_value;
774
775     # fixes bug where output like this was created:
776     # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
777     if(ref $default_value eq "SCALAR" ) {
778         $default_value = $$default_value;
779     } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
780         $default_value = __PACKAGE__->_quote_string($default_value);
781     }
782
783     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
784                        $to_field->table->name,
785                        $to_field->name,
786                        $default_value)
787         if ( defined $new_default &&
788              (!defined $old_default || $old_default ne $new_default) );
789
790     # fixes bug where removing the DEFAULT statement of a column
791     # would result in no change
792
793     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
794                        $to_field->table->name,
795                        $to_field->name)
796         if ( !defined $new_default && defined $old_default );
797
798     # add geometry column and constraints
799     push @out, add_geometry_column($to_field) if is_geometry($to_field);
800     push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
801
802     return wantarray ? @out : join(";\n", @out);
803 }
804
805 sub rename_field { alter_field(@_) }
806
807 sub add_field
808 {
809     my ($new_field) = @_;
810
811     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
812                       $new_field->table->name,
813                       create_field($new_field));
814     $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
815     $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
816     return $out;
817
818 }
819
820 sub drop_field
821 {
822     my ($old_field, $options) = @_;
823
824     my $generator = _generator($options);
825
826     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
827                       $generator->quote($old_field->table->name),
828                       $generator->quote($old_field->name));
829         $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
830     return $out;
831 }
832
833 sub add_geometry_column{
834    my ($field,$options) = @_;
835
836    my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
837                   '',
838                   $field->table->schema->name,
839                   $options->{table} ? $options->{table} : $field->table->name,
840                   $field->name,
841                   $field->extra->{dimensions},
842                   $field->extra->{srid},
843                   $field->extra->{geometry_type});
844     return $out;
845 }
846
847 sub drop_geometry_column
848 {
849    my $field = shift;
850
851    my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
852                   $field->table->schema->name,
853                   $field->table->name,
854                   $field->name);
855     return $out;
856 }
857
858 sub add_geometry_constraints{
859    my $field = shift;
860
861    my @constraints = create_geometry_constraints($field);
862
863    my $out = join("\n", map { alter_create_constraint($_); } @constraints);
864
865    return $out;
866 }
867
868 sub drop_geometry_constraints{
869    my $field = shift;
870
871    my @constraints = create_geometry_constraints($field);
872
873    my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
874
875    return $out;
876 }
877
878 sub alter_table {
879     my ($to_table, $options) = @_;
880     my $generator = _generator($options);
881     my $out = sprintf('ALTER TABLE %s %s',
882                       $generator->quote($to_table->name),
883                       $options->{alter_table_action});
884     $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
885     return $out;
886 }
887
888 sub rename_table {
889     my ($old_table, $new_table, $options) = @_;
890     my $generator = _generator($options);
891     $options->{alter_table_action} = "RENAME TO " . $generator->quote($new_table);
892
893    my @geometry_changes;
894    push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
895    push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
896
897     $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
898
899     return alter_table($old_table, $options);
900 }
901
902 sub alter_create_index {
903     my ($index, $options) = @_;
904     my $generator = _generator($options);
905     my ($idef, $constraints) = create_index($index, {
906         generator => $generator,
907     });
908     return $index->type eq NORMAL ? $idef
909         : sprintf('ALTER TABLE %s ADD %s',
910               $generator->quote($index->table->name),
911               join(q{}, @$constraints)
912           );
913 }
914
915 sub alter_drop_index {
916     my ($index, $options) = @_;
917     my $index_name = $index->name;
918     return "DROP INDEX $index_name";
919 }
920
921 sub alter_drop_constraint {
922     my ($c, $options) = @_;
923     my $generator = _generator($options);
924
925     # attention: Postgres  has a very special naming structure for naming
926     # foreign keys and primary keys.  It names them using the name of the
927     # table as prefix and fkey or pkey as suffix, concatenated by an underscore
928     my $c_name;
929     if( $c->name ) {
930         # Already has a name, just quote it
931         $c_name = $generator->quote($c->name);
932     } elsif ( $c->type eq FOREIGN_KEY ) {
933         # Doesn't have a name, and is foreign key, append '_fkey'
934         $c_name = $generator->quote($c->table->name . '_' .
935                                     ($c->fields)[0] . '_fkey');
936     } elsif ( $c->type eq PRIMARY_KEY ) {
937         # Doesn't have a name, and is primary key, append '_pkey'
938         $c_name = $generator->quote($c->table->name . '_pkey');
939     }
940
941     return sprintf(
942         'ALTER TABLE %s DROP CONSTRAINT %s',
943         $generator->quote($c->table->name), $c_name
944     );
945 }
946
947 sub alter_create_constraint {
948     my ($index, $options) = @_;
949     my $generator = _generator($options);
950     my ($defs, $fks) = create_constraint(@_);
951
952     # return if there are no constraint definitions so we don't run
953     # into output like this:
954     # ALTER TABLE users ADD ;
955
956     return unless(@{$defs} || @{$fks});
957     return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
958         : join( ' ', 'ALTER TABLE', $generator->quote($index->table->name),
959               'ADD', join(q{}, @{$defs}, @{$fks})
960           );
961 }
962
963 sub drop_table {
964     my ($table, $options) = @_;
965     my $generator = _generator($options);
966     my $out = "DROP TABLE " . $generator->quote($table) . " CASCADE";
967
968     my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
969
970     $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
971     return $out;
972 }
973
974 sub batch_alter_table {
975   my ( $table, $diff_hash, $options ) = @_;
976
977   # as long as we're not renaming the table we don't need to be here
978   if ( @{$diff_hash->{rename_table}} == 0 ) {
979     return batch_alter_table_statements($diff_hash, $options);
980   }
981
982   # first we need to perform drops which are on old table
983   my @sql = batch_alter_table_statements($diff_hash, $options, qw(
984     alter_drop_constraint
985     alter_drop_index
986     drop_field
987   ));
988
989   # next comes the rename_table
990   my $old_table = $diff_hash->{rename_table}[0][0];
991   push @sql, rename_table( $old_table, $table, $options );
992
993   # for alter_field (and so also rename_field) we need to make sure old
994   # field has table name set to new table otherwise calling alter_field dies
995   $diff_hash->{alter_field} =
996     [map { $_->[0]->table($table) && $_ } @{$diff_hash->{alter_field}}];
997   $diff_hash->{rename_field} =
998     [map { $_->[0]->table($table) && $_ } @{$diff_hash->{rename_field}}];
999
1000   # now add everything else
1001   push @sql, batch_alter_table_statements($diff_hash, $options, qw(
1002     add_field
1003     alter_field
1004     rename_field
1005     alter_create_index
1006     alter_create_constraint
1007     alter_table
1008   ));
1009
1010   return @sql;
1011 }
1012
1013 1;
1014
1015 # -------------------------------------------------------------------
1016 # Life is full of misery, loneliness, and suffering --
1017 # and it's all over much too soon.
1018 # Woody Allen
1019 # -------------------------------------------------------------------
1020
1021 =pod
1022
1023 =head1 SEE ALSO
1024
1025 SQL::Translator, SQL::Translator::Producer::Oracle.
1026
1027 =head1 AUTHOR
1028
1029 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
1030
1031 =cut