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