1 package SQL::Translator::Producer::PostgreSQL;
5 SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator
9 my $t = SQL::Translator->new( parser => '...', producer => 'PostgreSQL' );
14 Creates a DDL suitable for PostgreSQL. Very heavily based on the Oracle
17 Now handles PostGIS Geometry and Geography data types on table definitions.
18 Does not yet support PostGIS Views.
24 our ( $DEBUG, $WARN );
25 our $VERSION = '1.59';
26 $DEBUG = 0 unless defined $DEBUG;
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);
33 my ( %translate, %index_name );
47 mediumint => 'integer',
48 smallint => 'smallint',
49 tinyint => 'smallint',
51 varchar => 'character varying',
58 mediumblob => 'bytea',
60 enum => 'character varying',
61 set => 'character varying',
63 datetime => 'timestamp',
65 timestamp => 'timestamp',
73 varchar2 => 'character varying',
83 varchar => 'character varying',
84 datetime => 'timestamp',
89 tinyint => 'smallint',
95 my %reserved = map { $_, 1 } qw[
96 ALL ANALYSE ANALYZE AND ANY AS ASC
98 CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
99 CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
100 DEFAULT DEFERRABLE DESC DISTINCT DO
102 FALSE FOR FOREIGN FREEZE FROM FULL
104 ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
105 JOIN LEADING LEFT LIKE LIMIT
106 NATURAL NEW NOT NOTNULL NULL
107 OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
108 PRIMARY PUBLIC REFERENCES RIGHT
109 SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
110 UNION UNIQUE USER USING VERBOSE WHEN WHERE
113 # my $max_id_length = 62;
114 my %used_identifiers = ();
120 =head1 PostgreSQL Create Table Syntax
122 CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
123 { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
124 | table_constraint } [, ... ]
126 [ INHERITS ( parent_table [, ... ] ) ]
127 [ WITH OIDS | WITHOUT OIDS ]
129 where column_constraint is:
131 [ CONSTRAINT constraint_name ]
132 { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
134 REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
135 [ ON DELETE action ] [ ON UPDATE action ] }
136 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
138 and table_constraint is:
140 [ CONSTRAINT constraint_name ]
141 { UNIQUE ( column_name [, ... ] ) |
142 PRIMARY KEY ( column_name [, ... ] ) |
143 CHECK ( expression ) |
144 FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
145 [ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
146 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
148 =head1 Create Index Syntax
150 CREATE [ UNIQUE ] INDEX index_name ON table
151 [ USING acc_method ] ( column [ ops_name ] [, ...] )
153 CREATE [ UNIQUE ] INDEX index_name ON table
154 [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
160 my $translator = shift;
161 local $DEBUG = $translator->debug;
162 local $WARN = $translator->show_warnings;
163 my $no_comments = $translator->no_comments;
164 my $add_drop_table = $translator->add_drop_table;
165 my $schema = $translator->schema;
166 my $pargs = $translator->producer_args;
167 my $postgres_version = parse_dbms_version(
168 $pargs->{postgres_version}, 'perl'
171 my $qt = $translator->quote_table_names ? q{"} : q{};
172 my $qf = $translator->quote_field_names ? q{"} : q{};
175 push @output, header_comment unless ($no_comments);
177 my (@table_defs, @fks);
179 for my $table ( $schema->get_tables ) {
181 my ($table_def, $fks) = create_table($table, {
182 quote_table_names => $qt,
183 quote_field_names => $qf,
184 no_comments => $no_comments,
185 postgres_version => $postgres_version,
186 add_drop_table => $add_drop_table,
187 type_defs => \%type_defs,
190 push @table_defs, $table_def;
194 for my $view ( $schema->get_views ) {
195 push @table_defs, create_view($view, {
196 postgres_version => $postgres_version,
197 add_drop_view => $add_drop_table,
198 quote_table_names => $qt,
199 quote_field_names => $qf,
200 no_comments => $no_comments,
204 for my $trigger ( $schema->get_triggers ) {
205 push @table_defs, create_trigger( $trigger, {
206 add_drop_trigger => $add_drop_table,
207 no_comments => $no_comments,
211 push @output, map { "$_;\n\n" } values %type_defs;
212 push @output, map { "$_;\n\n" } @table_defs;
214 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
215 push @output, map { "$_;\n\n" } @fks;
220 warn "Truncated " . keys( %truncated ) . " names:\n";
221 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
227 : join ('', @output);
231 my $basename = shift || '';
232 my $type = shift || '';
233 my $scope = shift || '';
234 my $critical = shift || '';
235 my $basename_orig = $basename;
236 # my $max_id_length = 62;
238 ? $max_id_length - (length($type) + 1)
240 $basename = substr( $basename, 0, $max_name )
241 if length( $basename ) > $max_name;
242 my $name = $type ? "${type}_$basename" : $basename;
244 if ( $basename ne $basename_orig and $critical ) {
245 my $show_type = $type ? "+'$type'" : "";
246 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
247 "character limit to make '$name'\n" if $WARN;
248 $truncated{ $basename_orig } = $name;
251 $scope ||= \%global_names;
252 if ( my $prev = $scope->{ $name } ) {
253 my $name_orig = $name;
254 $name .= sprintf( "%02d", ++$prev );
255 substr($name, $max_id_length - 3) = "00"
256 if length( $name ) > $max_id_length;
258 warn "The name '$name_orig' has been changed to ",
259 "'$name' to make it unique.\n" if $WARN;
261 $scope->{ $name_orig }++;
271 return 1 if $field->data_type eq 'geometry';
277 return 1 if $field->data_type eq 'geography';
282 my ($table, $options) = @_;
284 my $qt = $options->{quote_table_names} || '';
285 my $qf = $options->{quote_field_names} || '';
286 my $no_comments = $options->{no_comments} || 0;
287 my $add_drop_table = $options->{add_drop_table} || 0;
288 my $postgres_version = $options->{postgres_version} || 0;
289 my $type_defs = $options->{type_defs} || {};
291 my $table_name = $table->name or next;
292 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
293 my $table_name_ur = $qt ? $table_name
294 : $fql_tbl_name ? join('.', $table_name, $fql_tbl_name)
296 $table->name($table_name_ur);
298 # print STDERR "$table_name table_name\n";
299 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
301 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
303 if ( $table->comments and !$no_comments ){
304 my $c = "-- Comments: \n-- ";
305 $c .= join "\n-- ", $table->comments;
313 my %field_name_scope;
314 for my $field ( $table->get_fields ) {
315 push @field_defs, create_field($field, { quote_table_names => $qt,
316 quote_field_names => $qf,
317 table_name => $table_name_ur,
318 postgres_version => $postgres_version,
319 type_defs => $type_defs,
320 constraint_defs => \@constraint_defs,});
327 # my $idx_name_default;
328 for my $index ( $table->get_indices ) {
329 my ($idef, $constraints) = create_index($index,
331 quote_field_names => $qf,
332 quote_table_names => $qt,
333 table_name => $table_name,
335 $idef and push @index_defs, $idef;
336 push @constraint_defs, @$constraints;
343 for my $c ( $table->get_constraints ) {
344 my ($cdefs, $fks) = create_constraint($c,
346 quote_field_names => $qf,
347 quote_table_names => $qt,
348 table_name => $table_name,
350 push @constraint_defs, @$cdefs;
357 if(exists $table->{extra}{temporary}) {
358 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
361 my $create_statement;
362 $create_statement = join("\n", @comments);
363 if ($add_drop_table) {
364 if ($postgres_version >= 8.002) {
365 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
367 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
370 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
371 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
374 $create_statement .= @index_defs ? ';' : q{};
375 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
376 . join(";\n", @index_defs);
381 if(grep { is_geometry($_) } $table->get_fields){
382 $create_statement .= ";";
383 my @geometry_columns;
384 foreach my $col ($table->get_fields) { push(@geometry_columns,$col) if is_geometry($col); }
385 $create_statement .= "\n".join("\n", map{ drop_geometry_column($_) } @geometry_columns) if $options->{add_drop_table};
386 $create_statement .= "\n".join("\n", map{ add_geometry_column($_) } @geometry_columns);
389 return $create_statement, \@fks;
393 my ($view, $options) = @_;
394 my $qt = $options->{quote_table_names} || '';
395 my $qf = $options->{quote_field_names} || '';
396 my $postgres_version = $options->{postgres_version} || 0;
397 my $add_drop_view = $options->{add_drop_view};
399 my $view_name = $view->name;
400 debug("PKG: Looking at view '${view_name}'\n");
403 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
404 unless $options->{no_comments};
405 if ($add_drop_view) {
406 if ($postgres_version >= 8.002) {
407 $create .= "DROP VIEW IF EXISTS ${qt}${view_name}${qt};\n";
409 $create .= "DROP VIEW ${qt}${view_name}${qt};\n";
414 my $extra = $view->extra;
415 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
416 $create .= " VIEW ${qt}${view_name}${qt}";
418 if ( my @fields = $view->fields ) {
419 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
420 $create .= " ( ${field_list} )";
423 if ( my $sql = $view->sql ) {
424 $create .= " AS\n ${sql}\n";
427 if ( $extra->{check_option} ) {
428 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
436 my %field_name_scope;
440 my ($field, $options) = @_;
442 my $qt = $options->{quote_table_names} || '';
443 my $qf = $options->{quote_field_names} || '';
444 my $table_name = $field->table->name;
445 my $constraint_defs = $options->{constraint_defs} || [];
446 my $postgres_version = $options->{postgres_version} || 0;
447 my $type_defs = $options->{type_defs} || {};
449 $field_name_scope{$table_name} ||= {};
450 my $field_name = $field->name;
451 my $field_comments = $field->comments
452 ? "-- " . $field->comments . "\n "
455 my $field_def = $field_comments.qq[$qf$field_name$qf];
460 my @size = $field->size;
461 my $data_type = lc $field->data_type;
462 my %extra = $field->extra;
463 my $list = $extra{'list'} || [];
464 # todo deal with embedded quotes
465 my $commalist = join( ', ', map { qq['$_'] } @$list );
467 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
468 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
469 $field_def .= ' '. $type_name;
470 my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
471 "CREATE TYPE $type_name AS ENUM ($commalist)";
472 if (! exists $type_defs->{$type_name} ) {
473 $type_defs->{$type_name} = $new_type_def;
474 } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
475 die "Attempted to redefine type name '$type_name' as a different type.\n";
478 $field_def .= ' '. convert_datatype($field);
484 SQL::Translator::Producer->_apply_default_value(
490 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
495 # Not null constraint
497 $field_def .= ' NOT NULL' unless $field->is_nullable;
500 # Geometry constraints
502 if(is_geometry($field)){
503 foreach ( create_geometry_constraints($field) ) {
504 my ($cdefs, $fks) = create_constraint($_,
506 quote_field_names => $qf,
507 quote_table_names => $qt,
508 table_name => $table_name,
510 push @$constraint_defs, @$cdefs;
519 sub create_geometry_constraints{
523 push @constraints, SQL::Translator::Schema::Constraint->new(
524 name => "enforce_dims_".$field->name,
525 expression => "(ST_NDims($field) = ".$field->{extra}{dimensions}.")",
526 table => $field->table,
530 push @constraints, SQL::Translator::Schema::Constraint->new(
531 name => "enforce_srid_".$field->name,
532 expression => "(ST_SRID($field) = ".$field->{extra}{srid}.")",
533 table => $field->table,
536 push @constraints, SQL::Translator::Schema::Constraint->new(
537 name => "enforce_geotype_".$field->name,
538 expression => "(GeometryType($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
539 table => $field->table,
548 my ($index, $options) = @_;
550 my $qt = $options->{quote_table_names} ||'';
551 my $qf = $options->{quote_field_names} ||'';
552 my $table_name = $index->table->name;
554 my ($index_def, @constraint_defs);
558 || join('_', $table_name, 'idx', ++$index_name{ $table_name });
560 my $type = $index->type || NORMAL;
561 my @fields = $index->fields;
562 return unless @fields;
564 my $def_start = qq[CONSTRAINT ${qf}$name${qf} ];
565 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
566 if ( $type eq PRIMARY_KEY ) {
567 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
569 elsif ( $type eq UNIQUE ) {
570 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
572 elsif ( $type eq NORMAL ) {
574 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} ".$field_names
578 warn "Unknown index type ($type) on table $table_name.\n"
582 return $index_def, \@constraint_defs;
585 sub create_constraint
587 my ($c, $options) = @_;
589 my $qf = $options->{quote_field_names} ||'';
590 my $qt = $options->{quote_table_names} ||'';
591 my $table_name = $c->table->name;
592 my (@constraint_defs, @fks);
594 my $name = $c->name || '';
596 my @fields = grep { defined } $c->fields;
598 my @rfields = grep { defined } $c->reference_fields;
600 next if !@fields && $c->type ne CHECK_C;
601 my $def_start = $name ? qq[CONSTRAINT ${qf}$name${qf} ] : '';
602 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
603 if ( $c->type eq PRIMARY_KEY ) {
604 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
606 elsif ( $c->type eq UNIQUE ) {
607 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
609 elsif ( $c->type eq CHECK_C ) {
610 my $expression = $c->expression;
611 push @constraint_defs, "${def_start}CHECK ($expression)";
613 elsif ( $c->type eq FOREIGN_KEY ) {
614 my $def .= "ALTER TABLE $qt$table_name$qt ADD ${def_start}FOREIGN KEY $field_names"
615 . "\n REFERENCES " . $qt . $c->reference_table . $qt;
618 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
621 if ( $c->match_type ) {
623 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
626 if ( $c->on_delete ) {
627 $def .= ' ON DELETE '. $c->on_delete;
630 if ( $c->on_update ) {
631 $def .= ' ON UPDATE '. $c->on_update;
634 if ( $c->deferrable ) {
635 $def .= ' DEFERRABLE';
641 return \@constraint_defs, \@fks;
645 my ($trigger,$options) = @_;
649 push @statements, sprintf( 'DROP TRIGGER IF EXISTS %s', $trigger->name )
650 if $options->{add_drop_trigger};
652 my $scope = $trigger->scope || '';
653 $scope = " FOR EACH $scope" if $scope;
655 push @statements, sprintf(
656 'CREATE TRIGGER %s %s %s ON %s%s %s',
658 $trigger->perform_action_when,
659 join( ' OR ', @{ $trigger->database_events } ),
672 my @size = $field->size;
673 my $data_type = lc $field->data_type;
674 my $array = $data_type =~ s/\[\]$//;
676 if ( $data_type eq 'enum' ) {
678 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
679 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
680 # push @$constraint_defs,
681 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
682 # qq[IN ($commalist))];
683 $data_type = 'character varying';
685 elsif ( $data_type eq 'set' ) {
686 $data_type = 'character varying';
688 elsif ( $field->is_auto_increment ) {
689 if ( defined $size[0] && $size[0] > 11 ) {
690 $data_type = 'bigserial';
693 $data_type = 'serial';
698 $data_type = defined $translate{ $data_type } ?
699 $translate{ $data_type } :
703 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
704 if ( defined $size[0] && $size[0] > 6 ) {
709 if ( $data_type eq 'integer' ) {
710 if ( defined $size[0] && $size[0] > 0) {
711 if ( $size[0] > 10 ) {
712 $data_type = 'bigint';
714 elsif ( $size[0] < 5 ) {
715 $data_type = 'smallint';
718 $data_type = 'integer';
722 $data_type = 'integer';
726 my $type_with_size = join('|',
727 'bit', 'varbit', 'character', 'bit varying', 'character varying',
728 'time', 'timestamp', 'interval', 'numeric'
731 if ( $data_type !~ /$type_with_size/ ) {
735 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
736 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
737 $data_type .= $2 if(defined $2);
738 } elsif ( defined $size[0] && $size[0] > 0 ) {
739 $data_type .= '(' . join( ',', @size ) . ')';
749 if($data_type eq 'geography'){
750 $data_type .= '('.$field->{extra}{geography_type}.','. $field->{extra}{srid} .')'
759 my ($from_field, $to_field) = @_;
761 die "Can't alter field in another table"
762 if($from_field->table->name ne $to_field->table->name);
766 # drop geometry column and constraints
767 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
768 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
770 # it's necessary to start with rename column cause this would affect
771 # all of the following statements which would be broken if do the
773 # BUT: drop geometry is done before the rename, cause it work's on the
774 # $from_field directly
775 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
776 $to_field->table->name,
778 $to_field->name) if($from_field->name ne $to_field->name);
780 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
781 $to_field->table->name,
782 $to_field->name) if(!$to_field->is_nullable and
783 $from_field->is_nullable);
785 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
786 $to_field->table->name,
788 if ( !$from_field->is_nullable and $to_field->is_nullable );
791 my $from_dt = convert_datatype($from_field);
792 my $to_dt = convert_datatype($to_field);
793 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
794 $to_field->table->name,
796 $to_dt) if($to_dt ne $from_dt);
798 my $old_default = $from_field->default_value;
799 my $new_default = $to_field->default_value;
800 my $default_value = $to_field->default_value;
802 # fixes bug where output like this was created:
803 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
804 if(ref $default_value eq "SCALAR" ) {
805 $default_value = $$default_value;
806 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
807 $default_value =~ s/'/''/xsmg;
808 $default_value = q(') . $default_value . q(');
811 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
812 $to_field->table->name,
815 if ( defined $new_default &&
816 (!defined $old_default || $old_default ne $new_default) );
818 # fixes bug where removing the DEFAULT statement of a column
819 # would result in no change
821 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
822 $to_field->table->name,
824 if ( !defined $new_default && defined $old_default );
826 # add geometry column and contraints
827 push @out, add_geometry_column($to_field) if is_geometry($to_field);
828 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
830 return wantarray ? @out : join(";\n", @out);
833 sub rename_field { alter_field(@_) }
837 my ($new_field) = @_;
839 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
840 $new_field->table->name,
841 create_field($new_field));
842 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
843 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
850 my ($old_field, $options) = @_;
852 my $qt = $options->{quote_table_names} ||'';
853 my $qf = $options->{quote_field_names} ||'';
855 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
856 $qt . $old_field->table->name . $qt,
857 $qf . $old_field->name . $qf);
858 $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
862 sub add_geometry_column{
863 my ($field,$options) = @_;
865 my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
867 $field->table->schema->name,
868 $options->{table} ? $options->{table} : $field->table->name,
870 $field->{extra}{dimensions},
871 $field->{extra}{srid},
872 $field->{extra}{geometry_type});
876 sub drop_geometry_column
880 my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
881 $field->table->schema->name,
887 sub add_geometry_constraints{
890 my @constraints = create_geometry_constraints($field);
892 my $out = join("\n", map { alter_create_constraint($_); } @constraints);
897 sub drop_geometry_constraints{
900 my @constraints = create_geometry_constraints($field);
902 my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
908 my ($to_table, $options) = @_;
909 my $qt = $options->{quote_table_names} || '';
910 my $out = sprintf('ALTER TABLE %s %s',
911 $qt . $to_table->name . $qt,
912 $options->{alter_table_action});
913 $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
918 my ($old_table, $new_table, $options) = @_;
919 my $qt = $options->{quote_table_names} || '';
920 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
922 my @geometry_changes;
923 push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
924 push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
926 $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
928 return alter_table($old_table, $options);
931 sub alter_create_index {
932 my ($index, $options) = @_;
933 my $qt = $options->{quote_table_names} || '';
934 my $qf = $options->{quote_field_names} || '';
935 my ($idef, $constraints) = create_index($index, {
936 quote_field_names => $qf,
937 quote_table_names => $qt,
938 table_name => $index->table->name,
940 return $index->type eq NORMAL ? $idef
941 : sprintf('ALTER TABLE %s ADD %s',
942 $qt . $index->table->name . $qt,
943 join(q{}, @$constraints)
947 sub alter_drop_index {
948 my ($index, $options) = @_;
949 my $index_name = $index->name;
950 return "DROP INDEX $index_name";
953 sub alter_drop_constraint {
954 my ($c, $options) = @_;
955 my $qt = $options->{quote_table_names} || '';
956 my $qc = $options->{quote_field_names} || '';
959 'ALTER TABLE %s DROP CONSTRAINT %s',
960 $qt . $c->table->name . $qt,
961 # attention: Postgres has a very special naming structure
962 # for naming foreign keys, it names them uses the name of
963 # the table as prefix and fkey as suffix, concatenated by a underscore
964 $c->type eq FOREIGN_KEY
966 ? $qc . $c->name . $qc
967 : $qc . $c->table->name . '_' . ($c->fields)[0] . '_fkey' . $qc
968 : $qc . $c->name . $qc
972 sub alter_create_constraint {
973 my ($index, $options) = @_;
974 my $qt = $options->{quote_table_names} || '';
975 my ($defs, $fks) = create_constraint(@_);
977 # return if there are no constraint definitions so we don't run
978 # into output like this:
979 # ALTER TABLE users ADD ;
981 return unless(@{$defs} || @{$fks});
982 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
983 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
984 'ADD', join(q{}, @{$defs}, @{$fks})
989 my ($table, $options) = @_;
990 my $qt = $options->{quote_table_names} || '';
991 my $out = "DROP TABLE $qt$table$qt CASCADE";
993 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
995 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
1001 # -------------------------------------------------------------------
1002 # Life is full of misery, loneliness, and suffering --
1003 # and it's all over much too soon.
1005 # -------------------------------------------------------------------
1011 SQL::Translator, SQL::Translator::Producer::Oracle.
1015 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.