1 package SQL::Translator::Producer::PostgreSQL;
3 # -------------------------------------------------------------------
4 # Copyright (C) 2002-2009 SQLFairy Authors
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License as
8 # published by the Free Software Foundation; version 2.
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
19 # -------------------------------------------------------------------
23 SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator
27 my $t = SQL::Translator->new( parser => '...', producer => 'PostgreSQL' );
32 Creates a DDL suitable for PostgreSQL. Very heavily based on the Oracle
35 Now handles PostGIS Geometry and Geography data types on table definitions.
36 Does not yet support PostGIS Views.
42 use vars qw[ $DEBUG $WARN $VERSION ];
44 $DEBUG = 0 unless defined $DEBUG;
46 use base qw(SQL::Translator::Producer);
47 use SQL::Translator::Schema::Constants;
48 use SQL::Translator::Utils qw(debug header_comment parse_dbms_version);
51 my ( %translate, %index_name );
65 mediumint => 'integer',
66 smallint => 'smallint',
67 tinyint => 'smallint',
69 varchar => 'character varying',
76 mediumblob => 'bytea',
78 enum => 'character varying',
79 set => 'character varying',
81 datetime => 'timestamp',
83 timestamp => 'timestamp',
91 varchar2 => 'character varying',
101 varchar => 'character varying',
102 datetime => 'timestamp',
107 tinyint => 'smallint',
113 my %reserved = map { $_, 1 } qw[
114 ALL ANALYSE ANALYZE AND ANY AS ASC
116 CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
117 CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
118 DEFAULT DEFERRABLE DESC DISTINCT DO
120 FALSE FOR FOREIGN FREEZE FROM FULL
122 ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
123 JOIN LEADING LEFT LIKE LIMIT
124 NATURAL NEW NOT NOTNULL NULL
125 OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
126 PRIMARY PUBLIC REFERENCES RIGHT
127 SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
128 UNION UNIQUE USER USING VERBOSE WHEN WHERE
131 # my $max_id_length = 62;
132 my %used_identifiers = ();
138 =head1 PostgreSQL Create Table Syntax
140 CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
141 { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
142 | table_constraint } [, ... ]
144 [ INHERITS ( parent_table [, ... ] ) ]
145 [ WITH OIDS | WITHOUT OIDS ]
147 where column_constraint is:
149 [ CONSTRAINT constraint_name ]
150 { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
152 REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
153 [ ON DELETE action ] [ ON UPDATE action ] }
154 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
156 and table_constraint is:
158 [ CONSTRAINT constraint_name ]
159 { UNIQUE ( column_name [, ... ] ) |
160 PRIMARY KEY ( column_name [, ... ] ) |
161 CHECK ( expression ) |
162 FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
163 [ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
164 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
166 =head1 Create Index Syntax
168 CREATE [ UNIQUE ] INDEX index_name ON table
169 [ USING acc_method ] ( column [ ops_name ] [, ...] )
171 CREATE [ UNIQUE ] INDEX index_name ON table
172 [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
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 my $postgres_version = parse_dbms_version(
186 $pargs->{postgres_version}, 'perl'
189 my $qt = $translator->quote_table_names ? q{"} : q{};
190 my $qf = $translator->quote_field_names ? q{"} : q{};
193 push @output, header_comment unless ($no_comments);
195 my (@table_defs, @fks);
197 for my $table ( $schema->get_tables ) {
199 my ($table_def, $fks) = create_table($table, {
200 quote_table_names => $qt,
201 quote_field_names => $qf,
202 no_comments => $no_comments,
203 postgres_version => $postgres_version,
204 add_drop_table => $add_drop_table,
205 type_defs => \%type_defs,
208 push @table_defs, $table_def;
212 for my $view ( $schema->get_views ) {
213 push @table_defs, create_view($view, {
214 postgres_version => $postgres_version,
215 add_drop_view => $add_drop_table,
216 quote_table_names => $qt,
217 quote_field_names => $qf,
218 no_comments => $no_comments,
222 push @output, map { "$_;\n\n" } values %type_defs;
223 push @output, map { "$_;\n\n" } @table_defs;
225 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
226 push @output, map { "$_;\n\n" } @fks;
231 warn "Truncated " . keys( %truncated ) . " names:\n";
232 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
238 : join ('', @output);
242 my $basename = shift || '';
243 my $type = shift || '';
244 my $scope = shift || '';
245 my $critical = shift || '';
246 my $basename_orig = $basename;
247 # my $max_id_length = 62;
249 ? $max_id_length - (length($type) + 1)
251 $basename = substr( $basename, 0, $max_name )
252 if length( $basename ) > $max_name;
253 my $name = $type ? "${type}_$basename" : $basename;
255 if ( $basename ne $basename_orig and $critical ) {
256 my $show_type = $type ? "+'$type'" : "";
257 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
258 "character limit to make '$name'\n" if $WARN;
259 $truncated{ $basename_orig } = $name;
262 $scope ||= \%global_names;
263 if ( my $prev = $scope->{ $name } ) {
264 my $name_orig = $name;
265 $name .= sprintf( "%02d", ++$prev );
266 substr($name, $max_id_length - 3) = "00"
267 if length( $name ) > $max_id_length;
269 warn "The name '$name_orig' has been changed to ",
270 "'$name' to make it unique.\n" if $WARN;
272 $scope->{ $name_orig }++;
282 return 1 if $field->data_type eq 'geometry';
288 return 1 if $field->data_type eq 'geography';
293 my ($table, $options) = @_;
295 my $qt = $options->{quote_table_names} || '';
296 my $qf = $options->{quote_field_names} || '';
297 my $no_comments = $options->{no_comments} || 0;
298 my $add_drop_table = $options->{add_drop_table} || 0;
299 my $postgres_version = $options->{postgres_version} || 0;
300 my $type_defs = $options->{type_defs} || {};
302 my $table_name = $table->name or next;
303 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
304 my $table_name_ur = $qt ? $table_name
305 : $fql_tbl_name ? join('.', $table_name, $fql_tbl_name)
307 $table->name($table_name_ur);
309 # print STDERR "$table_name table_name\n";
310 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
312 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
314 if ( $table->comments and !$no_comments ){
315 my $c = "-- Comments: \n-- ";
316 $c .= join "\n-- ", $table->comments;
324 my %field_name_scope;
325 for my $field ( $table->get_fields ) {
326 push @field_defs, create_field($field, { quote_table_names => $qt,
327 quote_field_names => $qf,
328 table_name => $table_name_ur,
329 postgres_version => $postgres_version,
330 type_defs => $type_defs,
331 constraint_defs => \@constraint_defs,});
338 # my $idx_name_default;
339 for my $index ( $table->get_indices ) {
340 my ($idef, $constraints) = create_index($index,
342 quote_field_names => $qf,
343 quote_table_names => $qt,
344 table_name => $table_name,
346 $idef and push @index_defs, $idef;
347 push @constraint_defs, @$constraints;
354 for my $c ( $table->get_constraints ) {
355 my ($cdefs, $fks) = create_constraint($c,
357 quote_field_names => $qf,
358 quote_table_names => $qt,
359 table_name => $table_name,
361 push @constraint_defs, @$cdefs;
368 if(exists $table->{extra}{temporary}) {
369 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
372 my $create_statement;
373 $create_statement = join("\n", @comments);
374 if ($add_drop_table) {
375 if ($postgres_version >= 8.002) {
376 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
378 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
381 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
382 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
385 $create_statement .= @index_defs ? ';' : q{};
386 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
387 . join(";\n", @index_defs);
392 if(grep { is_geometry($_) } $table->get_fields){
393 $create_statement .= ";";
394 my @geometry_columns;
395 foreach my $col ($table->get_fields) { push(@geometry_columns,$col) if is_geometry($col); }
396 $create_statement .= "\n".join("\n", map{ drop_geometry_column($_) } @geometry_columns) if $options->{add_drop_table};
397 $create_statement .= "\n".join("\n", map{ add_geometry_column($_) } @geometry_columns);
400 return $create_statement, \@fks;
404 my ($view, $options) = @_;
405 my $qt = $options->{quote_table_names} || '';
406 my $qf = $options->{quote_field_names} || '';
407 my $postgres_version = $options->{postgres_version} || 0;
408 my $add_drop_view = $options->{add_drop_view};
410 my $view_name = $view->name;
411 debug("PKG: Looking at view '${view_name}'\n");
414 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
415 unless $options->{no_comments};
416 if ($add_drop_view) {
417 if ($postgres_version >= 8.002) {
418 $create .= "DROP VIEW IF EXISTS ${qt}${view_name}${qt};\n";
420 $create .= "DROP VIEW ${qt}${view_name}${qt};\n";
425 my $extra = $view->extra;
426 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
427 $create .= " VIEW ${qt}${view_name}${qt}";
429 if ( my @fields = $view->fields ) {
430 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
431 $create .= " ( ${field_list} )";
434 if ( my $sql = $view->sql ) {
435 $create .= " AS\n ${sql}\n";
438 if ( $extra->{check_option} ) {
439 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
447 my %field_name_scope;
451 my ($field, $options) = @_;
453 my $qt = $options->{quote_table_names} || '';
454 my $qf = $options->{quote_field_names} || '';
455 my $table_name = $field->table->name;
456 my $constraint_defs = $options->{constraint_defs} || [];
457 my $postgres_version = $options->{postgres_version} || 0;
458 my $type_defs = $options->{type_defs} || {};
460 $field_name_scope{$table_name} ||= {};
461 my $field_name = $field->name;
462 my $field_comments = $field->comments
463 ? "-- " . $field->comments . "\n "
466 my $field_def = $field_comments.qq[$qf$field_name$qf];
471 my @size = $field->size;
472 my $data_type = lc $field->data_type;
473 my %extra = $field->extra;
474 my $list = $extra{'list'} || [];
475 # todo deal with embedded quotes
476 my $commalist = join( ', ', map { qq['$_'] } @$list );
478 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
479 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
480 $field_def .= ' '. $type_name;
481 my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
482 "CREATE TYPE $type_name AS ENUM ($commalist)";
483 if (! exists $type_defs->{$type_name} ) {
484 $type_defs->{$type_name} = $new_type_def;
485 } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
486 die "Attempted to redefine type name '$type_name' as a different type.\n";
489 $field_def .= ' '. convert_datatype($field);
495 SQL::Translator::Producer->_apply_default_value(
501 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
506 # Not null constraint
508 $field_def .= ' NOT NULL' unless $field->is_nullable;
511 # Geometry constraints
513 if(is_geometry($field)){
514 foreach ( create_geometry_constraints($field) ) {
515 my ($cdefs, $fks) = create_constraint($_,
517 quote_field_names => $qf,
518 quote_table_names => $qt,
519 table_name => $table_name,
521 push @$constraint_defs, @$cdefs;
530 sub create_geometry_constraints{
534 push @constraints, SQL::Translator::Schema::Constraint->new(
535 name => "enforce_dims_".$field->name,
536 expression => "(ST_NDims($field) = ".$field->{extra}{dimensions}.")",
537 table => $field->table,
541 push @constraints, SQL::Translator::Schema::Constraint->new(
542 name => "enforce_srid_".$field->name,
543 expression => "(ST_SRID($field) = ".$field->{extra}{srid}.")",
544 table => $field->table,
547 push @constraints, SQL::Translator::Schema::Constraint->new(
548 name => "enforce_geotype_".$field->name,
549 expression => "(GeometryType($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
550 table => $field->table,
559 my ($index, $options) = @_;
561 my $qt = $options->{quote_table_names} ||'';
562 my $qf = $options->{quote_field_names} ||'';
563 my $table_name = $index->table->name;
565 my ($index_def, @constraint_defs);
569 || join('_', $table_name, 'idx', ++$index_name{ $table_name });
571 my $type = $index->type || NORMAL;
572 my @fields = $index->fields;
575 my $def_start = qq[CONSTRAINT ${qf}$name${qf} ];
576 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
577 if ( $type eq PRIMARY_KEY ) {
578 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
580 elsif ( $type eq UNIQUE ) {
581 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
583 elsif ( $type eq NORMAL ) {
585 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} ".$field_names
589 warn "Unknown index type ($type) on table $table_name.\n"
593 return $index_def, \@constraint_defs;
596 sub create_constraint
598 my ($c, $options) = @_;
600 my $qf = $options->{quote_field_names} ||'';
601 my $qt = $options->{quote_table_names} ||'';
602 my $table_name = $c->table->name;
603 my (@constraint_defs, @fks);
605 my $name = $c->name || '';
607 my @fields = grep { defined } $c->fields;
609 my @rfields = grep { defined } $c->reference_fields;
611 next if !@fields && $c->type ne CHECK_C;
612 my $def_start = $name ? qq[CONSTRAINT ${qf}$name${qf} ] : '';
613 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
614 if ( $c->type eq PRIMARY_KEY ) {
615 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
617 elsif ( $c->type eq UNIQUE ) {
618 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
620 elsif ( $c->type eq CHECK_C ) {
621 my $expression = $c->expression;
622 push @constraint_defs, "${def_start}CHECK ($expression)";
624 elsif ( $c->type eq FOREIGN_KEY ) {
625 my $def .= "ALTER TABLE $qt$table_name$qt ADD ${def_start}FOREIGN KEY $field_names"
626 . "\n REFERENCES " . $qt . $c->reference_table . $qt;
629 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
632 if ( $c->match_type ) {
634 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
637 if ( $c->on_delete ) {
638 $def .= ' ON DELETE '. $c->on_delete;
641 if ( $c->on_update ) {
642 $def .= ' ON UPDATE '. $c->on_update;
645 if ( $c->deferrable ) {
646 $def .= ' DEFERRABLE';
652 return \@constraint_defs, \@fks;
659 my @size = $field->size;
660 my $data_type = lc $field->data_type;
661 my $array = $data_type =~ s/\[\]$//;
663 if ( $data_type eq 'enum' ) {
665 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
666 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
667 # push @$constraint_defs,
668 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
669 # qq[IN ($commalist))];
670 $data_type = 'character varying';
672 elsif ( $data_type eq 'set' ) {
673 $data_type = 'character varying';
675 elsif ( $field->is_auto_increment ) {
676 if ( defined $size[0] && $size[0] > 11 ) {
677 $data_type = 'bigserial';
680 $data_type = 'serial';
685 $data_type = defined $translate{ $data_type } ?
686 $translate{ $data_type } :
690 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
691 if ( defined $size[0] && $size[0] > 6 ) {
696 if ( $data_type eq 'integer' ) {
697 if ( defined $size[0] && $size[0] > 0) {
698 if ( $size[0] > 10 ) {
699 $data_type = 'bigint';
701 elsif ( $size[0] < 5 ) {
702 $data_type = 'smallint';
705 $data_type = 'integer';
709 $data_type = 'integer';
713 my $type_with_size = join('|',
714 'bit', 'varbit', 'character', 'bit varying', 'character varying',
715 'time', 'timestamp', 'interval', 'numeric'
718 if ( $data_type !~ /$type_with_size/ ) {
722 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
723 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
724 $data_type .= $2 if(defined $2);
725 } elsif ( defined $size[0] && $size[0] > 0 ) {
726 $data_type .= '(' . join( ',', @size ) . ')';
736 if($data_type eq 'geography'){
737 $data_type .= '('.$field->{extra}{geography_type}.','. $field->{extra}{srid} .')'
746 my ($from_field, $to_field) = @_;
748 die "Can't alter field in another table"
749 if($from_field->table->name ne $to_field->table->name);
753 # drop geometry column and constraints
754 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
755 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
757 # it's necessary to start with rename column cause this would affect
758 # all of the following statements which would be broken if do the
760 # BUT: drop geometry is done before the rename, cause it work's on the
761 # $from_field directly
762 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
763 $to_field->table->name,
765 $to_field->name) if($from_field->name ne $to_field->name);
767 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
768 $to_field->table->name,
769 $to_field->name) if(!$to_field->is_nullable and
770 $from_field->is_nullable);
772 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
773 $to_field->table->name,
775 if ( !$from_field->is_nullable and $to_field->is_nullable );
778 my $from_dt = convert_datatype($from_field);
779 my $to_dt = convert_datatype($to_field);
780 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
781 $to_field->table->name,
783 $to_dt) if($to_dt ne $from_dt);
785 my $old_default = $from_field->default_value;
786 my $new_default = $to_field->default_value;
787 my $default_value = $to_field->default_value;
789 # fixes bug where output like this was created:
790 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
791 if(ref $default_value eq "SCALAR" ) {
792 $default_value = $$default_value;
793 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
794 $default_value =~ s/'/''/xsmg;
795 $default_value = q(') . $default_value . q(');
798 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
799 $to_field->table->name,
802 if ( defined $new_default &&
803 (!defined $old_default || $old_default ne $new_default) );
805 # fixes bug where removing the DEFAULT statement of a column
806 # would result in no change
808 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
809 $to_field->table->name,
811 if ( !defined $new_default && defined $old_default );
813 # add geometry column and contraints
814 push @out, add_geometry_column($to_field) if is_geometry($to_field);
815 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
817 return wantarray ? @out : join(";\n", @out);
820 sub rename_field { alter_field(@_) }
824 my ($new_field) = @_;
826 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
827 $new_field->table->name,
828 create_field($new_field));
829 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
830 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
837 my ($old_field, $options) = @_;
839 my $qt = $options->{quote_table_names} ||'';
840 my $qf = $options->{quote_field_names} ||'';
842 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
843 $qt . $old_field->table->name . $qt,
844 $qf . $old_field->name . $qf);
845 $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
849 sub add_geometry_column{
850 my ($field,$options) = @_;
852 my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
854 $field->table->schema->name,
855 $options->{table} ? $options->{table} : $field->table->name,
857 $field->{extra}{dimensions},
858 $field->{extra}{srid},
859 $field->{extra}{geometry_type});
863 sub drop_geometry_column
867 my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
868 $field->table->schema->name,
874 sub add_geometry_constraints{
877 my @constraints = create_geometry_constraints($field);
879 my $out = join("\n", map { alter_create_constraint($_); } @constraints);
884 sub drop_geometry_constraints{
887 my @constraints = create_geometry_constraints($field);
889 my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
895 my ($to_table, $options) = @_;
896 my $qt = $options->{quote_table_names} || '';
897 my $out = sprintf('ALTER TABLE %s %s',
898 $qt . $to_table->name . $qt,
899 $options->{alter_table_action});
900 $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
905 my ($old_table, $new_table, $options) = @_;
906 my $qt = $options->{quote_table_names} || '';
907 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
909 my @geometry_changes;
910 push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
911 push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
913 $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
915 return alter_table($old_table, $options);
918 sub alter_create_index {
919 my ($index, $options) = @_;
920 my $qt = $options->{quote_table_names} || '';
921 my $qf = $options->{quote_field_names} || '';
922 my ($idef, $constraints) = create_index($index, {
923 quote_field_names => $qf,
924 quote_table_names => $qt,
925 table_name => $index->table->name,
927 return $index->type eq NORMAL ? $idef
928 : sprintf('ALTER TABLE %s ADD %s',
929 $qt . $index->table->name . $qt,
930 join(q{}, @$constraints)
934 sub alter_drop_index {
935 my ($index, $options) = @_;
936 my $index_name = $index->name;
937 return "DROP INDEX $index_name";
940 sub alter_drop_constraint {
941 my ($c, $options) = @_;
942 my $qt = $options->{quote_table_names} || '';
943 my $qc = $options->{quote_field_names} || '';
946 'ALTER TABLE %s DROP CONSTRAINT %s',
947 $qt . $c->table->name . $qt,
948 # attention: Postgres has a very special naming structure
949 # for naming foreign keys, it names them uses the name of
950 # the table as prefix and fkey as suffix, concatenated by a underscore
951 $c->type eq FOREIGN_KEY
953 ? $qc . $c->name . $qc
954 : $qc . $c->table->name . '_' . ($c->fields)[0] . '_fkey' . $qc
955 : $qc . $c->name . $qc
959 sub alter_create_constraint {
960 my ($index, $options) = @_;
961 my $qt = $options->{quote_table_names} || '';
962 my ($defs, $fks) = create_constraint(@_);
964 # return if there are no constraint definitions so we don't run
965 # into output like this:
966 # ALTER TABLE users ADD ;
968 return unless(@{$defs} || @{$fks});
969 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
970 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
971 'ADD', join(q{}, @{$defs}, @{$fks})
976 my ($table, $options) = @_;
977 my $qt = $options->{quote_table_names} || '';
978 my $out = "DROP TABLE $qt$table$qt CASCADE";
980 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
982 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
988 # -------------------------------------------------------------------
989 # Life is full of misery, loneliness, and suffering --
990 # and it's all over much too soon.
992 # -------------------------------------------------------------------
998 SQL::Translator, SQL::Translator::Producer::Oracle.
1002 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.