Allow passing an arrayref to SQLT->filename
[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);
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 contraints
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     return sprintf(
972         'ALTER TABLE %s DROP CONSTRAINT %s',
973         $generator->quote($c->table->name),
974         # attention: Postgres  has a very special naming structure
975         # for naming foreign keys, it names them uses the name of
976         # the table as prefix and fkey as suffix, concatenated by a underscore
977         $c->type eq FOREIGN_KEY
978             ? $c->name
979                 ? $qc . $c->name . $qc
980                 : $qc . $c->table->name . '_' . ($c->fields)[0] . '_fkey' . $qc
981             : $qc . $c->name . $qc
982     );
983 }
984
985 sub alter_create_constraint {
986     my ($index, $options) = @_;
987     my $qt = $options->{quote_table_names} || '';
988     $generator->quote_chars([$qt]);
989     my ($defs, $fks) = create_constraint(@_);
990
991     # return if there are no constraint definitions so we don't run
992     # into output like this:
993     # ALTER TABLE users ADD ;
994
995     return unless(@{$defs} || @{$fks});
996     return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
997         : join( ' ', 'ALTER TABLE', $generator->quote($index->table->name),
998               'ADD', join(q{}, @{$defs}, @{$fks})
999           );
1000 }
1001
1002 sub drop_table {
1003     my ($table, $options) = @_;
1004     my $qt = $options->{quote_table_names} || '';
1005     $generator->quote_chars([$qt]);
1006     my $out = "DROP TABLE " . $generator->quote($table) . " CASCADE";
1007
1008     my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
1009
1010     $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
1011     return $out;
1012 }
1013
1014 1;
1015
1016 # -------------------------------------------------------------------
1017 # Life is full of misery, loneliness, and suffering --
1018 # and it's all over much too soon.
1019 # Woody Allen
1020 # -------------------------------------------------------------------
1021
1022 =pod
1023
1024 =head1 SEE ALSO
1025
1026 SQL::Translator, SQL::Translator::Producer::Oracle.
1027
1028 =head1 AUTHOR
1029
1030 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
1031
1032 =cut