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);
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,
208 push @table_defs, $table_def;
212 for my $view ( $schema->get_views ) {
213 push @table_defs, create_view($view, {
214 add_drop_view => $add_drop_table,
215 quote_table_names => $qt,
216 quote_field_names => $qf,
217 no_comments => $no_comments,
221 push @output, map { "$_;\n\n" } @table_defs;
223 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
224 push @output, map { "$_;\n\n" } @fks;
229 warn "Truncated " . keys( %truncated ) . " names:\n";
230 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
234 warn "Encounted " . keys( %unreserve ) .
235 " unsafe names in schema (reserved or invalid):\n";
236 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
242 : join ('', @output);
245 # -------------------------------------------------------------------
247 my $basename = shift || '';
248 my $type = shift || '';
249 my $scope = shift || '';
250 my $critical = shift || '';
251 my $basename_orig = $basename;
252 # my $max_id_length = 62;
254 ? $max_id_length - (length($type) + 1)
256 $basename = substr( $basename, 0, $max_name )
257 if length( $basename ) > $max_name;
258 my $name = $type ? "${type}_$basename" : $basename;
260 if ( $basename ne $basename_orig and $critical ) {
261 my $show_type = $type ? "+'$type'" : "";
262 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
263 "character limit to make '$name'\n" if $WARN;
264 $truncated{ $basename_orig } = $name;
267 $scope ||= \%global_names;
268 if ( my $prev = $scope->{ $name } ) {
269 my $name_orig = $name;
270 $name .= sprintf( "%02d", ++$prev );
271 substr($name, $max_id_length - 3) = "00"
272 if length( $name ) > $max_id_length;
274 warn "The name '$name_orig' has been changed to ",
275 "'$name' to make it unique.\n" if $WARN;
277 $scope->{ $name_orig }++;
284 # -------------------------------------------------------------------
286 my $name = shift || '';
287 my $schema_obj_name = shift || '';
289 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
291 # also trap fields that don't begin with a letter
292 return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
294 if ( $schema_obj_name ) {
295 ++$unreserve{"$schema_obj_name.$name"};
298 ++$unreserve{"$name (table name)"};
301 my $unreserve = sprintf '%s_', $name;
302 return $unreserve.$suffix;
305 # -------------------------------------------------------------------
306 sub next_unused_name {
307 my $orig_name = shift or return;
308 my $name = $orig_name;
310 my $suffix_gen = sub {
312 return ++$suffix ? '' : $suffix;
316 $name = $orig_name . $suffix_gen->();
317 last if $used_names{ $name }++;
326 return 1 if $field->data_type eq 'geometry' || $field->data_type eq 'geography';
331 my ($table, $options) = @_;
333 my $qt = $options->{quote_table_names} || '';
334 my $qf = $options->{quote_field_names} || '';
335 my $no_comments = $options->{no_comments} || 0;
336 my $add_drop_table = $options->{add_drop_table} || 0;
337 my $postgres_version = $options->{postgres_version} || 0;
339 my $table_name = $table->name or next;
340 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
341 my $table_name_ur = $qt ? $table_name
342 : $fql_tbl_name ? join('.', $table_name, unreserve($fql_tbl_name))
343 : unreserve($table_name);
344 $table->name($table_name_ur);
346 # print STDERR "$table_name table_name\n";
347 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
349 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
351 if ( $table->comments and !$no_comments ){
352 my $c = "-- Comments: \n-- ";
353 $c .= join "\n-- ", $table->comments;
361 my %field_name_scope;
362 for my $field ( $table->get_fields ) {
363 push @field_defs, create_field($field, { quote_table_names => $qt,
364 quote_field_names => $qf,
365 table_name => $table_name_ur,
366 postgres_version => $postgres_version,
367 type_defs => \@type_defs,
368 type_drops => \@type_drops,
369 constraint_defs => \@constraint_defs,});
376 # my $idx_name_default;
377 for my $index ( $table->get_indices ) {
378 my ($idef, $constraints) = create_index($index,
380 quote_field_names => $qf,
381 quote_table_names => $qt,
382 table_name => $table_name,
384 $idef and push @index_defs, $idef;
385 push @constraint_defs, @$constraints;
392 for my $c ( $table->get_constraints ) {
393 my ($cdefs, $fks) = create_constraint($c,
395 quote_field_names => $qf,
396 quote_table_names => $qt,
397 table_name => $table_name,
399 push @constraint_defs, @$cdefs;
406 if(exists $table->{extra}{temporary}) {
407 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
410 my $create_statement;
411 $create_statement = join("\n", @comments);
412 if ($add_drop_table) {
413 if ($postgres_version >= 8.002) {
414 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
415 $create_statement .= join (";\n", @type_drops) . ";\n"
416 if $postgres_version >= 8.003 && scalar @type_drops;
418 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
421 $create_statement .= join(";\n", @type_defs) . ";\n"
422 if $postgres_version >= 8.003 && scalar @type_defs;
423 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
424 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
427 $create_statement .= @index_defs ? ';' : q{};
428 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
429 . join(";\n", @index_defs);
434 if(grep { is_geometry($_) } $table->get_fields){
435 $create_statement .= ";";
436 $create_statement .= "\n".join("\n", map { drop_geometry_column($_) if is_geometry($_); } $table->get_fields) if $options->{add_drop_table};
437 $create_statement .= "\n".join("\n", map { add_geometry_column($_) if is_geometry($_);} $table->get_fields);
440 return $create_statement, \@fks;
444 my ($view, $options) = @_;
445 my $qt = $options->{quote_table_names} || '';
446 my $qf = $options->{quote_field_names} || '';
447 my $add_drop_view = $options->{add_drop_view};
449 my $view_name = $view->name;
450 debug("PKG: Looking at view '${view_name}'\n");
453 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
454 unless $options->{no_comments};
455 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
458 my $extra = $view->extra;
459 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
460 $create .= " VIEW ${qt}${view_name}${qt}";
462 if ( my @fields = $view->fields ) {
463 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
464 $create .= " ( ${field_list} )";
467 if ( my $sql = $view->sql ) {
468 $create .= " AS\n ${sql}\n";
471 if ( $extra->{check_option} ) {
472 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
480 my %field_name_scope;
484 my ($field, $options) = @_;
486 my $qt = $options->{quote_table_names} || '';
487 my $qf = $options->{quote_field_names} || '';
488 my $table_name = $field->table->name;
489 my $constraint_defs = $options->{constraint_defs} || [];
490 my $postgres_version = $options->{postgres_version} || 0;
491 my $type_defs = $options->{type_defs} || [];
492 my $type_drops = $options->{type_drops} || [];
494 $field_name_scope{$table_name} ||= {};
495 my $field_name = $field->name;
496 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
497 $field->name($field_name_ur);
498 my $field_comments = $field->comments
499 ? "-- " . $field->comments . "\n "
502 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
507 my @size = $field->size;
508 my $data_type = lc $field->data_type;
509 my %extra = $field->extra;
510 my $list = $extra{'list'} || [];
511 # todo deal with embedded quotes
512 my $commalist = join( ', ', map { qq['$_'] } @$list );
514 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
515 my $type_name = $field->table->name . '_' . $field->name . '_type';
516 $field_def .= ' '. $type_name;
517 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
518 push @$type_drops, "DROP TYPE IF EXISTS $type_name";
520 $field_def .= ' '. convert_datatype($field);
526 SQL::Translator::Producer->_apply_default_value(
532 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
537 # Not null constraint
539 $field_def .= ' NOT NULL' unless $field->is_nullable;
542 # Geometry constraints
544 if(is_geometry($field)){
545 foreach ( create_geometry_constraints($field) ) {
546 my ($cdefs, $fks) = create_constraint($_,
548 quote_field_names => $qf,
549 quote_table_names => $qt,
550 table_name => $table_name,
552 push @$constraint_defs, @$cdefs;
561 sub create_geometry_constraints{
565 push @constraints, SQL::Translator::Schema::Constraint->new(
566 name => "enforce_dims_".$field->name,
567 expression => "(st_ndims($field) = ".$field->{extra}{dimensions}.")",
568 table => $field->table,
572 push @constraints, SQL::Translator::Schema::Constraint->new(
573 name => "enforce_srid_".$field->name,
574 expression => "(st_srid($field) = ".$field->{extra}{srid}.")",
575 table => $field->table,
578 push @constraints, SQL::Translator::Schema::Constraint->new(
579 name => "enforce_geotype_".$field->name,
580 expression => "(geometrytype($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
581 table => $field->table,
590 my ($index, $options) = @_;
592 my $qt = $options->{quote_table_names} ||'';
593 my $qf = $options->{quote_field_names} ||'';
594 my $table_name = $index->table->name;
595 # my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
597 my ($index_def, @constraint_defs);
599 my $name = next_unused_name(
601 || join('_', $table_name, 'idx', ++$index_name{ $table_name })
604 my $type = $index->type || NORMAL;
606 map { $_ =~ s/\(.+\)//; $_ }
607 map { $qt ? $_ : unreserve($_, $table_name ) }
611 my $def_start = qq[CONSTRAINT "$name" ];
612 if ( $type eq PRIMARY_KEY ) {
613 push @constraint_defs, "${def_start}PRIMARY KEY ".
614 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
616 elsif ( $type eq UNIQUE ) {
617 push @constraint_defs, "${def_start}UNIQUE " .
618 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
620 elsif ( $type eq NORMAL ) {
622 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
623 join( ', ', map { qq[$qf$_$qf] } @fields ).
628 warn "Unknown index type ($type) on table $table_name.\n"
632 return $index_def, \@constraint_defs;
635 sub create_constraint
637 my ($c, $options) = @_;
639 my $qf = $options->{quote_field_names} ||'';
640 my $qt = $options->{quote_table_names} ||'';
641 my $table_name = $c->table->name;
642 my (@constraint_defs, @fks);
644 my $name = $c->name || '';
646 $name = next_unused_name($name);
650 map { $_ =~ s/\(.+\)//; $_ }
651 map { $qt ? $_ : unreserve( $_, $table_name )}
655 map { $_ =~ s/\(.+\)//; $_ }
656 map { $qt ? $_ : unreserve( $_, $table_name )}
657 $c->reference_fields;
659 next if !@fields && $c->type ne CHECK_C;
660 my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
661 if ( $c->type eq PRIMARY_KEY ) {
662 push @constraint_defs, "${def_start}PRIMARY KEY ".
663 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
665 elsif ( $c->type eq UNIQUE ) {
666 $name = next_unused_name($name);
667 push @constraint_defs, "${def_start}UNIQUE " .
668 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
670 elsif ( $c->type eq CHECK_C ) {
671 my $expression = $c->expression;
672 push @constraint_defs, "${def_start}CHECK ($expression)";
674 elsif ( $c->type eq FOREIGN_KEY ) {
675 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
676 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
677 "\n REFERENCES " . $qt . $c->reference_table . $qt;
680 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
683 if ( $c->match_type ) {
685 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
688 if ( $c->on_delete ) {
689 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
692 if ( $c->on_update ) {
693 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
696 if ( $c->deferrable ) {
697 $def .= ' DEFERRABLE';
703 return \@constraint_defs, \@fks;
710 my @size = $field->size;
711 my $data_type = lc $field->data_type;
713 if ( $data_type eq 'enum' ) {
715 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
716 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
717 # push @$constraint_defs,
718 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
719 # qq[IN ($commalist))];
720 $data_type = 'character varying';
722 elsif ( $data_type eq 'set' ) {
723 $data_type = 'character varying';
725 elsif ( $field->is_auto_increment ) {
726 if ( defined $size[0] && $size[0] > 11 ) {
727 $data_type = 'bigserial';
730 $data_type = 'serial';
735 $data_type = defined $translate{ $data_type } ?
736 $translate{ $data_type } :
740 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
741 if ( defined $size[0] && $size[0] > 6 ) {
746 if ( $data_type eq 'integer' ) {
747 if ( defined $size[0] && $size[0] > 0) {
748 if ( $size[0] > 10 ) {
749 $data_type = 'bigint';
751 elsif ( $size[0] < 5 ) {
752 $data_type = 'smallint';
755 $data_type = 'integer';
759 $data_type = 'integer';
763 my $type_with_size = join('|',
764 'bit', 'varbit', 'character', 'bit varying', 'character varying',
765 'time', 'timestamp', 'interval', 'numeric'
768 if ( $data_type !~ /$type_with_size/ ) {
772 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
773 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
774 $data_type .= $2 if(defined $2);
775 } elsif ( defined $size[0] && $size[0] > 0 ) {
776 $data_type .= '(' . join( ',', @size ) . ')';
785 my ($from_field, $to_field) = @_;
787 die "Can't alter field in another table"
788 if($from_field->table->name ne $to_field->table->name);
792 # drop geometry column and constraints
793 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
794 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
796 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
797 $to_field->table->name,
798 $to_field->name) if(!$to_field->is_nullable and
799 $from_field->is_nullable);
801 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
802 $to_field->table->name,
804 if ( !$from_field->is_nullable and $to_field->is_nullable );
807 my $from_dt = convert_datatype($from_field);
808 my $to_dt = convert_datatype($to_field);
809 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
810 $to_field->table->name,
812 $to_dt) if($to_dt ne $from_dt);
814 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
815 $to_field->table->name,
817 $to_field->name) if($from_field->name ne $to_field->name);
819 my $old_default = $from_field->default_value;
820 my $new_default = $to_field->default_value;
821 my $default_value = $to_field->default_value;
823 # fixes bug where output like this was created:
824 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
825 if(ref $default_value eq "SCALAR" ) {
826 $default_value = $$default_value;
827 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
828 $default_value =~ s/'/''/xsmg;
829 $default_value = q(') . $default_value . q(');
832 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
833 $to_field->table->name,
836 if ( defined $new_default &&
837 (!defined $old_default || $old_default ne $new_default) );
839 # fixes bug where removing the DEFAULT statement of a column
840 # would result in no change
842 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
843 $to_field->table->name,
845 if ( !defined $new_default && defined $old_default );
847 # add geometry column and contraints
848 push @out, add_geometry_column($to_field) if is_geometry($to_field);
849 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
851 return wantarray ? @out : join("\n", @out);
854 sub rename_field { alter_field(@_) }
858 my ($new_field) = @_;
860 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
861 $new_field->table->name,
862 create_field($new_field));
863 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
864 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
871 my ($old_field) = @_;
873 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
874 $old_field->table->name,
876 $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
880 sub add_geometry_column{
881 my ($field,$options) = @_;
883 my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
885 $field->table->schema->name,
886 $options->{table} ? $options->{table} : $field->table->name,
888 $field->{extra}{dimensions},
889 $field->{extra}{srid},
890 $field->{extra}{geometry_type});
894 sub drop_geometry_column
898 my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
899 $field->table->schema->name,
905 sub add_geometry_constraints{
908 my @constraints = create_geometry_constraints($field);
910 my $out = join("\n", map { alter_create_constraint($_); } @constraints);
915 sub drop_geometry_constraints{
918 my @constraints = create_geometry_constraints($field);
920 my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
926 my ($to_table, $options) = @_;
927 my $qt = $options->{quote_table_names} || '';
928 my $out = sprintf('ALTER TABLE %s %s',
929 $qt . $to_table->name . $qt,
930 $options->{alter_table_action});
931 $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
936 my ($old_table, $new_table, $options) = @_;
937 my $qt = $options->{quote_table_names} || '';
938 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
940 my @geometry_changes;
941 push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
942 push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
944 $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
946 return alter_table($old_table, $options);
949 sub alter_create_index {
950 my ($index, $options) = @_;
951 my $qt = $options->{quote_table_names} || '';
952 my $qf = $options->{quote_field_names} || '';
953 my ($idef, $constraints) = create_index($index, {
954 quote_field_names => $qf,
955 quote_table_names => $qt,
956 table_name => $index->table->name,
958 return $index->type eq NORMAL ? $idef
959 : sprintf('ALTER TABLE %s ADD %s',
960 $qt . $index->table->name . $qt,
961 join(q{}, @$constraints)
965 sub alter_drop_index {
966 my ($index, $options) = @_;
967 my $index_name = $index->name;
968 return "DROP INDEX $index_name";
971 sub alter_drop_constraint {
972 my ($c, $options) = @_;
973 my $qt = $options->{quote_table_names} || '';
974 my $qc = $options->{quote_field_names} || '';
975 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
976 $qt . $c->table->name . $qt,
977 $qc . $c->name . $qc );
981 sub alter_create_constraint {
982 my ($index, $options) = @_;
983 my $qt = $options->{quote_table_names} || '';
984 my ($defs, $fks) = create_constraint(@_);
986 # return if there are no constraint definitions so we don't run
987 # into output like this:
988 # ALTER TABLE users ADD ;
990 return unless(@{$defs} || @{$fks});
991 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
992 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
993 'ADD', join(q{}, @{$defs}, @{$fks})
998 my ($table, $options) = @_;
999 my $qt = $options->{quote_table_names} || '';
1000 my $out = "DROP TABLE $qt$table$qt CASCADE";
1002 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
1004 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
1010 # -------------------------------------------------------------------
1011 # Life is full of misery, loneliness, and suffering --
1012 # and it's all over much too soon.
1014 # -------------------------------------------------------------------
1020 SQL::Translator, SQL::Translator::Producer::Oracle.
1024 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.