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 %used_names ];
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 }++;
281 # -------------------------------------------------------------------
282 sub next_unused_name {
283 my $orig_name = shift or return;
284 my $name = $orig_name;
286 my $suffix_gen = sub {
288 return ++$suffix ? '' : $suffix;
292 $name = $orig_name . $suffix_gen->();
293 last if $used_names{ $name }++;
302 return 1 if $field->data_type eq 'geometry';
308 return 1 if $field->data_type eq 'geography';
313 my ($table, $options) = @_;
315 my $qt = $options->{quote_table_names} || '';
316 my $qf = $options->{quote_field_names} || '';
317 my $no_comments = $options->{no_comments} || 0;
318 my $add_drop_table = $options->{add_drop_table} || 0;
319 my $postgres_version = $options->{postgres_version} || 0;
320 my $type_defs = $options->{type_defs} || {};
322 my $table_name = $table->name or next;
323 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
324 my $table_name_ur = $qt ? $table_name
325 : $fql_tbl_name ? join('.', $table_name, $fql_tbl_name)
327 $table->name($table_name_ur);
329 # print STDERR "$table_name table_name\n";
330 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
332 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
334 if ( $table->comments and !$no_comments ){
335 my $c = "-- Comments: \n-- ";
336 $c .= join "\n-- ", $table->comments;
344 my %field_name_scope;
345 for my $field ( $table->get_fields ) {
346 push @field_defs, create_field($field, { quote_table_names => $qt,
347 quote_field_names => $qf,
348 table_name => $table_name_ur,
349 postgres_version => $postgres_version,
350 type_defs => $type_defs,
351 constraint_defs => \@constraint_defs,});
358 # my $idx_name_default;
359 for my $index ( $table->get_indices ) {
360 my ($idef, $constraints) = create_index($index,
362 quote_field_names => $qf,
363 quote_table_names => $qt,
364 table_name => $table_name,
366 $idef and push @index_defs, $idef;
367 push @constraint_defs, @$constraints;
374 for my $c ( $table->get_constraints ) {
375 my ($cdefs, $fks) = create_constraint($c,
377 quote_field_names => $qf,
378 quote_table_names => $qt,
379 table_name => $table_name,
381 push @constraint_defs, @$cdefs;
388 if(exists $table->{extra}{temporary}) {
389 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
392 my $create_statement;
393 $create_statement = join("\n", @comments);
394 if ($add_drop_table) {
395 if ($postgres_version >= 8.002) {
396 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
398 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
401 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
402 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
405 $create_statement .= @index_defs ? ';' : q{};
406 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
407 . join(";\n", @index_defs);
412 if(grep { is_geometry($_) } $table->get_fields){
413 $create_statement .= ";";
414 my @geometry_columns;
415 foreach my $col ($table->get_fields) { push(@geometry_columns,$col) if is_geometry($col); }
416 $create_statement .= "\n".join("\n", map{ drop_geometry_column($_) } @geometry_columns) if $options->{add_drop_table};
417 $create_statement .= "\n".join("\n", map{ add_geometry_column($_) } @geometry_columns);
420 return $create_statement, \@fks;
424 my ($view, $options) = @_;
425 my $qt = $options->{quote_table_names} || '';
426 my $qf = $options->{quote_field_names} || '';
427 my $postgres_version = $options->{postgres_version} || 0;
428 my $add_drop_view = $options->{add_drop_view};
430 my $view_name = $view->name;
431 debug("PKG: Looking at view '${view_name}'\n");
434 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
435 unless $options->{no_comments};
436 if ($add_drop_view) {
437 if ($postgres_version >= 8.002) {
438 $create .= "DROP VIEW IF EXISTS ${qt}${view_name}${qt};\n";
440 $create .= "DROP VIEW ${qt}${view_name}${qt};\n";
445 my $extra = $view->extra;
446 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
447 $create .= " VIEW ${qt}${view_name}${qt}";
449 if ( my @fields = $view->fields ) {
450 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
451 $create .= " ( ${field_list} )";
454 if ( my $sql = $view->sql ) {
455 $create .= " AS\n ${sql}\n";
458 if ( $extra->{check_option} ) {
459 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
467 my %field_name_scope;
471 my ($field, $options) = @_;
473 my $qt = $options->{quote_table_names} || '';
474 my $qf = $options->{quote_field_names} || '';
475 my $table_name = $field->table->name;
476 my $constraint_defs = $options->{constraint_defs} || [];
477 my $postgres_version = $options->{postgres_version} || 0;
478 my $type_defs = $options->{type_defs} || {};
480 $field_name_scope{$table_name} ||= {};
481 my $field_name = $field->name;
482 my $field_comments = $field->comments
483 ? "-- " . $field->comments . "\n "
486 my $field_def = $field_comments.qq[$qf$field_name$qf];
491 my @size = $field->size;
492 my $data_type = lc $field->data_type;
493 my %extra = $field->extra;
494 my $list = $extra{'list'} || [];
495 # todo deal with embedded quotes
496 my $commalist = join( ', ', map { qq['$_'] } @$list );
498 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
499 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
500 $field_def .= ' '. $type_name;
501 my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
502 "CREATE TYPE $type_name AS ENUM ($commalist)";
503 if (! exists $type_defs->{$type_name} ) {
504 $type_defs->{$type_name} = $new_type_def;
505 } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
506 die "Attempted to redefine type name '$type_name' as a different type.\n";
509 $field_def .= ' '. convert_datatype($field);
515 SQL::Translator::Producer->_apply_default_value(
521 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
526 # Not null constraint
528 $field_def .= ' NOT NULL' unless $field->is_nullable;
531 # Geometry constraints
533 if(is_geometry($field)){
534 foreach ( create_geometry_constraints($field) ) {
535 my ($cdefs, $fks) = create_constraint($_,
537 quote_field_names => $qf,
538 quote_table_names => $qt,
539 table_name => $table_name,
541 push @$constraint_defs, @$cdefs;
550 sub create_geometry_constraints{
554 push @constraints, SQL::Translator::Schema::Constraint->new(
555 name => "enforce_dims_".$field->name,
556 expression => "(ST_NDims($field) = ".$field->{extra}{dimensions}.")",
557 table => $field->table,
561 push @constraints, SQL::Translator::Schema::Constraint->new(
562 name => "enforce_srid_".$field->name,
563 expression => "(ST_SRID($field) = ".$field->{extra}{srid}.")",
564 table => $field->table,
567 push @constraints, SQL::Translator::Schema::Constraint->new(
568 name => "enforce_geotype_".$field->name,
569 expression => "(GeometryType($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
570 table => $field->table,
579 my ($index, $options) = @_;
581 my $qt = $options->{quote_table_names} ||'';
582 my $qf = $options->{quote_field_names} ||'';
583 my $table_name = $index->table->name;
585 my ($index_def, @constraint_defs);
587 my $name = next_unused_name(
589 || join('_', $table_name, 'idx', ++$index_name{ $table_name })
592 my $type = $index->type || NORMAL;
593 my @fields = $index->fields;
596 my $def_start = qq[CONSTRAINT ${qf}$name${qf} ];
597 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
598 if ( $type eq PRIMARY_KEY ) {
599 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
601 elsif ( $type eq UNIQUE ) {
602 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
604 elsif ( $type eq NORMAL ) {
606 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} ".$field_names
610 warn "Unknown index type ($type) on table $table_name.\n"
614 return $index_def, \@constraint_defs;
617 sub create_constraint
619 my ($c, $options) = @_;
621 my $qf = $options->{quote_field_names} ||'';
622 my $qt = $options->{quote_table_names} ||'';
623 my $table_name = $c->table->name;
624 my (@constraint_defs, @fks);
626 my $name = $c->name || '';
628 $name = next_unused_name($name);
631 my @fields = grep { defined } $c->fields;
633 my @rfields = grep { defined } $c->reference_fields;
635 next if !@fields && $c->type ne CHECK_C;
636 my $def_start = $name ? qq[CONSTRAINT ${qf}$name${qf} ] : '';
637 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
638 if ( $c->type eq PRIMARY_KEY ) {
639 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
641 elsif ( $c->type eq UNIQUE ) {
642 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
644 elsif ( $c->type eq CHECK_C ) {
645 my $expression = $c->expression;
646 push @constraint_defs, "${def_start}CHECK ($expression)";
648 elsif ( $c->type eq FOREIGN_KEY ) {
649 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY " . $field_names .
650 "\n REFERENCES " . $qt . $c->reference_table . $qt;
653 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
656 if ( $c->match_type ) {
658 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
661 if ( $c->on_delete ) {
662 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
665 if ( $c->on_update ) {
666 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
669 if ( $c->deferrable ) {
670 $def .= ' DEFERRABLE';
676 return \@constraint_defs, \@fks;
683 my @size = $field->size;
684 my $data_type = lc $field->data_type;
685 my $array = $data_type =~ s/\[\]$//;
687 if ( $data_type eq 'enum' ) {
689 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
690 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
691 # push @$constraint_defs,
692 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
693 # qq[IN ($commalist))];
694 $data_type = 'character varying';
696 elsif ( $data_type eq 'set' ) {
697 $data_type = 'character varying';
699 elsif ( $field->is_auto_increment ) {
700 if ( defined $size[0] && $size[0] > 11 ) {
701 $data_type = 'bigserial';
704 $data_type = 'serial';
709 $data_type = defined $translate{ $data_type } ?
710 $translate{ $data_type } :
714 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
715 if ( defined $size[0] && $size[0] > 6 ) {
720 if ( $data_type eq 'integer' ) {
721 if ( defined $size[0] && $size[0] > 0) {
722 if ( $size[0] > 10 ) {
723 $data_type = 'bigint';
725 elsif ( $size[0] < 5 ) {
726 $data_type = 'smallint';
729 $data_type = 'integer';
733 $data_type = 'integer';
737 my $type_with_size = join('|',
738 'bit', 'varbit', 'character', 'bit varying', 'character varying',
739 'time', 'timestamp', 'interval', 'numeric'
742 if ( $data_type !~ /$type_with_size/ ) {
746 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
747 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
748 $data_type .= $2 if(defined $2);
749 } elsif ( defined $size[0] && $size[0] > 0 ) {
750 $data_type .= '(' . join( ',', @size ) . ')';
760 if($data_type eq 'geography'){
761 $data_type .= '('.$field->{extra}{geography_type}.','. $field->{extra}{srid} .')'
770 my ($from_field, $to_field) = @_;
772 die "Can't alter field in another table"
773 if($from_field->table->name ne $to_field->table->name);
777 # drop geometry column and constraints
778 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
779 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
781 # it's necessary to start with rename column cause this would affect
782 # all of the following statements which would be broken if do the
784 # BUT: drop geometry is done before the rename, cause it work's on the
785 # $from_field directly
786 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
787 $to_field->table->name,
789 $to_field->name) if($from_field->name ne $to_field->name);
792 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
793 $to_field->table->name,
794 $to_field->name) if(!$to_field->is_nullable and
795 $from_field->is_nullable);
797 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
798 $to_field->table->name,
800 if ( !$from_field->is_nullable and $to_field->is_nullable );
803 my $from_dt = convert_datatype($from_field);
804 my $to_dt = convert_datatype($to_field);
805 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
806 $to_field->table->name,
808 $to_dt) if($to_dt ne $from_dt);
810 my $old_default = $from_field->default_value;
811 my $new_default = $to_field->default_value;
812 my $default_value = $to_field->default_value;
814 # fixes bug where output like this was created:
815 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
816 if(ref $default_value eq "SCALAR" ) {
817 $default_value = $$default_value;
818 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
819 $default_value =~ s/'/''/xsmg;
820 $default_value = q(') . $default_value . q(');
823 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
824 $to_field->table->name,
827 if ( defined $new_default &&
828 (!defined $old_default || $old_default ne $new_default) );
830 # fixes bug where removing the DEFAULT statement of a column
831 # would result in no change
833 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
834 $to_field->table->name,
836 if ( !defined $new_default && defined $old_default );
838 # add geometry column and contraints
839 push @out, add_geometry_column($to_field) if is_geometry($to_field);
840 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
842 return wantarray ? @out : join(";\n", @out);
845 sub rename_field { alter_field(@_) }
849 my ($new_field) = @_;
851 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
852 $new_field->table->name,
853 create_field($new_field));
854 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
855 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
862 my ($old_field, $options) = @_;
864 my $qt = $options->{quote_table_names} ||'';
865 my $qf = $options->{quote_field_names} ||'';
867 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
868 $qt . $old_field->table->name . $qt,
869 $qf . $old_field->name . $qf);
870 $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
874 sub add_geometry_column{
875 my ($field,$options) = @_;
877 my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
879 $field->table->schema->name,
880 $options->{table} ? $options->{table} : $field->table->name,
882 $field->{extra}{dimensions},
883 $field->{extra}{srid},
884 $field->{extra}{geometry_type});
888 sub drop_geometry_column
892 my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
893 $field->table->schema->name,
899 sub add_geometry_constraints{
902 my @constraints = create_geometry_constraints($field);
904 my $out = join("\n", map { alter_create_constraint($_); } @constraints);
909 sub drop_geometry_constraints{
912 my @constraints = create_geometry_constraints($field);
914 my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
920 my ($to_table, $options) = @_;
921 my $qt = $options->{quote_table_names} || '';
922 my $out = sprintf('ALTER TABLE %s %s',
923 $qt . $to_table->name . $qt,
924 $options->{alter_table_action});
925 $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
930 my ($old_table, $new_table, $options) = @_;
931 my $qt = $options->{quote_table_names} || '';
932 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
934 my @geometry_changes;
935 push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
936 push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
938 $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
940 return alter_table($old_table, $options);
943 sub alter_create_index {
944 my ($index, $options) = @_;
945 my $qt = $options->{quote_table_names} || '';
946 my $qf = $options->{quote_field_names} || '';
947 my ($idef, $constraints) = create_index($index, {
948 quote_field_names => $qf,
949 quote_table_names => $qt,
950 table_name => $index->table->name,
952 return $index->type eq NORMAL ? $idef
953 : sprintf('ALTER TABLE %s ADD %s',
954 $qt . $index->table->name . $qt,
955 join(q{}, @$constraints)
959 sub alter_drop_index {
960 my ($index, $options) = @_;
961 my $index_name = $index->name;
962 return "DROP INDEX $index_name";
965 sub alter_drop_constraint {
966 my ($c, $options) = @_;
967 my $qt = $options->{quote_table_names} || '';
968 my $qc = $options->{quote_field_names} || '';
971 'ALTER TABLE %s DROP CONSTRAINT %s',
972 $qt . $c->table->name . $qt,
973 # attention: Postgres has a very special naming structure
974 # for naming foreign keys, it names them uses the name of
975 # the table as prefix and fkey as suffix, concatenated by a underscore
976 $c->type eq FOREIGN_KEY
977 ? $qc . $c->table->name . '_' . ($c->fields)[0] . '_fkey' . $qc
978 : $qc . $c->name . $qc
982 sub alter_create_constraint {
983 my ($index, $options) = @_;
984 my $qt = $options->{quote_table_names} || '';
985 my ($defs, $fks) = create_constraint(@_);
987 # return if there are no constraint definitions so we don't run
988 # into output like this:
989 # ALTER TABLE users ADD ;
991 return unless(@{$defs} || @{$fks});
992 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
993 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
994 'ADD', join(q{}, @{$defs}, @{$fks})
999 my ($table, $options) = @_;
1000 my $qt = $options->{quote_table_names} || '';
1001 my $out = "DROP TABLE $qt$table$qt CASCADE";
1003 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
1005 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
1011 # -------------------------------------------------------------------
1012 # Life is full of misery, loneliness, and suffering --
1013 # and it's all over much too soon.
1015 # -------------------------------------------------------------------
1021 SQL::Translator, SQL::Translator::Producer::Oracle.
1025 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.