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 push @output, map { "$_;\n\n" } values %type_defs;
205 push @output, map { "$_;\n\n" } @table_defs;
207 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
208 push @output, map { "$_;\n\n" } @fks;
213 warn "Truncated " . keys( %truncated ) . " names:\n";
214 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
220 : join ('', @output);
224 my $basename = shift || '';
225 my $type = shift || '';
226 my $scope = shift || '';
227 my $critical = shift || '';
228 my $basename_orig = $basename;
229 # my $max_id_length = 62;
231 ? $max_id_length - (length($type) + 1)
233 $basename = substr( $basename, 0, $max_name )
234 if length( $basename ) > $max_name;
235 my $name = $type ? "${type}_$basename" : $basename;
237 if ( $basename ne $basename_orig and $critical ) {
238 my $show_type = $type ? "+'$type'" : "";
239 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
240 "character limit to make '$name'\n" if $WARN;
241 $truncated{ $basename_orig } = $name;
244 $scope ||= \%global_names;
245 if ( my $prev = $scope->{ $name } ) {
246 my $name_orig = $name;
247 $name .= sprintf( "%02d", ++$prev );
248 substr($name, $max_id_length - 3) = "00"
249 if length( $name ) > $max_id_length;
251 warn "The name '$name_orig' has been changed to ",
252 "'$name' to make it unique.\n" if $WARN;
254 $scope->{ $name_orig }++;
264 return 1 if $field->data_type eq 'geometry';
270 return 1 if $field->data_type eq 'geography';
275 my ($table, $options) = @_;
277 my $qt = $options->{quote_table_names} || '';
278 my $qf = $options->{quote_field_names} || '';
279 my $no_comments = $options->{no_comments} || 0;
280 my $add_drop_table = $options->{add_drop_table} || 0;
281 my $postgres_version = $options->{postgres_version} || 0;
282 my $type_defs = $options->{type_defs} || {};
284 my $table_name = $table->name or next;
285 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
286 my $table_name_ur = $qt ? $table_name
287 : $fql_tbl_name ? join('.', $table_name, $fql_tbl_name)
289 $table->name($table_name_ur);
291 # print STDERR "$table_name table_name\n";
292 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
294 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
296 if ( $table->comments and !$no_comments ){
297 my $c = "-- Comments: \n-- ";
298 $c .= join "\n-- ", $table->comments;
306 my %field_name_scope;
307 for my $field ( $table->get_fields ) {
308 push @field_defs, create_field($field, { quote_table_names => $qt,
309 quote_field_names => $qf,
310 table_name => $table_name_ur,
311 postgres_version => $postgres_version,
312 type_defs => $type_defs,
313 constraint_defs => \@constraint_defs,});
320 # my $idx_name_default;
321 for my $index ( $table->get_indices ) {
322 my ($idef, $constraints) = create_index($index,
324 quote_field_names => $qf,
325 quote_table_names => $qt,
326 table_name => $table_name,
328 $idef and push @index_defs, $idef;
329 push @constraint_defs, @$constraints;
336 for my $c ( $table->get_constraints ) {
337 my ($cdefs, $fks) = create_constraint($c,
339 quote_field_names => $qf,
340 quote_table_names => $qt,
341 table_name => $table_name,
343 push @constraint_defs, @$cdefs;
350 if(exists $table->{extra}{temporary}) {
351 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
354 my $create_statement;
355 $create_statement = join("\n", @comments);
356 if ($add_drop_table) {
357 if ($postgres_version >= 8.002) {
358 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
360 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
363 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
364 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
367 $create_statement .= @index_defs ? ';' : q{};
368 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
369 . join(";\n", @index_defs);
374 if(grep { is_geometry($_) } $table->get_fields){
375 $create_statement .= ";";
376 my @geometry_columns;
377 foreach my $col ($table->get_fields) { push(@geometry_columns,$col) if is_geometry($col); }
378 $create_statement .= "\n".join("\n", map{ drop_geometry_column($_) } @geometry_columns) if $options->{add_drop_table};
379 $create_statement .= "\n".join("\n", map{ add_geometry_column($_) } @geometry_columns);
382 return $create_statement, \@fks;
386 my ($view, $options) = @_;
387 my $qt = $options->{quote_table_names} || '';
388 my $qf = $options->{quote_field_names} || '';
389 my $postgres_version = $options->{postgres_version} || 0;
390 my $add_drop_view = $options->{add_drop_view};
392 my $view_name = $view->name;
393 debug("PKG: Looking at view '${view_name}'\n");
396 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
397 unless $options->{no_comments};
398 if ($add_drop_view) {
399 if ($postgres_version >= 8.002) {
400 $create .= "DROP VIEW IF EXISTS ${qt}${view_name}${qt};\n";
402 $create .= "DROP VIEW ${qt}${view_name}${qt};\n";
407 my $extra = $view->extra;
408 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
409 $create .= " VIEW ${qt}${view_name}${qt}";
411 if ( my @fields = $view->fields ) {
412 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
413 $create .= " ( ${field_list} )";
416 if ( my $sql = $view->sql ) {
417 $create .= " AS\n ${sql}\n";
420 if ( $extra->{check_option} ) {
421 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
429 my %field_name_scope;
433 my ($field, $options) = @_;
435 my $qt = $options->{quote_table_names} || '';
436 my $qf = $options->{quote_field_names} || '';
437 my $table_name = $field->table->name;
438 my $constraint_defs = $options->{constraint_defs} || [];
439 my $postgres_version = $options->{postgres_version} || 0;
440 my $type_defs = $options->{type_defs} || {};
442 $field_name_scope{$table_name} ||= {};
443 my $field_name = $field->name;
444 my $field_comments = $field->comments
445 ? "-- " . $field->comments . "\n "
448 my $field_def = $field_comments.qq[$qf$field_name$qf];
453 my @size = $field->size;
454 my $data_type = lc $field->data_type;
455 my %extra = $field->extra;
456 my $list = $extra{'list'} || [];
457 # todo deal with embedded quotes
458 my $commalist = join( ', ', map { qq['$_'] } @$list );
460 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
461 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
462 $field_def .= ' '. $type_name;
463 my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
464 "CREATE TYPE $type_name AS ENUM ($commalist)";
465 if (! exists $type_defs->{$type_name} ) {
466 $type_defs->{$type_name} = $new_type_def;
467 } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
468 die "Attempted to redefine type name '$type_name' as a different type.\n";
471 $field_def .= ' '. convert_datatype($field);
477 SQL::Translator::Producer->_apply_default_value(
483 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
488 # Not null constraint
490 $field_def .= ' NOT NULL' unless $field->is_nullable;
493 # Geometry constraints
495 if(is_geometry($field)){
496 foreach ( create_geometry_constraints($field) ) {
497 my ($cdefs, $fks) = create_constraint($_,
499 quote_field_names => $qf,
500 quote_table_names => $qt,
501 table_name => $table_name,
503 push @$constraint_defs, @$cdefs;
512 sub create_geometry_constraints{
516 push @constraints, SQL::Translator::Schema::Constraint->new(
517 name => "enforce_dims_".$field->name,
518 expression => "(ST_NDims($field) = ".$field->{extra}{dimensions}.")",
519 table => $field->table,
523 push @constraints, SQL::Translator::Schema::Constraint->new(
524 name => "enforce_srid_".$field->name,
525 expression => "(ST_SRID($field) = ".$field->{extra}{srid}.")",
526 table => $field->table,
529 push @constraints, SQL::Translator::Schema::Constraint->new(
530 name => "enforce_geotype_".$field->name,
531 expression => "(GeometryType($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
532 table => $field->table,
541 my ($index, $options) = @_;
543 my $qt = $options->{quote_table_names} ||'';
544 my $qf = $options->{quote_field_names} ||'';
545 my $table_name = $index->table->name;
547 my ($index_def, @constraint_defs);
551 || join('_', $table_name, 'idx', ++$index_name{ $table_name });
553 my $type = $index->type || NORMAL;
554 my @fields = $index->fields;
557 my $def_start = qq[CONSTRAINT ${qf}$name${qf} ];
558 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
559 if ( $type eq PRIMARY_KEY ) {
560 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
562 elsif ( $type eq UNIQUE ) {
563 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
565 elsif ( $type eq NORMAL ) {
567 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} ".$field_names
571 warn "Unknown index type ($type) on table $table_name.\n"
575 return $index_def, \@constraint_defs;
578 sub create_constraint
580 my ($c, $options) = @_;
582 my $qf = $options->{quote_field_names} ||'';
583 my $qt = $options->{quote_table_names} ||'';
584 my $table_name = $c->table->name;
585 my (@constraint_defs, @fks);
587 my $name = $c->name || '';
589 my @fields = grep { defined } $c->fields;
591 my @rfields = grep { defined } $c->reference_fields;
593 next if !@fields && $c->type ne CHECK_C;
594 my $def_start = $name ? qq[CONSTRAINT ${qf}$name${qf} ] : '';
595 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
596 if ( $c->type eq PRIMARY_KEY ) {
597 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
599 elsif ( $c->type eq UNIQUE ) {
600 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
602 elsif ( $c->type eq CHECK_C ) {
603 my $expression = $c->expression;
604 push @constraint_defs, "${def_start}CHECK ($expression)";
606 elsif ( $c->type eq FOREIGN_KEY ) {
607 my $def .= "ALTER TABLE $qt$table_name$qt ADD ${def_start}FOREIGN KEY $field_names"
608 . "\n REFERENCES " . $qt . $c->reference_table . $qt;
611 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
614 if ( $c->match_type ) {
616 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
619 if ( $c->on_delete ) {
620 $def .= ' ON DELETE '. $c->on_delete;
623 if ( $c->on_update ) {
624 $def .= ' ON UPDATE '. $c->on_update;
627 if ( $c->deferrable ) {
628 $def .= ' DEFERRABLE';
634 return \@constraint_defs, \@fks;
641 my @size = $field->size;
642 my $data_type = lc $field->data_type;
643 my $array = $data_type =~ s/\[\]$//;
645 if ( $data_type eq 'enum' ) {
647 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
648 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
649 # push @$constraint_defs,
650 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
651 # qq[IN ($commalist))];
652 $data_type = 'character varying';
654 elsif ( $data_type eq 'set' ) {
655 $data_type = 'character varying';
657 elsif ( $field->is_auto_increment ) {
658 if ( defined $size[0] && $size[0] > 11 ) {
659 $data_type = 'bigserial';
662 $data_type = 'serial';
667 $data_type = defined $translate{ $data_type } ?
668 $translate{ $data_type } :
672 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
673 if ( defined $size[0] && $size[0] > 6 ) {
678 if ( $data_type eq 'integer' ) {
679 if ( defined $size[0] && $size[0] > 0) {
680 if ( $size[0] > 10 ) {
681 $data_type = 'bigint';
683 elsif ( $size[0] < 5 ) {
684 $data_type = 'smallint';
687 $data_type = 'integer';
691 $data_type = 'integer';
695 my $type_with_size = join('|',
696 'bit', 'varbit', 'character', 'bit varying', 'character varying',
697 'time', 'timestamp', 'interval', 'numeric'
700 if ( $data_type !~ /$type_with_size/ ) {
704 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
705 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
706 $data_type .= $2 if(defined $2);
707 } elsif ( defined $size[0] && $size[0] > 0 ) {
708 $data_type .= '(' . join( ',', @size ) . ')';
718 if($data_type eq 'geography'){
719 $data_type .= '('.$field->{extra}{geography_type}.','. $field->{extra}{srid} .')'
728 my ($from_field, $to_field) = @_;
730 die "Can't alter field in another table"
731 if($from_field->table->name ne $to_field->table->name);
735 # drop geometry column and constraints
736 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
737 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
739 # it's necessary to start with rename column cause this would affect
740 # all of the following statements which would be broken if do the
742 # BUT: drop geometry is done before the rename, cause it work's on the
743 # $from_field directly
744 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
745 $to_field->table->name,
747 $to_field->name) if($from_field->name ne $to_field->name);
749 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
750 $to_field->table->name,
751 $to_field->name) if(!$to_field->is_nullable and
752 $from_field->is_nullable);
754 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
755 $to_field->table->name,
757 if ( !$from_field->is_nullable and $to_field->is_nullable );
760 my $from_dt = convert_datatype($from_field);
761 my $to_dt = convert_datatype($to_field);
762 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
763 $to_field->table->name,
765 $to_dt) if($to_dt ne $from_dt);
767 my $old_default = $from_field->default_value;
768 my $new_default = $to_field->default_value;
769 my $default_value = $to_field->default_value;
771 # fixes bug where output like this was created:
772 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
773 if(ref $default_value eq "SCALAR" ) {
774 $default_value = $$default_value;
775 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
776 $default_value =~ s/'/''/xsmg;
777 $default_value = q(') . $default_value . q(');
780 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
781 $to_field->table->name,
784 if ( defined $new_default &&
785 (!defined $old_default || $old_default ne $new_default) );
787 # fixes bug where removing the DEFAULT statement of a column
788 # would result in no change
790 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
791 $to_field->table->name,
793 if ( !defined $new_default && defined $old_default );
795 # add geometry column and contraints
796 push @out, add_geometry_column($to_field) if is_geometry($to_field);
797 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
799 return wantarray ? @out : join(";\n", @out);
802 sub rename_field { alter_field(@_) }
806 my ($new_field) = @_;
808 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
809 $new_field->table->name,
810 create_field($new_field));
811 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
812 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
819 my ($old_field, $options) = @_;
821 my $qt = $options->{quote_table_names} ||'';
822 my $qf = $options->{quote_field_names} ||'';
824 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
825 $qt . $old_field->table->name . $qt,
826 $qf . $old_field->name . $qf);
827 $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
831 sub add_geometry_column{
832 my ($field,$options) = @_;
834 my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
836 $field->table->schema->name,
837 $options->{table} ? $options->{table} : $field->table->name,
839 $field->{extra}{dimensions},
840 $field->{extra}{srid},
841 $field->{extra}{geometry_type});
845 sub drop_geometry_column
849 my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
850 $field->table->schema->name,
856 sub add_geometry_constraints{
859 my @constraints = create_geometry_constraints($field);
861 my $out = join("\n", map { alter_create_constraint($_); } @constraints);
866 sub drop_geometry_constraints{
869 my @constraints = create_geometry_constraints($field);
871 my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
877 my ($to_table, $options) = @_;
878 my $qt = $options->{quote_table_names} || '';
879 my $out = sprintf('ALTER TABLE %s %s',
880 $qt . $to_table->name . $qt,
881 $options->{alter_table_action});
882 $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
887 my ($old_table, $new_table, $options) = @_;
888 my $qt = $options->{quote_table_names} || '';
889 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
891 my @geometry_changes;
892 push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
893 push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
895 $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
897 return alter_table($old_table, $options);
900 sub alter_create_index {
901 my ($index, $options) = @_;
902 my $qt = $options->{quote_table_names} || '';
903 my $qf = $options->{quote_field_names} || '';
904 my ($idef, $constraints) = create_index($index, {
905 quote_field_names => $qf,
906 quote_table_names => $qt,
907 table_name => $index->table->name,
909 return $index->type eq NORMAL ? $idef
910 : sprintf('ALTER TABLE %s ADD %s',
911 $qt . $index->table->name . $qt,
912 join(q{}, @$constraints)
916 sub alter_drop_index {
917 my ($index, $options) = @_;
918 my $index_name = $index->name;
919 return "DROP INDEX $index_name";
922 sub alter_drop_constraint {
923 my ($c, $options) = @_;
924 my $qt = $options->{quote_table_names} || '';
925 my $qc = $options->{quote_field_names} || '';
928 'ALTER TABLE %s DROP CONSTRAINT %s',
929 $qt . $c->table->name . $qt,
930 # attention: Postgres has a very special naming structure
931 # for naming foreign keys, it names them uses the name of
932 # the table as prefix and fkey as suffix, concatenated by a underscore
933 $c->type eq FOREIGN_KEY
935 ? $qc . $c->name . $qc
936 : $qc . $c->table->name . '_' . ($c->fields)[0] . '_fkey' . $qc
937 : $qc . $c->name . $qc
941 sub alter_create_constraint {
942 my ($index, $options) = @_;
943 my $qt = $options->{quote_table_names} || '';
944 my ($defs, $fks) = create_constraint(@_);
946 # return if there are no constraint definitions so we don't run
947 # into output like this:
948 # ALTER TABLE users ADD ;
950 return unless(@{$defs} || @{$fks});
951 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
952 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
953 'ADD', join(q{}, @{$defs}, @{$fks})
958 my ($table, $options) = @_;
959 my $qt = $options->{quote_table_names} || '';
960 my $out = "DROP TABLE $qt$table$qt CASCADE";
962 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
964 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
970 # -------------------------------------------------------------------
971 # Life is full of misery, loneliness, and suffering --
972 # and it's all over much too soon.
974 # -------------------------------------------------------------------
980 SQL::Translator, SQL::Translator::Producer::Oracle.
984 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.