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 ] )
177 # -------------------------------------------------------------------
179 my $translator = shift;
180 local $DEBUG = $translator->debug;
181 local $WARN = $translator->show_warnings;
182 my $no_comments = $translator->no_comments;
183 my $add_drop_table = $translator->add_drop_table;
184 my $schema = $translator->schema;
185 my $pargs = $translator->producer_args;
186 my $postgres_version = parse_dbms_version(
187 $pargs->{postgres_version}, 'perl'
190 my $qt = $translator->quote_table_names ? q{"} : q{};
191 my $qf = $translator->quote_field_names ? q{"} : q{};
194 push @output, header_comment unless ($no_comments);
196 my (@table_defs, @fks);
198 for my $table ( $schema->get_tables ) {
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 type_defs => \%type_defs,
209 push @table_defs, $table_def;
213 for my $view ( $schema->get_views ) {
214 push @table_defs, create_view($view, {
215 postgres_version => $postgres_version,
216 add_drop_view => $add_drop_table,
217 quote_table_names => $qt,
218 quote_field_names => $qf,
219 no_comments => $no_comments,
223 push @output, map { "$_;\n\n" } values %type_defs;
224 push @output, map { "$_;\n\n" } @table_defs;
226 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
227 push @output, map { "$_;\n\n" } @fks;
232 warn "Truncated " . keys( %truncated ) . " names:\n";
233 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
239 : join ('', @output);
242 # -------------------------------------------------------------------
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;
251 ? $max_id_length - (length($type) + 1)
253 $basename = substr( $basename, 0, $max_name )
254 if length( $basename ) > $max_name;
255 my $name = $type ? "${type}_$basename" : $basename;
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;
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;
271 warn "The name '$name_orig' has been changed to ",
272 "'$name' to make it unique.\n" if $WARN;
274 $scope->{ $name_orig }++;
284 return 1 if $field->data_type eq 'geometry';
290 return 1 if $field->data_type eq 'geography';
295 my ($table, $options) = @_;
297 my $qt = $options->{quote_table_names} || '';
298 my $qf = $options->{quote_field_names} || '';
299 my $no_comments = $options->{no_comments} || 0;
300 my $add_drop_table = $options->{add_drop_table} || 0;
301 my $postgres_version = $options->{postgres_version} || 0;
302 my $type_defs = $options->{type_defs} || {};
304 my $table_name = $table->name or next;
305 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
306 my $table_name_ur = $qt ? $table_name
307 : $fql_tbl_name ? join('.', $table_name, $fql_tbl_name)
309 $table->name($table_name_ur);
311 # print STDERR "$table_name table_name\n";
312 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
314 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
316 if ( $table->comments and !$no_comments ){
317 my $c = "-- Comments: \n-- ";
318 $c .= join "\n-- ", $table->comments;
326 my %field_name_scope;
327 for my $field ( $table->get_fields ) {
328 push @field_defs, create_field($field, { quote_table_names => $qt,
329 quote_field_names => $qf,
330 table_name => $table_name_ur,
331 postgres_version => $postgres_version,
332 type_defs => $type_defs,
333 constraint_defs => \@constraint_defs,});
340 # my $idx_name_default;
341 for my $index ( $table->get_indices ) {
342 my ($idef, $constraints) = create_index($index,
344 quote_field_names => $qf,
345 quote_table_names => $qt,
346 table_name => $table_name,
348 $idef and push @index_defs, $idef;
349 push @constraint_defs, @$constraints;
356 for my $c ( $table->get_constraints ) {
357 my ($cdefs, $fks) = create_constraint($c,
359 quote_field_names => $qf,
360 quote_table_names => $qt,
361 table_name => $table_name,
363 push @constraint_defs, @$cdefs;
370 if(exists $table->{extra}{temporary}) {
371 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
374 my $create_statement;
375 $create_statement = join("\n", @comments);
376 if ($add_drop_table) {
377 if ($postgres_version >= 8.002) {
378 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
380 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
383 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
384 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
387 $create_statement .= @index_defs ? ';' : q{};
388 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
389 . join(";\n", @index_defs);
394 if(grep { is_geometry($_) } $table->get_fields){
395 $create_statement .= ";";
396 my @geometry_columns;
397 foreach my $col ($table->get_fields) { push(@geometry_columns,$col) if is_geometry($col); }
398 $create_statement .= "\n".join("\n", map{ drop_geometry_column($_) } @geometry_columns) if $options->{add_drop_table};
399 $create_statement .= "\n".join("\n", map{ add_geometry_column($_) } @geometry_columns);
402 return $create_statement, \@fks;
406 my ($view, $options) = @_;
407 my $qt = $options->{quote_table_names} || '';
408 my $qf = $options->{quote_field_names} || '';
409 my $postgres_version = $options->{postgres_version} || 0;
410 my $add_drop_view = $options->{add_drop_view};
412 my $view_name = $view->name;
413 debug("PKG: Looking at view '${view_name}'\n");
416 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
417 unless $options->{no_comments};
418 if ($add_drop_view) {
419 if ($postgres_version >= 8.002) {
420 $create .= "DROP VIEW IF EXISTS ${qt}${view_name}${qt};\n";
422 $create .= "DROP VIEW ${qt}${view_name}${qt};\n";
427 my $extra = $view->extra;
428 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
429 $create .= " VIEW ${qt}${view_name}${qt}";
431 if ( my @fields = $view->fields ) {
432 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
433 $create .= " ( ${field_list} )";
436 if ( my $sql = $view->sql ) {
437 $create .= " AS\n ${sql}\n";
440 if ( $extra->{check_option} ) {
441 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
449 my %field_name_scope;
453 my ($field, $options) = @_;
455 my $qt = $options->{quote_table_names} || '';
456 my $qf = $options->{quote_field_names} || '';
457 my $table_name = $field->table->name;
458 my $constraint_defs = $options->{constraint_defs} || [];
459 my $postgres_version = $options->{postgres_version} || 0;
460 my $type_defs = $options->{type_defs} || {};
462 $field_name_scope{$table_name} ||= {};
463 my $field_name = $field->name;
464 my $field_comments = $field->comments
465 ? "-- " . $field->comments . "\n "
468 my $field_def = $field_comments.qq[$qf$field_name$qf];
473 my @size = $field->size;
474 my $data_type = lc $field->data_type;
475 my %extra = $field->extra;
476 my $list = $extra{'list'} || [];
477 # todo deal with embedded quotes
478 my $commalist = join( ', ', map { qq['$_'] } @$list );
480 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
481 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
482 $field_def .= ' '. $type_name;
483 my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
484 "CREATE TYPE $type_name AS ENUM ($commalist)";
485 if (! exists $type_defs->{$type_name} ) {
486 $type_defs->{$type_name} = $new_type_def;
487 } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
488 die "Attempted to redefine type name '$type_name' as a different type.\n";
491 $field_def .= ' '. convert_datatype($field);
497 SQL::Translator::Producer->_apply_default_value(
503 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
508 # Not null constraint
510 $field_def .= ' NOT NULL' unless $field->is_nullable;
513 # Geometry constraints
515 if(is_geometry($field)){
516 foreach ( create_geometry_constraints($field) ) {
517 my ($cdefs, $fks) = create_constraint($_,
519 quote_field_names => $qf,
520 quote_table_names => $qt,
521 table_name => $table_name,
523 push @$constraint_defs, @$cdefs;
532 sub create_geometry_constraints{
536 push @constraints, SQL::Translator::Schema::Constraint->new(
537 name => "enforce_dims_".$field->name,
538 expression => "(ST_NDims($field) = ".$field->{extra}{dimensions}.")",
539 table => $field->table,
543 push @constraints, SQL::Translator::Schema::Constraint->new(
544 name => "enforce_srid_".$field->name,
545 expression => "(ST_SRID($field) = ".$field->{extra}{srid}.")",
546 table => $field->table,
549 push @constraints, SQL::Translator::Schema::Constraint->new(
550 name => "enforce_geotype_".$field->name,
551 expression => "(GeometryType($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
552 table => $field->table,
561 my ($index, $options) = @_;
563 my $qt = $options->{quote_table_names} ||'';
564 my $qf = $options->{quote_field_names} ||'';
565 my $table_name = $index->table->name;
567 my ($index_def, @constraint_defs);
571 || join('_', $table_name, 'idx', ++$index_name{ $table_name });
573 my $type = $index->type || NORMAL;
574 my @fields = $index->fields;
577 my $def_start = qq[CONSTRAINT ${qf}$name${qf} ];
578 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
579 if ( $type eq PRIMARY_KEY ) {
580 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
582 elsif ( $type eq UNIQUE ) {
583 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
585 elsif ( $type eq NORMAL ) {
587 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} ".$field_names
591 warn "Unknown index type ($type) on table $table_name.\n"
595 return $index_def, \@constraint_defs;
598 sub create_constraint
600 my ($c, $options) = @_;
602 my $qf = $options->{quote_field_names} ||'';
603 my $qt = $options->{quote_table_names} ||'';
604 my $table_name = $c->table->name;
605 my (@constraint_defs, @fks);
607 my $name = $c->name || '';
609 my @fields = grep { defined } $c->fields;
611 my @rfields = grep { defined } $c->reference_fields;
613 next if !@fields && $c->type ne CHECK_C;
614 my $def_start = $name ? qq[CONSTRAINT ${qf}$name${qf} ] : '';
615 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
616 if ( $c->type eq PRIMARY_KEY ) {
617 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
619 elsif ( $c->type eq UNIQUE ) {
620 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
622 elsif ( $c->type eq CHECK_C ) {
623 my $expression = $c->expression;
624 push @constraint_defs, "${def_start}CHECK ($expression)";
626 elsif ( $c->type eq FOREIGN_KEY ) {
627 my $def .= "ALTER TABLE $qt$table_name$qt ADD ${def_start}FOREIGN KEY $field_names"
628 . "\n REFERENCES " . $qt . $c->reference_table . $qt;
631 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
634 if ( $c->match_type ) {
636 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
639 if ( $c->on_delete ) {
640 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
643 if ( $c->on_update ) {
644 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
647 if ( $c->deferrable ) {
648 $def .= ' DEFERRABLE';
654 return \@constraint_defs, \@fks;
661 my @size = $field->size;
662 my $data_type = lc $field->data_type;
663 my $array = $data_type =~ s/\[\]$//;
665 if ( $data_type eq 'enum' ) {
667 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
668 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
669 # push @$constraint_defs,
670 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
671 # qq[IN ($commalist))];
672 $data_type = 'character varying';
674 elsif ( $data_type eq 'set' ) {
675 $data_type = 'character varying';
677 elsif ( $field->is_auto_increment ) {
678 if ( defined $size[0] && $size[0] > 11 ) {
679 $data_type = 'bigserial';
682 $data_type = 'serial';
687 $data_type = defined $translate{ $data_type } ?
688 $translate{ $data_type } :
692 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
693 if ( defined $size[0] && $size[0] > 6 ) {
698 if ( $data_type eq 'integer' ) {
699 if ( defined $size[0] && $size[0] > 0) {
700 if ( $size[0] > 10 ) {
701 $data_type = 'bigint';
703 elsif ( $size[0] < 5 ) {
704 $data_type = 'smallint';
707 $data_type = 'integer';
711 $data_type = 'integer';
715 my $type_with_size = join('|',
716 'bit', 'varbit', 'character', 'bit varying', 'character varying',
717 'time', 'timestamp', 'interval', 'numeric'
720 if ( $data_type !~ /$type_with_size/ ) {
724 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
725 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
726 $data_type .= $2 if(defined $2);
727 } elsif ( defined $size[0] && $size[0] > 0 ) {
728 $data_type .= '(' . join( ',', @size ) . ')';
738 if($data_type eq 'geography'){
739 $data_type .= '('.$field->{extra}{geography_type}.','. $field->{extra}{srid} .')'
748 my ($from_field, $to_field) = @_;
750 die "Can't alter field in another table"
751 if($from_field->table->name ne $to_field->table->name);
755 # drop geometry column and constraints
756 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
757 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
759 # it's necessary to start with rename column cause this would affect
760 # all of the following statements which would be broken if do the
762 # BUT: drop geometry is done before the rename, cause it work's on the
763 # $from_field directly
764 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
765 $to_field->table->name,
767 $to_field->name) if($from_field->name ne $to_field->name);
770 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
771 $to_field->table->name,
772 $to_field->name) if(!$to_field->is_nullable and
773 $from_field->is_nullable);
775 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
776 $to_field->table->name,
778 if ( !$from_field->is_nullable and $to_field->is_nullable );
781 my $from_dt = convert_datatype($from_field);
782 my $to_dt = convert_datatype($to_field);
783 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
784 $to_field->table->name,
786 $to_dt) if($to_dt ne $from_dt);
788 my $old_default = $from_field->default_value;
789 my $new_default = $to_field->default_value;
790 my $default_value = $to_field->default_value;
792 # fixes bug where output like this was created:
793 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
794 if(ref $default_value eq "SCALAR" ) {
795 $default_value = $$default_value;
796 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
797 $default_value =~ s/'/''/xsmg;
798 $default_value = q(') . $default_value . q(');
801 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
802 $to_field->table->name,
805 if ( defined $new_default &&
806 (!defined $old_default || $old_default ne $new_default) );
808 # fixes bug where removing the DEFAULT statement of a column
809 # would result in no change
811 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
812 $to_field->table->name,
814 if ( !defined $new_default && defined $old_default );
816 # add geometry column and contraints
817 push @out, add_geometry_column($to_field) if is_geometry($to_field);
818 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
820 return wantarray ? @out : join(";\n", @out);
823 sub rename_field { alter_field(@_) }
827 my ($new_field) = @_;
829 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
830 $new_field->table->name,
831 create_field($new_field));
832 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
833 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
840 my ($old_field, $options) = @_;
842 my $qt = $options->{quote_table_names} ||'';
843 my $qf = $options->{quote_field_names} ||'';
845 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
846 $qt . $old_field->table->name . $qt,
847 $qf . $old_field->name . $qf);
848 $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
852 sub add_geometry_column{
853 my ($field,$options) = @_;
855 my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
857 $field->table->schema->name,
858 $options->{table} ? $options->{table} : $field->table->name,
860 $field->{extra}{dimensions},
861 $field->{extra}{srid},
862 $field->{extra}{geometry_type});
866 sub drop_geometry_column
870 my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
871 $field->table->schema->name,
877 sub add_geometry_constraints{
880 my @constraints = create_geometry_constraints($field);
882 my $out = join("\n", map { alter_create_constraint($_); } @constraints);
887 sub drop_geometry_constraints{
890 my @constraints = create_geometry_constraints($field);
892 my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
898 my ($to_table, $options) = @_;
899 my $qt = $options->{quote_table_names} || '';
900 my $out = sprintf('ALTER TABLE %s %s',
901 $qt . $to_table->name . $qt,
902 $options->{alter_table_action});
903 $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
908 my ($old_table, $new_table, $options) = @_;
909 my $qt = $options->{quote_table_names} || '';
910 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
912 my @geometry_changes;
913 push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
914 push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
916 $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
918 return alter_table($old_table, $options);
921 sub alter_create_index {
922 my ($index, $options) = @_;
923 my $qt = $options->{quote_table_names} || '';
924 my $qf = $options->{quote_field_names} || '';
925 my ($idef, $constraints) = create_index($index, {
926 quote_field_names => $qf,
927 quote_table_names => $qt,
928 table_name => $index->table->name,
930 return $index->type eq NORMAL ? $idef
931 : sprintf('ALTER TABLE %s ADD %s',
932 $qt . $index->table->name . $qt,
933 join(q{}, @$constraints)
937 sub alter_drop_index {
938 my ($index, $options) = @_;
939 my $index_name = $index->name;
940 return "DROP INDEX $index_name";
943 sub alter_drop_constraint {
944 my ($c, $options) = @_;
945 my $qt = $options->{quote_table_names} || '';
946 my $qc = $options->{quote_field_names} || '';
949 'ALTER TABLE %s DROP CONSTRAINT %s',
950 $qt . $c->table->name . $qt,
951 # attention: Postgres has a very special naming structure
952 # for naming foreign keys, it names them uses the name of
953 # the table as prefix and fkey as suffix, concatenated by a underscore
954 $c->type eq FOREIGN_KEY
956 ? $qc . $c->name . $qc
957 : $qc . $c->table->name . '_' . ($c->fields)[0] . '_fkey' . $qc
958 : $qc . $c->name . $qc
962 sub alter_create_constraint {
963 my ($index, $options) = @_;
964 my $qt = $options->{quote_table_names} || '';
965 my ($defs, $fks) = create_constraint(@_);
967 # return if there are no constraint definitions so we don't run
968 # into output like this:
969 # ALTER TABLE users ADD ;
971 return unless(@{$defs} || @{$fks});
972 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
973 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
974 'ADD', join(q{}, @{$defs}, @{$fks})
979 my ($table, $options) = @_;
980 my $qt = $options->{quote_table_names} || '';
981 my $out = "DROP TABLE $qt$table$qt CASCADE";
983 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
985 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
991 # -------------------------------------------------------------------
992 # Life is full of misery, loneliness, and suffering --
993 # and it's all over much too soon.
995 # -------------------------------------------------------------------
1001 SQL::Translator, SQL::Translator::Producer::Oracle.
1005 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.