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';
335 return 1 if $field->data_type eq 'geography';
340 my ($table, $options) = @_;
342 my $qt = $options->{quote_table_names} || '';
343 my $qf = $options->{quote_field_names} || '';
344 my $no_comments = $options->{no_comments} || 0;
345 my $add_drop_table = $options->{add_drop_table} || 0;
346 my $postgres_version = $options->{postgres_version} || 0;
347 my $type_defs = $options->{type_defs} || {};
349 my $table_name = $table->name or next;
350 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
351 my $table_name_ur = $qt ? $table_name
352 : $fql_tbl_name ? join('.', $table_name, unreserve($fql_tbl_name))
353 : unreserve($table_name);
354 $table->name($table_name_ur);
356 # print STDERR "$table_name table_name\n";
357 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
359 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
361 if ( $table->comments and !$no_comments ){
362 my $c = "-- Comments: \n-- ";
363 $c .= join "\n-- ", $table->comments;
371 my %field_name_scope;
372 for my $field ( $table->get_fields ) {
373 push @field_defs, create_field($field, { quote_table_names => $qt,
374 quote_field_names => $qf,
375 table_name => $table_name_ur,
376 postgres_version => $postgres_version,
377 type_defs => $type_defs,
378 constraint_defs => \@constraint_defs,});
385 # my $idx_name_default;
386 for my $index ( $table->get_indices ) {
387 my ($idef, $constraints) = create_index($index,
389 quote_field_names => $qf,
390 quote_table_names => $qt,
391 table_name => $table_name,
393 $idef and push @index_defs, $idef;
394 push @constraint_defs, @$constraints;
401 for my $c ( $table->get_constraints ) {
402 my ($cdefs, $fks) = create_constraint($c,
404 quote_field_names => $qf,
405 quote_table_names => $qt,
406 table_name => $table_name,
408 push @constraint_defs, @$cdefs;
415 if(exists $table->{extra}{temporary}) {
416 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
419 my $create_statement;
420 $create_statement = join("\n", @comments);
421 if ($add_drop_table) {
422 if ($postgres_version >= 8.002) {
423 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
425 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
428 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
429 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
432 $create_statement .= @index_defs ? ';' : q{};
433 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
434 . join(";\n", @index_defs);
439 if(grep { is_geometry($_) } $table->get_fields){
440 $create_statement .= ";";
441 my @geometry_columns;
442 foreach my $col ($table->get_fields) { push(@geometry_columns,$col) if is_geometry($col); }
443 $create_statement .= "\n".join("\n", map{ drop_geometry_column($_) } @geometry_columns) if $options->{add_drop_table};
444 $create_statement .= "\n".join("\n", map{ add_geometry_column($_) } @geometry_columns);
447 return $create_statement, \@fks;
451 my ($view, $options) = @_;
452 my $qt = $options->{quote_table_names} || '';
453 my $qf = $options->{quote_field_names} || '';
454 my $add_drop_view = $options->{add_drop_view};
456 my $view_name = $view->name;
457 debug("PKG: Looking at view '${view_name}'\n");
460 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
461 unless $options->{no_comments};
462 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
465 my $extra = $view->extra;
466 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
467 $create .= " VIEW ${qt}${view_name}${qt}";
469 if ( my @fields = $view->fields ) {
470 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
471 $create .= " ( ${field_list} )";
474 if ( my $sql = $view->sql ) {
475 $create .= " AS\n ${sql}\n";
478 if ( $extra->{check_option} ) {
479 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
487 my %field_name_scope;
491 my ($field, $options) = @_;
493 my $qt = $options->{quote_table_names} || '';
494 my $qf = $options->{quote_field_names} || '';
495 my $table_name = $field->table->name;
496 my $constraint_defs = $options->{constraint_defs} || [];
497 my $postgres_version = $options->{postgres_version} || 0;
498 my $type_defs = $options->{type_defs} || {};
500 $field_name_scope{$table_name} ||= {};
501 my $field_name = $field->name;
502 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
503 $field->name($field_name_ur);
504 my $field_comments = $field->comments
505 ? "-- " . $field->comments . "\n "
508 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
513 my @size = $field->size;
514 my $data_type = lc $field->data_type;
515 my %extra = $field->extra;
516 my $list = $extra{'list'} || [];
517 # todo deal with embedded quotes
518 my $commalist = join( ', ', map { qq['$_'] } @$list );
520 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
521 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
522 $field_def .= ' '. $type_name;
523 my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
524 "CREATE TYPE $type_name AS ENUM ($commalist)";
525 if (! exists $type_defs->{$type_name} ) {
526 $type_defs->{$type_name} = $new_type_def;
527 } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
528 die "Attempted to redefine type name '$type_name' as a different type.\n";
531 $field_def .= ' '. convert_datatype($field);
537 SQL::Translator::Producer->_apply_default_value(
543 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
548 # Not null constraint
550 $field_def .= ' NOT NULL' unless $field->is_nullable;
553 # Geometry constraints
555 if(is_geometry($field)){
556 foreach ( create_geometry_constraints($field) ) {
557 my ($cdefs, $fks) = create_constraint($_,
559 quote_field_names => $qf,
560 quote_table_names => $qt,
561 table_name => $table_name,
563 push @$constraint_defs, @$cdefs;
572 sub create_geometry_constraints{
576 push @constraints, SQL::Translator::Schema::Constraint->new(
577 name => "enforce_dims_".$field->name,
578 expression => "(st_ndims($field) = ".$field->{extra}{dimensions}.")",
579 table => $field->table,
583 push @constraints, SQL::Translator::Schema::Constraint->new(
584 name => "enforce_srid_".$field->name,
585 expression => "(st_srid($field) = ".$field->{extra}{srid}.")",
586 table => $field->table,
589 push @constraints, SQL::Translator::Schema::Constraint->new(
590 name => "enforce_geotype_".$field->name,
591 expression => "(geometrytype($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
592 table => $field->table,
601 my ($index, $options) = @_;
603 my $qt = $options->{quote_table_names} ||'';
604 my $qf = $options->{quote_field_names} ||'';
605 my $table_name = $index->table->name;
606 # my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
608 my ($index_def, @constraint_defs);
610 my $name = next_unused_name(
612 || join('_', $table_name, 'idx', ++$index_name{ $table_name })
615 my $type = $index->type || NORMAL;
617 map { $_ =~ s/\(.+\)//; $_ }
618 map { $qt ? $_ : unreserve($_, $table_name ) }
622 my $def_start = qq[CONSTRAINT "$name" ];
623 if ( $type eq PRIMARY_KEY ) {
624 push @constraint_defs, "${def_start}PRIMARY KEY ".
625 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
627 elsif ( $type eq UNIQUE ) {
628 push @constraint_defs, "${def_start}UNIQUE " .
629 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
631 elsif ( $type eq NORMAL ) {
633 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
634 join( ', ', map { qq[$qf$_$qf] } @fields ).
639 warn "Unknown index type ($type) on table $table_name.\n"
643 return $index_def, \@constraint_defs;
646 sub create_constraint
648 my ($c, $options) = @_;
650 my $qf = $options->{quote_field_names} ||'';
651 my $qt = $options->{quote_table_names} ||'';
652 my $table_name = $c->table->name;
653 my (@constraint_defs, @fks);
655 my $name = $c->name || '';
657 $name = next_unused_name($name);
661 map { $_ =~ s/\(.+\)//; $_ }
662 map { $qt ? $_ : unreserve( $_, $table_name )}
666 map { $_ =~ s/\(.+\)//; $_ }
667 map { $qt ? $_ : unreserve( $_, $table_name )}
668 $c->reference_fields;
670 next if !@fields && $c->type ne CHECK_C;
671 my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
672 if ( $c->type eq PRIMARY_KEY ) {
673 push @constraint_defs, "${def_start}PRIMARY KEY ".
674 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
676 elsif ( $c->type eq UNIQUE ) {
677 $name = next_unused_name($name);
678 push @constraint_defs, "${def_start}UNIQUE " .
679 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
681 elsif ( $c->type eq CHECK_C ) {
682 my $expression = $c->expression;
683 push @constraint_defs, "${def_start}CHECK ($expression)";
685 elsif ( $c->type eq FOREIGN_KEY ) {
686 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
687 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
688 "\n REFERENCES " . $qt . $c->reference_table . $qt;
691 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
694 if ( $c->match_type ) {
696 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
699 if ( $c->on_delete ) {
700 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
703 if ( $c->on_update ) {
704 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
707 if ( $c->deferrable ) {
708 $def .= ' DEFERRABLE';
714 return \@constraint_defs, \@fks;
721 my @size = $field->size;
722 my $data_type = lc $field->data_type;
724 if ( $data_type eq 'enum' ) {
726 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
727 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
728 # push @$constraint_defs,
729 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
730 # qq[IN ($commalist))];
731 $data_type = 'character varying';
733 elsif ( $data_type eq 'set' ) {
734 $data_type = 'character varying';
736 elsif ( $field->is_auto_increment ) {
737 if ( defined $size[0] && $size[0] > 11 ) {
738 $data_type = 'bigserial';
741 $data_type = 'serial';
746 $data_type = defined $translate{ $data_type } ?
747 $translate{ $data_type } :
751 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
752 if ( defined $size[0] && $size[0] > 6 ) {
757 if ( $data_type eq 'integer' ) {
758 if ( defined $size[0] && $size[0] > 0) {
759 if ( $size[0] > 10 ) {
760 $data_type = 'bigint';
762 elsif ( $size[0] < 5 ) {
763 $data_type = 'smallint';
766 $data_type = 'integer';
770 $data_type = 'integer';
774 my $type_with_size = join('|',
775 'bit', 'varbit', 'character', 'bit varying', 'character varying',
776 'time', 'timestamp', 'interval', 'numeric'
779 if ( $data_type !~ /$type_with_size/ ) {
783 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
784 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
785 $data_type .= $2 if(defined $2);
786 } elsif ( defined $size[0] && $size[0] > 0 ) {
787 $data_type .= '(' . join( ',', @size ) . ')';
793 if($data_type eq 'geography'){
794 $data_type .= '('.$field->{extra}{geography_type}.','. $field->{extra}{srid} .')'
803 my ($from_field, $to_field) = @_;
805 die "Can't alter field in another table"
806 if($from_field->table->name ne $to_field->table->name);
810 # drop geometry column and constraints
811 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
812 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
814 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
815 $to_field->table->name,
816 $to_field->name) if(!$to_field->is_nullable and
817 $from_field->is_nullable);
819 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
820 $to_field->table->name,
822 if ( !$from_field->is_nullable and $to_field->is_nullable );
825 my $from_dt = convert_datatype($from_field);
826 my $to_dt = convert_datatype($to_field);
827 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
828 $to_field->table->name,
830 $to_dt) if($to_dt ne $from_dt);
832 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
833 $to_field->table->name,
835 $to_field->name) if($from_field->name ne $to_field->name);
837 my $old_default = $from_field->default_value;
838 my $new_default = $to_field->default_value;
839 my $default_value = $to_field->default_value;
841 # fixes bug where output like this was created:
842 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
843 if(ref $default_value eq "SCALAR" ) {
844 $default_value = $$default_value;
845 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
846 $default_value =~ s/'/''/xsmg;
847 $default_value = q(') . $default_value . q(');
850 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
851 $to_field->table->name,
854 if ( defined $new_default &&
855 (!defined $old_default || $old_default ne $new_default) );
857 # fixes bug where removing the DEFAULT statement of a column
858 # would result in no change
860 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
861 $to_field->table->name,
863 if ( !defined $new_default && defined $old_default );
865 # add geometry column and contraints
866 push @out, add_geometry_column($to_field) if is_geometry($to_field);
867 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
869 return wantarray ? @out : join("\n", @out);
872 sub rename_field { alter_field(@_) }
876 my ($new_field) = @_;
878 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
879 $new_field->table->name,
880 create_field($new_field));
881 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
882 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
889 my ($old_field) = @_;
891 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
892 $old_field->table->name,
894 $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
898 sub add_geometry_column{
899 my ($field,$options) = @_;
901 my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
903 $field->table->schema->name,
904 $options->{table} ? $options->{table} : $field->table->name,
906 $field->{extra}{dimensions},
907 $field->{extra}{srid},
908 $field->{extra}{geometry_type});
912 sub drop_geometry_column
916 my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
917 $field->table->schema->name,
923 sub add_geometry_constraints{
926 my @constraints = create_geometry_constraints($field);
928 my $out = join("\n", map { alter_create_constraint($_); } @constraints);
933 sub drop_geometry_constraints{
936 my @constraints = create_geometry_constraints($field);
938 my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
944 my ($to_table, $options) = @_;
945 my $qt = $options->{quote_table_names} || '';
946 my $out = sprintf('ALTER TABLE %s %s',
947 $qt . $to_table->name . $qt,
948 $options->{alter_table_action});
949 $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
954 my ($old_table, $new_table, $options) = @_;
955 my $qt = $options->{quote_table_names} || '';
956 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
958 my @geometry_changes;
959 push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
960 push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
962 $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
964 return alter_table($old_table, $options);
967 sub alter_create_index {
968 my ($index, $options) = @_;
969 my $qt = $options->{quote_table_names} || '';
970 my $qf = $options->{quote_field_names} || '';
971 my ($idef, $constraints) = create_index($index, {
972 quote_field_names => $qf,
973 quote_table_names => $qt,
974 table_name => $index->table->name,
976 return $index->type eq NORMAL ? $idef
977 : sprintf('ALTER TABLE %s ADD %s',
978 $qt . $index->table->name . $qt,
979 join(q{}, @$constraints)
983 sub alter_drop_index {
984 my ($index, $options) = @_;
985 my $index_name = $index->name;
986 return "DROP INDEX $index_name";
989 sub alter_drop_constraint {
990 my ($c, $options) = @_;
991 my $qt = $options->{quote_table_names} || '';
992 my $qc = $options->{quote_field_names} || '';
993 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
994 $qt . $c->table->name . $qt,
995 $qc . $c->name . $qc );
999 sub alter_create_constraint {
1000 my ($index, $options) = @_;
1001 my $qt = $options->{quote_table_names} || '';
1002 my ($defs, $fks) = create_constraint(@_);
1004 # return if there are no constraint definitions so we don't run
1005 # into output like this:
1006 # ALTER TABLE users ADD ;
1008 return unless(@{$defs} || @{$fks});
1009 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
1010 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
1011 'ADD', join(q{}, @{$defs}, @{$fks})
1016 my ($table, $options) = @_;
1017 my $qt = $options->{quote_table_names} || '';
1018 my $out = "DROP TABLE $qt$table$qt CASCADE";
1020 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
1022 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
1028 # -------------------------------------------------------------------
1029 # Life is full of misery, loneliness, and suffering --
1030 # and it's all over much too soon.
1032 # -------------------------------------------------------------------
1038 SQL::Translator, SQL::Translator::Producer::Oracle.
1042 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.