1 package SQL::Translator::Producer::PostgreSQL;
3 # -------------------------------------------------------------------
5 # -------------------------------------------------------------------
6 # Copyright (C) 2002-4 SQLFairy Authors
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # -------------------------------------------------------------------
25 SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator
29 my $t = SQL::Translator->new( parser => '...', producer => 'PostgreSQL' );
34 Creates a DDL suitable for PostgreSQL. Very heavily based on the Oracle
41 use vars qw[ $DEBUG $WARN $VERSION %used_names ];
42 $VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
43 $DEBUG = 0 unless defined $DEBUG;
45 use base qw(SQL::Translator::Producer);
46 use SQL::Translator::Schema::Constants;
47 use SQL::Translator::Utils qw(debug header_comment);
64 mediumint => 'integer',
65 smallint => 'smallint',
66 tinyint => 'smallint',
68 varchar => 'character varying',
75 mediumblob => 'bytea',
77 enum => 'character varying',
78 set => 'character varying',
80 datetime => 'timestamp',
82 timestamp => 'timestamp',
90 varchar2 => 'character varying',
100 varchar => 'character varying',
101 datetime => 'timestamp',
106 tinyint => 'smallint',
112 my %reserved = map { $_, 1 } qw[
113 ALL ANALYSE ANALYZE AND ANY AS ASC
115 CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
116 CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
117 DEFAULT DEFERRABLE DESC DISTINCT DO
119 FALSE FOR FOREIGN FREEZE FROM FULL
121 ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
122 JOIN LEADING LEFT LIKE LIMIT
123 NATURAL NEW NOT NOTNULL NULL
124 OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
125 PRIMARY PUBLIC REFERENCES RIGHT
126 SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
127 UNION UNIQUE USER USING VERBOSE WHEN WHERE
130 # my $max_id_length = 62;
131 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 local %used_names = ();
188 my $postgres_version = $pargs->{postgres_version} || 0;
191 $qt = '"' if ($translator->quote_table_names);
193 $qf = '"' if ($translator->quote_field_names);
196 $output .= header_comment unless ($no_comments);
198 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 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 $output = join(";\n\n", @table_defs) . ";\n\n";
223 $output .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
224 $output .= join( ";\n\n", @fks ) . ";\n";
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";
243 # -------------------------------------------------------------------
245 my $basename = shift || '';
246 my $type = shift || '';
247 my $scope = shift || '';
248 my $critical = shift || '';
249 my $basename_orig = $basename;
250 # my $max_id_length = 62;
252 ? $max_id_length - (length($type) + 1)
254 $basename = substr( $basename, 0, $max_name )
255 if length( $basename ) > $max_name;
256 my $name = $type ? "${type}_$basename" : $basename;
258 if ( $basename ne $basename_orig and $critical ) {
259 my $show_type = $type ? "+'$type'" : "";
260 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
261 "character limit to make '$name'\n" if $WARN;
262 $truncated{ $basename_orig } = $name;
265 $scope ||= \%global_names;
266 if ( my $prev = $scope->{ $name } ) {
267 my $name_orig = $name;
268 $name .= sprintf( "%02d", ++$prev );
269 substr($name, $max_id_length - 3) = "00"
270 if length( $name ) > $max_id_length;
272 warn "The name '$name_orig' has been changed to ",
273 "'$name' to make it unique.\n" if $WARN;
275 $scope->{ $name_orig }++;
282 # -------------------------------------------------------------------
284 my $name = shift || '';
285 my $schema_obj_name = shift || '';
287 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
289 # also trap fields that don't begin with a letter
290 return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
292 if ( $schema_obj_name ) {
293 ++$unreserve{"$schema_obj_name.$name"};
296 ++$unreserve{"$name (table name)"};
299 my $unreserve = sprintf '%s_', $name;
300 return $unreserve.$suffix;
303 # -------------------------------------------------------------------
304 sub next_unused_name {
305 my $name = shift || '';
306 if ( !defined( $used_names{$name} ) ) {
307 $used_names{$name} = $name;
312 while ( defined( $used_names{ $name . $i } ) ) {
316 $used_names{$name} = $name;
323 my ($table, $options) = @_;
325 my $qt = $options->{quote_table_names} || '';
326 my $qf = $options->{quote_field_names} || '';
327 my $no_comments = $options->{no_comments} || 0;
328 my $add_drop_table = $options->{add_drop_table} || 0;
329 my $postgres_version = $options->{postgres_version} || 0;
331 my $table_name = $table->name or next;
332 $table_name = mk_name( $table_name, '', undef, 1 );
333 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
334 my $table_name_ur = $qt ? $table_name
335 : $fql_tbl_name ? join('.', $table_name, unreserve($fql_tbl_name))
336 : unreserve($table_name);
337 $table->name($table_name_ur);
339 # print STDERR "$table_name table_name\n";
340 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
342 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
344 if ( $table->comments and !$no_comments ){
345 my $c = "-- Comments: \n-- ";
346 $c .= join "\n-- ", $table->comments;
354 my %field_name_scope;
355 for my $field ( $table->get_fields ) {
356 push @field_defs, create_field($field, { quote_table_names => $qt,
357 quote_field_names => $qf,
358 table_name => $table_name_ur,
359 postgres_version => $postgres_version,
360 type_defs => \@type_defs,
361 type_drops => \@type_drops,
362 constraint_defs => \@constraint_defs,});
369 # my $idx_name_default;
370 for my $index ( $table->get_indices ) {
371 my ($idef, $constraints) = create_index($index,
373 quote_field_names => $qf,
374 quote_table_names => $qt,
375 table_name => $table_name,
377 $idef and push @index_defs, $idef;
378 push @constraint_defs, @$constraints;
385 for my $c ( $table->get_constraints ) {
386 my ($cdefs, $fks) = create_constraint($c,
388 quote_field_names => $qf,
389 quote_table_names => $qt,
390 table_name => $table_name,
392 push @constraint_defs, @$cdefs;
399 if(exists $table->{extra}{temporary}) {
400 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
403 my $create_statement;
404 $create_statement = join("\n", @comments);
405 if ($add_drop_table) {
406 if ($postgres_version >= 8.2) {
407 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
408 $create_statement .= join ("\n", @type_drops) . "\n"
409 if $postgres_version >= 8.3;
411 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
414 $create_statement .= join("\n", @type_defs) . "\n"
415 if $postgres_version >= 8.3;
416 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
417 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
420 $create_statement .= @index_defs ? ';' : q{};
421 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
422 . join(";\n", @index_defs);
424 return $create_statement, \@fks;
428 my ($view, $options) = @_;
429 my $qt = $options->{quote_table_names} || '';
430 my $qf = $options->{quote_field_names} || '';
431 my $add_drop_view = $options->{add_drop_view};
433 my $view_name = $view->name;
434 debug("PKG: Looking at view '${view_name}'\n");
437 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
438 unless $options->{no_comments};
439 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
442 my $extra = $view->extra;
443 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
444 $create .= " VIEW ${qt}${view_name}${qt}";
446 if ( my @fields = $view->fields ) {
447 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
448 $create .= " ( ${field_list} )";
451 if ( my $sql = $view->sql ) {
452 $create .= " AS (\n ${sql}\n )";
455 if ( $extra->{check_option} ) {
456 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
464 my %field_name_scope;
468 my ($field, $options) = @_;
470 my $qt = $options->{quote_table_names} || '';
471 my $qf = $options->{quote_field_names} || '';
472 my $table_name = $field->table->name;
473 my $constraint_defs = $options->{constraint_defs} || [];
474 my $postgres_version = $options->{postgres_version} || 0;
475 my $type_defs = $options->{type_defs} || [];
476 my $type_drops = $options->{type_drops} || [];
478 $field_name_scope{$table_name} ||= {};
479 my $field_name = mk_name(
480 $field->name, '', $field_name_scope{$table_name}, 1
482 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
483 $field->name($field_name_ur);
484 my $field_comments = $field->comments
485 ? "-- " . $field->comments . "\n "
488 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
493 my @size = $field->size;
494 my $data_type = lc $field->data_type;
495 my %extra = $field->extra;
496 my $list = $extra{'list'} || [];
497 # todo deal with embedded quotes
498 my $commalist = join( ', ', map { qq['$_'] } @$list );
500 if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
501 my $type_name = $field->table->name . '_' . $field->name . '_type';
502 $field_def .= ' '. $type_name;
503 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
504 push @$type_drops, "DROP TYPE IF EXISTS $type_name";
506 $field_def .= ' '. convert_datatype($field);
512 my $default = $field->default_value;
513 if ( defined $default ) {
514 SQL::Translator::Producer->_apply_default_value(
520 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
526 # Not null constraint
528 $field_def .= ' NOT NULL' unless $field->is_nullable;
536 my ($index, $options) = @_;
538 my $qt = $options->{quote_table_names} ||'';
539 my $qf = $options->{quote_field_names} ||'';
540 my $table_name = $index->table->name;
541 # my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
543 my ($index_def, @constraint_defs);
545 my $name = $index->name || '';
547 $name = next_unused_name($name);
550 my $type = $index->type || NORMAL;
552 map { $_ =~ s/\(.+\)//; $_ }
553 map { $qt ? $_ : unreserve($_, $table_name ) }
557 my $def_start = qq[CONSTRAINT "$name" ];
558 if ( $type eq PRIMARY_KEY ) {
559 push @constraint_defs, "${def_start}PRIMARY KEY ".
560 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
562 elsif ( $type eq UNIQUE ) {
563 push @constraint_defs, "${def_start}UNIQUE " .
564 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
566 elsif ( $type eq NORMAL ) {
568 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
569 join( ', ', map { qq[$qf$_$qf] } @fields ).
574 warn "Unknown index type ($type) on table $table_name.\n"
578 return $index_def, \@constraint_defs;
581 sub create_constraint
583 my ($c, $options) = @_;
585 my $qf = $options->{quote_field_names} ||'';
586 my $qt = $options->{quote_table_names} ||'';
587 my $table_name = $c->table->name;
588 my (@constraint_defs, @fks);
590 my $name = $c->name || '';
592 $name = next_unused_name($name);
596 map { $_ =~ s/\(.+\)//; $_ }
597 map { $qt ? $_ : unreserve( $_, $table_name )}
601 map { $_ =~ s/\(.+\)//; $_ }
602 map { $qt ? $_ : unreserve( $_, $table_name )}
603 $c->reference_fields;
605 next if !@fields && $c->type ne CHECK_C;
606 my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
607 if ( $c->type eq PRIMARY_KEY ) {
608 push @constraint_defs, "${def_start}PRIMARY KEY ".
609 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
611 elsif ( $c->type eq UNIQUE ) {
612 $name = next_unused_name($name);
613 push @constraint_defs, "${def_start}UNIQUE " .
614 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
616 elsif ( $c->type eq CHECK_C ) {
617 my $expression = $c->expression;
618 push @constraint_defs, "${def_start}CHECK ($expression)";
620 elsif ( $c->type eq FOREIGN_KEY ) {
621 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
622 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
623 "\n REFERENCES " . $qt . $c->reference_table . $qt;
626 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
629 if ( $c->match_type ) {
631 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
634 if ( $c->on_delete ) {
635 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
638 if ( $c->on_update ) {
639 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
642 if ( $c->deferrable ) {
643 $def .= ' DEFERRABLE';
649 return \@constraint_defs, \@fks;
656 my @size = $field->size;
657 my $data_type = lc $field->data_type;
659 if ( $data_type eq 'enum' ) {
661 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
662 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
663 # push @$constraint_defs,
664 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
665 # qq[IN ($commalist))];
666 $data_type = 'character varying';
668 elsif ( $data_type eq 'set' ) {
669 $data_type = 'character varying';
671 elsif ( $field->is_auto_increment ) {
672 if ( defined $size[0] && $size[0] > 11 ) {
673 $data_type = 'bigserial';
676 $data_type = 'serial';
681 $data_type = defined $translate{ $data_type } ?
682 $translate{ $data_type } :
686 if ( $data_type =~ /timestamp/i ) {
687 if ( defined $size[0] && $size[0] > 6 ) {
692 if ( $data_type eq 'integer' ) {
693 if ( defined $size[0] && $size[0] > 0) {
694 if ( $size[0] > 10 ) {
695 $data_type = 'bigint';
697 elsif ( $size[0] < 5 ) {
698 $data_type = 'smallint';
701 $data_type = 'integer';
705 $data_type = 'integer';
708 my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
709 integer smallint text line lseg macaddr money
710 path point polygon real/;
711 foreach (@type_without_size) {
712 if ( $data_type =~ qr/$_/ ) {
717 if ( defined $size[0] && $size[0] > 0 ) {
718 $data_type .= '(' . join( ',', @size ) . ')';
720 elsif (defined $size[0] && $data_type eq 'timestamp' ) {
721 $data_type .= '(' . join( ',', @size ) . ')';
731 my ($from_field, $to_field) = @_;
733 die "Can't alter field in another table"
734 if($from_field->table->name ne $to_field->table->name);
737 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
738 $to_field->table->name,
739 $to_field->name) if(!$to_field->is_nullable and
740 $from_field->is_nullable);
742 my $from_dt = convert_datatype($from_field);
743 my $to_dt = convert_datatype($to_field);
744 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
745 $to_field->table->name,
747 $to_dt) if($to_dt ne $from_dt);
749 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
750 $to_field->table->name,
752 $to_field->name) if($from_field->name ne $to_field->name);
754 my $old_default = $from_field->default_value;
755 my $new_default = $to_field->default_value;
756 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
757 $to_field->table->name,
759 $to_field->default_value)
760 if ( defined $new_default &&
761 (!defined $old_default || $old_default ne $new_default) );
763 return wantarray ? @out : join("\n", @out);
766 sub rename_field { alter_field(@_) }
770 my ($new_field) = @_;
772 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
773 $new_field->table->name,
774 create_field($new_field));
781 my ($old_field) = @_;
783 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
784 $old_field->table->name,
791 my ($to_table, $options) = @_;
792 my $qt = $options->{quote_table_names} || '';
793 my $out = sprintf('ALTER TABLE %s %s',
794 $qt . $to_table->name . $qt,
795 $options->{alter_table_action});
800 my ($old_table, $new_table, $options) = @_;
801 my $qt = $options->{quote_table_names} || '';
802 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
803 return alter_table($old_table, $options);
806 sub alter_create_index {
807 my ($index, $options) = @_;
808 my $qt = $options->{quote_table_names} || '';
809 my $qf = $options->{quote_field_names} || '';
810 my ($idef, $constraints) = create_index($index, {
811 quote_field_names => $qf,
812 quote_table_names => $qt,
813 table_name => $index->table->name,
815 return $index->type eq NORMAL ? $idef
816 : sprintf('ALTER TABLE %s ADD %s',
817 $qt . $index->table->name . $qt,
818 join(q{}, @$constraints)
822 sub alter_drop_index {
823 my ($index, $options) = @_;
824 my $index_name = $index->name;
825 return "DROP INDEX $index_name";
828 sub alter_drop_constraint {
829 my ($c, $options) = @_;
830 my $qt = $options->{quote_table_names} || '';
831 my $qc = $options->{quote_field_names} || '';
832 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
833 $qt . $c->table->name . $qt,
834 $qc . $c->name . $qc );
838 sub alter_create_constraint {
839 my ($index, $options) = @_;
840 my $qt = $options->{quote_table_names} || '';
841 return $index->type eq FOREIGN_KEY ? join(q{}, @{create_constraint(@_)})
842 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
843 'ADD', join(q{}, map { @{$_} } create_constraint(@_))
848 my ($table, $options) = @_;
849 my $qt = $options->{quote_table_names} || '';
850 return "DROP TABLE $qt$table$qt CASCADE";
855 # -------------------------------------------------------------------
856 # Life is full of misery, loneliness, and suffering --
857 # and it's all over much too soon.
859 # -------------------------------------------------------------------
865 SQL::Translator, SQL::Translator::Producer::Oracle.
869 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.