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 add_drop_view => $add_drop_table,
216 quote_table_names => $qt,
217 quote_field_names => $qf,
218 no_comments => $no_comments,
222 push @output, map { "$_;\n\n" } values %type_defs;
223 push @output, map { "$_;\n\n" } @table_defs;
225 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
226 push @output, map { "$_;\n\n" } @fks;
231 warn "Truncated " . keys( %truncated ) . " names:\n";
232 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
238 : join ('', @output);
241 # -------------------------------------------------------------------
243 my $basename = shift || '';
244 my $type = shift || '';
245 my $scope = shift || '';
246 my $critical = shift || '';
247 my $basename_orig = $basename;
248 # my $max_id_length = 62;
250 ? $max_id_length - (length($type) + 1)
252 $basename = substr( $basename, 0, $max_name )
253 if length( $basename ) > $max_name;
254 my $name = $type ? "${type}_$basename" : $basename;
256 if ( $basename ne $basename_orig and $critical ) {
257 my $show_type = $type ? "+'$type'" : "";
258 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
259 "character limit to make '$name'\n" if $WARN;
260 $truncated{ $basename_orig } = $name;
263 $scope ||= \%global_names;
264 if ( my $prev = $scope->{ $name } ) {
265 my $name_orig = $name;
266 $name .= sprintf( "%02d", ++$prev );
267 substr($name, $max_id_length - 3) = "00"
268 if length( $name ) > $max_id_length;
270 warn "The name '$name_orig' has been changed to ",
271 "'$name' to make it unique.\n" if $WARN;
273 $scope->{ $name_orig }++;
280 # -------------------------------------------------------------------
281 sub next_unused_name {
282 my $orig_name = shift or return;
283 my $name = $orig_name;
285 my $suffix_gen = sub {
287 return ++$suffix ? '' : $suffix;
291 $name = $orig_name . $suffix_gen->();
292 last if $used_names{ $name }++;
301 return 1 if $field->data_type eq 'geometry';
307 return 1 if $field->data_type eq 'geography';
312 my ($table, $options) = @_;
314 my $qt = $options->{quote_table_names} || '';
315 my $qf = $options->{quote_field_names} || '';
316 my $no_comments = $options->{no_comments} || 0;
317 my $add_drop_table = $options->{add_drop_table} || 0;
318 my $postgres_version = $options->{postgres_version} || 0;
319 my $type_defs = $options->{type_defs} || {};
321 my $table_name = $table->name or next;
322 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
323 my $table_name_ur = $qt ? $table_name
324 : $fql_tbl_name ? join('.', $table_name, $fql_tbl_name)
326 $table->name($table_name_ur);
328 # print STDERR "$table_name table_name\n";
329 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
331 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
333 if ( $table->comments and !$no_comments ){
334 my $c = "-- Comments: \n-- ";
335 $c .= join "\n-- ", $table->comments;
343 my %field_name_scope;
344 for my $field ( $table->get_fields ) {
345 push @field_defs, create_field($field, { quote_table_names => $qt,
346 quote_field_names => $qf,
347 table_name => $table_name_ur,
348 postgres_version => $postgres_version,
349 type_defs => $type_defs,
350 constraint_defs => \@constraint_defs,});
357 # my $idx_name_default;
358 for my $index ( $table->get_indices ) {
359 my ($idef, $constraints) = create_index($index,
361 quote_field_names => $qf,
362 quote_table_names => $qt,
363 table_name => $table_name,
365 $idef and push @index_defs, $idef;
366 push @constraint_defs, @$constraints;
373 for my $c ( $table->get_constraints ) {
374 my ($cdefs, $fks) = create_constraint($c,
376 quote_field_names => $qf,
377 quote_table_names => $qt,
378 table_name => $table_name,
380 push @constraint_defs, @$cdefs;
387 if(exists $table->{extra}{temporary}) {
388 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
391 my $create_statement;
392 $create_statement = join("\n", @comments);
393 if ($add_drop_table) {
394 if ($postgres_version >= 8.002) {
395 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
397 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
400 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
401 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
404 $create_statement .= @index_defs ? ';' : q{};
405 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
406 . join(";\n", @index_defs);
411 if(grep { is_geometry($_) } $table->get_fields){
412 $create_statement .= ";";
413 my @geometry_columns;
414 foreach my $col ($table->get_fields) { push(@geometry_columns,$col) if is_geometry($col); }
415 $create_statement .= "\n".join("\n", map{ drop_geometry_column($_) } @geometry_columns) if $options->{add_drop_table};
416 $create_statement .= "\n".join("\n", map{ add_geometry_column($_) } @geometry_columns);
419 return $create_statement, \@fks;
423 my ($view, $options) = @_;
424 my $qt = $options->{quote_table_names} || '';
425 my $qf = $options->{quote_field_names} || '';
426 my $add_drop_view = $options->{add_drop_view};
428 my $view_name = $view->name;
429 debug("PKG: Looking at view '${view_name}'\n");
432 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
433 unless $options->{no_comments};
434 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
437 my $extra = $view->extra;
438 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
439 $create .= " VIEW ${qt}${view_name}${qt}";
441 if ( my @fields = $view->fields ) {
442 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
443 $create .= " ( ${field_list} )";
446 if ( my $sql = $view->sql ) {
447 $create .= " AS\n ${sql}\n";
450 if ( $extra->{check_option} ) {
451 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
459 my %field_name_scope;
463 my ($field, $options) = @_;
465 my $qt = $options->{quote_table_names} || '';
466 my $qf = $options->{quote_field_names} || '';
467 my $table_name = $field->table->name;
468 my $constraint_defs = $options->{constraint_defs} || [];
469 my $postgres_version = $options->{postgres_version} || 0;
470 my $type_defs = $options->{type_defs} || {};
472 $field_name_scope{$table_name} ||= {};
473 my $field_name = $field->name;
474 my $field_comments = $field->comments
475 ? "-- " . $field->comments . "\n "
478 my $field_def = $field_comments.qq[$qf$field_name$qf];
483 my @size = $field->size;
484 my $data_type = lc $field->data_type;
485 my %extra = $field->extra;
486 my $list = $extra{'list'} || [];
487 # todo deal with embedded quotes
488 my $commalist = join( ', ', map { qq['$_'] } @$list );
490 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
491 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
492 $field_def .= ' '. $type_name;
493 my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
494 "CREATE TYPE $type_name AS ENUM ($commalist)";
495 if (! exists $type_defs->{$type_name} ) {
496 $type_defs->{$type_name} = $new_type_def;
497 } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
498 die "Attempted to redefine type name '$type_name' as a different type.\n";
501 $field_def .= ' '. convert_datatype($field);
507 SQL::Translator::Producer->_apply_default_value(
513 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
518 # Not null constraint
520 $field_def .= ' NOT NULL' unless $field->is_nullable;
523 # Geometry constraints
525 if(is_geometry($field)){
526 foreach ( create_geometry_constraints($field) ) {
527 my ($cdefs, $fks) = create_constraint($_,
529 quote_field_names => $qf,
530 quote_table_names => $qt,
531 table_name => $table_name,
533 push @$constraint_defs, @$cdefs;
542 sub create_geometry_constraints{
546 push @constraints, SQL::Translator::Schema::Constraint->new(
547 name => "enforce_dims_".$field->name,
548 expression => "(st_ndims($field) = ".$field->{extra}{dimensions}.")",
549 table => $field->table,
553 push @constraints, SQL::Translator::Schema::Constraint->new(
554 name => "enforce_srid_".$field->name,
555 expression => "(st_srid($field) = ".$field->{extra}{srid}.")",
556 table => $field->table,
559 push @constraints, SQL::Translator::Schema::Constraint->new(
560 name => "enforce_geotype_".$field->name,
561 expression => "(geometrytype($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
562 table => $field->table,
571 my ($index, $options) = @_;
573 my $qt = $options->{quote_table_names} ||'';
574 my $qf = $options->{quote_field_names} ||'';
575 my $table_name = $index->table->name;
577 my ($index_def, @constraint_defs);
579 my $name = next_unused_name(
581 || join('_', $table_name, 'idx', ++$index_name{ $table_name })
584 my $type = $index->type || NORMAL;
585 my @fields = $index->fields;
588 my $def_start = qq[CONSTRAINT ${qf}$name${qf} ];
589 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
590 if ( $type eq PRIMARY_KEY ) {
591 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
593 elsif ( $type eq UNIQUE ) {
594 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
596 elsif ( $type eq NORMAL ) {
598 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} ".$field_names
602 warn "Unknown index type ($type) on table $table_name.\n"
606 return $index_def, \@constraint_defs;
609 sub create_constraint
611 my ($c, $options) = @_;
613 my $qf = $options->{quote_field_names} ||'';
614 my $qt = $options->{quote_table_names} ||'';
615 my $table_name = $c->table->name;
616 my (@constraint_defs, @fks);
618 my $name = $c->name || '';
620 $name = next_unused_name($name);
623 my @fields = grep { defined } $c->fields;
625 my @rfields = grep { defined } $c->reference_fields;
627 next if !@fields && $c->type ne CHECK_C;
628 my $def_start = $name ? qq[CONSTRAINT ${qf}$name${qf} ] : '';
629 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
630 if ( $c->type eq PRIMARY_KEY ) {
631 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
633 elsif ( $c->type eq UNIQUE ) {
634 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
636 elsif ( $c->type eq CHECK_C ) {
637 my $expression = $c->expression;
638 push @constraint_defs, "${def_start}CHECK ($expression)";
640 elsif ( $c->type eq FOREIGN_KEY ) {
641 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY " . $field_names .
642 "\n REFERENCES " . $qt . $c->reference_table . $qt;
645 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
648 if ( $c->match_type ) {
650 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
653 if ( $c->on_delete ) {
654 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
657 if ( $c->on_update ) {
658 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
661 if ( $c->deferrable ) {
662 $def .= ' DEFERRABLE';
668 return \@constraint_defs, \@fks;
675 my @size = $field->size;
676 my $data_type = lc $field->data_type;
678 if ( $data_type eq 'enum' ) {
680 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
681 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
682 # push @$constraint_defs,
683 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
684 # qq[IN ($commalist))];
685 $data_type = 'character varying';
687 elsif ( $data_type eq 'set' ) {
688 $data_type = 'character varying';
690 elsif ( $field->is_auto_increment ) {
691 if ( defined $size[0] && $size[0] > 11 ) {
692 $data_type = 'bigserial';
695 $data_type = 'serial';
700 $data_type = defined $translate{ $data_type } ?
701 $translate{ $data_type } :
705 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
706 if ( defined $size[0] && $size[0] > 6 ) {
711 if ( $data_type eq 'integer' ) {
712 if ( defined $size[0] && $size[0] > 0) {
713 if ( $size[0] > 10 ) {
714 $data_type = 'bigint';
716 elsif ( $size[0] < 5 ) {
717 $data_type = 'smallint';
720 $data_type = 'integer';
724 $data_type = 'integer';
728 my $type_with_size = join('|',
729 'bit', 'varbit', 'character', 'bit varying', 'character varying',
730 'time', 'timestamp', 'interval', 'numeric'
733 if ( $data_type !~ /$type_with_size/ ) {
737 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
738 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
739 $data_type .= $2 if(defined $2);
740 } elsif ( defined $size[0] && $size[0] > 0 ) {
741 $data_type .= '(' . join( ',', @size ) . ')';
747 if($data_type eq 'geography'){
748 $data_type .= '('.$field->{extra}{geography_type}.','. $field->{extra}{srid} .')'
757 my ($from_field, $to_field) = @_;
759 die "Can't alter field in another table"
760 if($from_field->table->name ne $to_field->table->name);
764 # drop geometry column and constraints
765 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
766 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
768 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
769 $to_field->table->name,
770 $to_field->name) if(!$to_field->is_nullable and
771 $from_field->is_nullable);
773 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
774 $to_field->table->name,
776 if ( !$from_field->is_nullable and $to_field->is_nullable );
779 my $from_dt = convert_datatype($from_field);
780 my $to_dt = convert_datatype($to_field);
781 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
782 $to_field->table->name,
784 $to_dt) if($to_dt ne $from_dt);
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);
791 my $old_default = $from_field->default_value;
792 my $new_default = $to_field->default_value;
793 my $default_value = $to_field->default_value;
795 # fixes bug where output like this was created:
796 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
797 if(ref $default_value eq "SCALAR" ) {
798 $default_value = $$default_value;
799 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
800 $default_value =~ s/'/''/xsmg;
801 $default_value = q(') . $default_value . q(');
804 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
805 $to_field->table->name,
808 if ( defined $new_default &&
809 (!defined $old_default || $old_default ne $new_default) );
811 # fixes bug where removing the DEFAULT statement of a column
812 # would result in no change
814 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
815 $to_field->table->name,
817 if ( !defined $new_default && defined $old_default );
819 # add geometry column and contraints
820 push @out, add_geometry_column($to_field) if is_geometry($to_field);
821 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
823 return wantarray ? @out : join("\n", @out);
826 sub rename_field { alter_field(@_) }
830 my ($new_field) = @_;
832 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
833 $new_field->table->name,
834 create_field($new_field));
835 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
836 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
843 my ($old_field) = @_;
845 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
846 $old_field->table->name,
848 $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
852 sub add_geometry_column{
853 my ($field,$options) = @_;
855 my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
857 $field->table->schema->name,
858 $options->{table} ? $options->{table} : $field->table->name,
860 $field->{extra}{dimensions},
861 $field->{extra}{srid},
862 $field->{extra}{geometry_type});
866 sub drop_geometry_column
870 my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
871 $field->table->schema->name,
877 sub add_geometry_constraints{
880 my @constraints = create_geometry_constraints($field);
882 my $out = join("\n", map { alter_create_constraint($_); } @constraints);
887 sub drop_geometry_constraints{
890 my @constraints = create_geometry_constraints($field);
892 my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
898 my ($to_table, $options) = @_;
899 my $qt = $options->{quote_table_names} || '';
900 my $out = sprintf('ALTER TABLE %s %s',
901 $qt . $to_table->name . $qt,
902 $options->{alter_table_action});
903 $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
908 my ($old_table, $new_table, $options) = @_;
909 my $qt = $options->{quote_table_names} || '';
910 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
912 my @geometry_changes;
913 push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
914 push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
916 $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
918 return alter_table($old_table, $options);
921 sub alter_create_index {
922 my ($index, $options) = @_;
923 my $qt = $options->{quote_table_names} || '';
924 my $qf = $options->{quote_field_names} || '';
925 my ($idef, $constraints) = create_index($index, {
926 quote_field_names => $qf,
927 quote_table_names => $qt,
928 table_name => $index->table->name,
930 return $index->type eq NORMAL ? $idef
931 : sprintf('ALTER TABLE %s ADD %s',
932 $qt . $index->table->name . $qt,
933 join(q{}, @$constraints)
937 sub alter_drop_index {
938 my ($index, $options) = @_;
939 my $index_name = $index->name;
940 return "DROP INDEX $index_name";
943 sub alter_drop_constraint {
944 my ($c, $options) = @_;
945 my $qt = $options->{quote_table_names} || '';
946 my $qc = $options->{quote_field_names} || '';
947 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
948 $qt . $c->table->name . $qt,
949 $qc . $c->name . $qc );
953 sub alter_create_constraint {
954 my ($index, $options) = @_;
955 my $qt = $options->{quote_table_names} || '';
956 my ($defs, $fks) = create_constraint(@_);
958 # return if there are no constraint definitions so we don't run
959 # into output like this:
960 # ALTER TABLE users ADD ;
962 return unless(@{$defs} || @{$fks});
963 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
964 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
965 'ADD', join(q{}, @{$defs}, @{$fks})
970 my ($table, $options) = @_;
971 my $qt = $options->{quote_table_names} || '';
972 my $out = "DROP TABLE $qt$table$qt CASCADE";
974 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
976 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
982 # -------------------------------------------------------------------
983 # Life is full of misery, loneliness, and suffering --
984 # and it's all over much too soon.
986 # -------------------------------------------------------------------
992 SQL::Translator, SQL::Translator::Producer::Oracle.
996 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.