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 = ();
139 =head1 PostgreSQL Create Table Syntax
141 CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
142 { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
143 | table_constraint } [, ... ]
145 [ INHERITS ( parent_table [, ... ] ) ]
146 [ WITH OIDS | WITHOUT OIDS ]
148 where column_constraint is:
150 [ CONSTRAINT constraint_name ]
151 { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
153 REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
154 [ ON DELETE action ] [ ON UPDATE action ] }
155 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
157 and table_constraint is:
159 [ CONSTRAINT constraint_name ]
160 { UNIQUE ( column_name [, ... ] ) |
161 PRIMARY KEY ( column_name [, ... ] ) |
162 CHECK ( expression ) |
163 FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
164 [ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
165 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
167 =head1 Create Index Syntax
169 CREATE [ UNIQUE ] INDEX index_name ON table
170 [ USING acc_method ] ( column [ ops_name ] [, ...] )
172 CREATE [ UNIQUE ] INDEX index_name ON table
173 [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
178 # -------------------------------------------------------------------
180 my $translator = shift;
181 local $DEBUG = $translator->debug;
182 local $WARN = $translator->show_warnings;
183 my $no_comments = $translator->no_comments;
184 my $add_drop_table = $translator->add_drop_table;
185 my $schema = $translator->schema;
186 my $pargs = $translator->producer_args;
187 my $postgres_version = parse_dbms_version(
188 $pargs->{postgres_version}, 'perl'
191 my $qt = $translator->quote_table_names ? q{"} : q{};
192 my $qf = $translator->quote_field_names ? q{"} : q{};
195 push @output, header_comment unless ($no_comments);
197 my (@table_defs, @fks);
199 for my $table ( $schema->get_tables ) {
201 my ($table_def, $fks) = create_table($table, {
202 quote_table_names => $qt,
203 quote_field_names => $qf,
204 no_comments => $no_comments,
205 postgres_version => $postgres_version,
206 add_drop_table => $add_drop_table,
207 type_defs => \%type_defs,
210 push @table_defs, $table_def;
214 for my $view ( $schema->get_views ) {
215 push @table_defs, create_view($view, {
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";
237 warn "Encounted " . keys( %unreserve ) .
238 " unsafe names in schema (reserved or invalid):\n";
239 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
245 : join ('', @output);
248 # -------------------------------------------------------------------
250 my $basename = shift || '';
251 my $type = shift || '';
252 my $scope = shift || '';
253 my $critical = shift || '';
254 my $basename_orig = $basename;
255 # my $max_id_length = 62;
257 ? $max_id_length - (length($type) + 1)
259 $basename = substr( $basename, 0, $max_name )
260 if length( $basename ) > $max_name;
261 my $name = $type ? "${type}_$basename" : $basename;
263 if ( $basename ne $basename_orig and $critical ) {
264 my $show_type = $type ? "+'$type'" : "";
265 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
266 "character limit to make '$name'\n" if $WARN;
267 $truncated{ $basename_orig } = $name;
270 $scope ||= \%global_names;
271 if ( my $prev = $scope->{ $name } ) {
272 my $name_orig = $name;
273 $name .= sprintf( "%02d", ++$prev );
274 substr($name, $max_id_length - 3) = "00"
275 if length( $name ) > $max_id_length;
277 warn "The name '$name_orig' has been changed to ",
278 "'$name' to make it unique.\n" if $WARN;
280 $scope->{ $name_orig }++;
287 # -------------------------------------------------------------------
289 my $name = shift || '';
290 my $schema_obj_name = shift || '';
292 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
294 # also trap fields that don't begin with a letter
295 return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
297 if ( $schema_obj_name ) {
298 ++$unreserve{"$schema_obj_name.$name"};
301 ++$unreserve{"$name (table name)"};
304 my $unreserve = sprintf '%s_', $name;
305 return $unreserve.$suffix;
308 # -------------------------------------------------------------------
309 sub next_unused_name {
310 my $orig_name = shift or return;
311 my $name = $orig_name;
313 my $suffix_gen = sub {
315 return ++$suffix ? '' : $suffix;
319 $name = $orig_name . $suffix_gen->();
320 last if $used_names{ $name }++;
329 return 1 if $field->data_type eq 'geometry' || $field->data_type eq 'geography';
334 my ($table, $options) = @_;
336 my $qt = $options->{quote_table_names} || '';
337 my $qf = $options->{quote_field_names} || '';
338 my $no_comments = $options->{no_comments} || 0;
339 my $add_drop_table = $options->{add_drop_table} || 0;
340 my $postgres_version = $options->{postgres_version} || 0;
341 my $type_defs = $options->{type_defs} || {};
343 my $table_name = $table->name or next;
344 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
345 my $table_name_ur = $qt ? $table_name
346 : $fql_tbl_name ? join('.', $table_name, unreserve($fql_tbl_name))
347 : unreserve($table_name);
348 $table->name($table_name_ur);
350 # print STDERR "$table_name table_name\n";
351 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
353 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
355 if ( $table->comments and !$no_comments ){
356 my $c = "-- Comments: \n-- ";
357 $c .= join "\n-- ", $table->comments;
365 my %field_name_scope;
366 for my $field ( $table->get_fields ) {
367 push @field_defs, create_field($field, { quote_table_names => $qt,
368 quote_field_names => $qf,
369 table_name => $table_name_ur,
370 postgres_version => $postgres_version,
371 type_defs => $type_defs,
372 constraint_defs => \@constraint_defs,});
379 # my $idx_name_default;
380 for my $index ( $table->get_indices ) {
381 my ($idef, $constraints) = create_index($index,
383 quote_field_names => $qf,
384 quote_table_names => $qt,
385 table_name => $table_name,
387 $idef and push @index_defs, $idef;
388 push @constraint_defs, @$constraints;
395 for my $c ( $table->get_constraints ) {
396 my ($cdefs, $fks) = create_constraint($c,
398 quote_field_names => $qf,
399 quote_table_names => $qt,
400 table_name => $table_name,
402 push @constraint_defs, @$cdefs;
409 if(exists $table->{extra}{temporary}) {
410 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
413 my $create_statement;
414 $create_statement = join("\n", @comments);
415 if ($add_drop_table) {
416 if ($postgres_version >= 8.002) {
417 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
419 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
422 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
423 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
426 $create_statement .= @index_defs ? ';' : q{};
427 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
428 . join(";\n", @index_defs);
433 if(grep { is_geometry($_) } $table->get_fields){
434 $create_statement .= ";";
435 $create_statement .= "\n".join("\n", map { drop_geometry_column($_) if is_geometry($_); } $table->get_fields) if $options->{add_drop_table};
436 $create_statement .= "\n".join("\n", map { add_geometry_column($_) if is_geometry($_);} $table->get_fields);
439 return $create_statement, \@fks;
443 my ($view, $options) = @_;
444 my $qt = $options->{quote_table_names} || '';
445 my $qf = $options->{quote_field_names} || '';
446 my $add_drop_view = $options->{add_drop_view};
448 my $view_name = $view->name;
449 debug("PKG: Looking at view '${view_name}'\n");
452 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
453 unless $options->{no_comments};
454 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
457 my $extra = $view->extra;
458 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
459 $create .= " VIEW ${qt}${view_name}${qt}";
461 if ( my @fields = $view->fields ) {
462 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
463 $create .= " ( ${field_list} )";
466 if ( my $sql = $view->sql ) {
467 $create .= " AS\n ${sql}\n";
470 if ( $extra->{check_option} ) {
471 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
479 my %field_name_scope;
483 my ($field, $options) = @_;
485 my $qt = $options->{quote_table_names} || '';
486 my $qf = $options->{quote_field_names} || '';
487 my $table_name = $field->table->name;
488 my $constraint_defs = $options->{constraint_defs} || [];
489 my $postgres_version = $options->{postgres_version} || 0;
490 my $type_defs = $options->{type_defs} || {};
492 $field_name_scope{$table_name} ||= {};
493 my $field_name = $field->name;
494 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
495 $field->name($field_name_ur);
496 my $field_comments = $field->comments
497 ? "-- " . $field->comments . "\n "
500 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
505 my @size = $field->size;
506 my $data_type = lc $field->data_type;
507 my %extra = $field->extra;
508 my $list = $extra{'list'} || [];
509 # todo deal with embedded quotes
510 my $commalist = join( ', ', map { qq['$_'] } @$list );
512 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
513 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
514 $field_def .= ' '. $type_name;
515 my $new_type_def = "DROP TYPE IF EXISTS $type_name;\n" .
516 "CREATE TYPE $type_name AS ENUM ($commalist)";
517 if (! exists $type_defs->{$type_name} ) {
518 $type_defs->{$type_name} = $new_type_def;
519 } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
520 die "Attempted to redefine type name '$type_name' as a different type.\n";
523 $field_def .= ' '. convert_datatype($field);
529 SQL::Translator::Producer->_apply_default_value(
535 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
540 # Not null constraint
542 $field_def .= ' NOT NULL' unless $field->is_nullable;
545 # Geometry constraints
547 if(is_geometry($field)){
548 foreach ( create_geometry_constraints($field) ) {
549 my ($cdefs, $fks) = create_constraint($_,
551 quote_field_names => $qf,
552 quote_table_names => $qt,
553 table_name => $table_name,
555 push @$constraint_defs, @$cdefs;
564 sub create_geometry_constraints{
568 push @constraints, SQL::Translator::Schema::Constraint->new(
569 name => "enforce_dims_".$field->name,
570 expression => "(st_ndims($field) = ".$field->{extra}{dimensions}.")",
571 table => $field->table,
575 push @constraints, SQL::Translator::Schema::Constraint->new(
576 name => "enforce_srid_".$field->name,
577 expression => "(st_srid($field) = ".$field->{extra}{srid}.")",
578 table => $field->table,
581 push @constraints, SQL::Translator::Schema::Constraint->new(
582 name => "enforce_geotype_".$field->name,
583 expression => "(geometrytype($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
584 table => $field->table,
593 my ($index, $options) = @_;
595 my $qt = $options->{quote_table_names} ||'';
596 my $qf = $options->{quote_field_names} ||'';
597 my $table_name = $index->table->name;
598 # my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
600 my ($index_def, @constraint_defs);
602 my $name = next_unused_name(
604 || join('_', $table_name, 'idx', ++$index_name{ $table_name })
607 my $type = $index->type || NORMAL;
609 map { $_ =~ s/\(.+\)//; $_ }
610 map { $qt ? $_ : unreserve($_, $table_name ) }
614 my $def_start = qq[CONSTRAINT "$name" ];
615 if ( $type eq PRIMARY_KEY ) {
616 push @constraint_defs, "${def_start}PRIMARY KEY ".
617 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
619 elsif ( $type eq UNIQUE ) {
620 push @constraint_defs, "${def_start}UNIQUE " .
621 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
623 elsif ( $type eq NORMAL ) {
625 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
626 join( ', ', map { qq[$qf$_$qf] } @fields ).
631 warn "Unknown index type ($type) on table $table_name.\n"
635 return $index_def, \@constraint_defs;
638 sub create_constraint
640 my ($c, $options) = @_;
642 my $qf = $options->{quote_field_names} ||'';
643 my $qt = $options->{quote_table_names} ||'';
644 my $table_name = $c->table->name;
645 my (@constraint_defs, @fks);
647 my $name = $c->name || '';
649 $name = next_unused_name($name);
653 map { $_ =~ s/\(.+\)//; $_ }
654 map { $qt ? $_ : unreserve( $_, $table_name )}
658 map { $_ =~ s/\(.+\)//; $_ }
659 map { $qt ? $_ : unreserve( $_, $table_name )}
660 $c->reference_fields;
662 next if !@fields && $c->type ne CHECK_C;
663 my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
664 if ( $c->type eq PRIMARY_KEY ) {
665 push @constraint_defs, "${def_start}PRIMARY KEY ".
666 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
668 elsif ( $c->type eq UNIQUE ) {
669 $name = next_unused_name($name);
670 push @constraint_defs, "${def_start}UNIQUE " .
671 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
673 elsif ( $c->type eq CHECK_C ) {
674 my $expression = $c->expression;
675 push @constraint_defs, "${def_start}CHECK ($expression)";
677 elsif ( $c->type eq FOREIGN_KEY ) {
678 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
679 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
680 "\n REFERENCES " . $qt . $c->reference_table . $qt;
683 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
686 if ( $c->match_type ) {
688 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
691 if ( $c->on_delete ) {
692 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
695 if ( $c->on_update ) {
696 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
699 if ( $c->deferrable ) {
700 $def .= ' DEFERRABLE';
706 return \@constraint_defs, \@fks;
713 my @size = $field->size;
714 my $data_type = lc $field->data_type;
716 if ( $data_type eq 'enum' ) {
718 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
719 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
720 # push @$constraint_defs,
721 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
722 # qq[IN ($commalist))];
723 $data_type = 'character varying';
725 elsif ( $data_type eq 'set' ) {
726 $data_type = 'character varying';
728 elsif ( $field->is_auto_increment ) {
729 if ( defined $size[0] && $size[0] > 11 ) {
730 $data_type = 'bigserial';
733 $data_type = 'serial';
738 $data_type = defined $translate{ $data_type } ?
739 $translate{ $data_type } :
743 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
744 if ( defined $size[0] && $size[0] > 6 ) {
749 if ( $data_type eq 'integer' ) {
750 if ( defined $size[0] && $size[0] > 0) {
751 if ( $size[0] > 10 ) {
752 $data_type = 'bigint';
754 elsif ( $size[0] < 5 ) {
755 $data_type = 'smallint';
758 $data_type = 'integer';
762 $data_type = 'integer';
766 my $type_with_size = join('|',
767 'bit', 'varbit', 'character', 'bit varying', 'character varying',
768 'time', 'timestamp', 'interval', 'numeric'
771 if ( $data_type !~ /$type_with_size/ ) {
775 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
776 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
777 $data_type .= $2 if(defined $2);
778 } elsif ( defined $size[0] && $size[0] > 0 ) {
779 $data_type .= '(' . join( ',', @size ) . ')';
788 my ($from_field, $to_field) = @_;
790 die "Can't alter field in another table"
791 if($from_field->table->name ne $to_field->table->name);
795 # drop geometry column and constraints
796 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
797 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
799 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
800 $to_field->table->name,
801 $to_field->name) if(!$to_field->is_nullable and
802 $from_field->is_nullable);
804 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
805 $to_field->table->name,
807 if ( !$from_field->is_nullable and $to_field->is_nullable );
810 my $from_dt = convert_datatype($from_field);
811 my $to_dt = convert_datatype($to_field);
812 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
813 $to_field->table->name,
815 $to_dt) if($to_dt ne $from_dt);
817 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
818 $to_field->table->name,
820 $to_field->name) if($from_field->name ne $to_field->name);
822 my $old_default = $from_field->default_value;
823 my $new_default = $to_field->default_value;
824 my $default_value = $to_field->default_value;
826 # fixes bug where output like this was created:
827 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
828 if(ref $default_value eq "SCALAR" ) {
829 $default_value = $$default_value;
830 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
831 $default_value =~ s/'/''/xsmg;
832 $default_value = q(') . $default_value . q(');
835 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
836 $to_field->table->name,
839 if ( defined $new_default &&
840 (!defined $old_default || $old_default ne $new_default) );
842 # fixes bug where removing the DEFAULT statement of a column
843 # would result in no change
845 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
846 $to_field->table->name,
848 if ( !defined $new_default && defined $old_default );
850 # add geometry column and contraints
851 push @out, add_geometry_column($to_field) if is_geometry($to_field);
852 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
854 return wantarray ? @out : join("\n", @out);
857 sub rename_field { alter_field(@_) }
861 my ($new_field) = @_;
863 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
864 $new_field->table->name,
865 create_field($new_field));
866 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
867 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
874 my ($old_field) = @_;
876 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
877 $old_field->table->name,
879 $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
883 sub add_geometry_column{
884 my ($field,$options) = @_;
886 my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
888 $field->table->schema->name,
889 $options->{table} ? $options->{table} : $field->table->name,
891 $field->{extra}{dimensions},
892 $field->{extra}{srid},
893 $field->{extra}{geometry_type});
897 sub drop_geometry_column
901 my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
902 $field->table->schema->name,
908 sub add_geometry_constraints{
911 my @constraints = create_geometry_constraints($field);
913 my $out = join("\n", map { alter_create_constraint($_); } @constraints);
918 sub drop_geometry_constraints{
921 my @constraints = create_geometry_constraints($field);
923 my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
929 my ($to_table, $options) = @_;
930 my $qt = $options->{quote_table_names} || '';
931 my $out = sprintf('ALTER TABLE %s %s',
932 $qt . $to_table->name . $qt,
933 $options->{alter_table_action});
934 $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
939 my ($old_table, $new_table, $options) = @_;
940 my $qt = $options->{quote_table_names} || '';
941 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
943 my @geometry_changes;
944 push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
945 push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
947 $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
949 return alter_table($old_table, $options);
952 sub alter_create_index {
953 my ($index, $options) = @_;
954 my $qt = $options->{quote_table_names} || '';
955 my $qf = $options->{quote_field_names} || '';
956 my ($idef, $constraints) = create_index($index, {
957 quote_field_names => $qf,
958 quote_table_names => $qt,
959 table_name => $index->table->name,
961 return $index->type eq NORMAL ? $idef
962 : sprintf('ALTER TABLE %s ADD %s',
963 $qt . $index->table->name . $qt,
964 join(q{}, @$constraints)
968 sub alter_drop_index {
969 my ($index, $options) = @_;
970 my $index_name = $index->name;
971 return "DROP INDEX $index_name";
974 sub alter_drop_constraint {
975 my ($c, $options) = @_;
976 my $qt = $options->{quote_table_names} || '';
977 my $qc = $options->{quote_field_names} || '';
978 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
979 $qt . $c->table->name . $qt,
980 $qc . $c->name . $qc );
984 sub alter_create_constraint {
985 my ($index, $options) = @_;
986 my $qt = $options->{quote_table_names} || '';
987 my ($defs, $fks) = create_constraint(@_);
989 # return if there are no constraint definitions so we don't run
990 # into output like this:
991 # ALTER TABLE users ADD ;
993 return unless(@{$defs} || @{$fks});
994 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
995 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
996 'ADD', join(q{}, @{$defs}, @{$fks})
1001 my ($table, $options) = @_;
1002 my $qt = $options->{quote_table_names} || '';
1003 my $out = "DROP TABLE $qt$table$qt CASCADE";
1005 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
1007 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
1013 # -------------------------------------------------------------------
1014 # Life is full of misery, loneliness, and suffering --
1015 # and it's all over much too soon.
1017 # -------------------------------------------------------------------
1023 SQL::Translator, SQL::Translator::Producer::Oracle.
1027 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.