1 package SQL::Translator::Producer::PostgreSQL;
3 # -------------------------------------------------------------------
4 # $Id: PostgreSQL.pm,v 1.29 2007-06-04 04:01:14 mwz444 Exp $
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 ];
42 $VERSION = sprintf "%d.%02d", q$Revision: 1.29 $ =~ /(\d+)\.(\d+)/;
43 $DEBUG = 1 unless defined $DEBUG;
45 use SQL::Translator::Schema::Constants;
46 use SQL::Translator::Utils qw(header_comment);
63 mediumint => 'integer',
64 smallint => 'smallint',
65 tinyint => 'smallint',
67 varchar => 'character varying',
74 mediumblob => 'bytea',
76 enum => 'character varying',
77 set => 'character varying',
79 datetime => 'timestamp',
81 timestamp => 'timestamp',
89 varchar2 => 'character varying',
99 varchar => 'character varying',
100 datetime => 'timestamp',
105 tinyint => 'smallint',
111 my %reserved = map { $_, 1 } qw[
112 ALL ANALYSE ANALYZE AND ANY AS ASC
114 CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
115 CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
116 DEFAULT DEFERRABLE DESC DISTINCT DO
118 FALSE FOR FOREIGN FREEZE FROM FULL
120 ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
121 JOIN LEADING LEFT LIKE LIMIT
122 NATURAL NEW NOT NOTNULL NULL
123 OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
124 PRIMARY PUBLIC REFERENCES RIGHT
125 SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
126 UNION UNIQUE USER USING VERBOSE WHEN WHERE
129 # my $max_id_length = 62;
130 my %used_identifiers = ();
137 =head1 PostgreSQL Create Table Syntax
139 CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
140 { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
141 | table_constraint } [, ... ]
143 [ INHERITS ( parent_table [, ... ] ) ]
144 [ WITH OIDS | WITHOUT OIDS ]
146 where column_constraint is:
148 [ CONSTRAINT constraint_name ]
149 { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
151 REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
152 [ ON DELETE action ] [ ON UPDATE action ] }
153 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
155 and table_constraint is:
157 [ CONSTRAINT constraint_name ]
158 { UNIQUE ( column_name [, ... ] ) |
159 PRIMARY KEY ( column_name [, ... ] ) |
160 CHECK ( expression ) |
161 FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
162 [ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
163 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
165 =head1 Create Index Syntax
167 CREATE [ UNIQUE ] INDEX index_name ON table
168 [ USING acc_method ] ( column [ ops_name ] [, ...] )
170 CREATE [ UNIQUE ] INDEX index_name ON table
171 [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
176 # -------------------------------------------------------------------
178 my $translator = shift;
179 $DEBUG = $translator->debug;
180 $WARN = $translator->show_warnings;
181 my $no_comments = $translator->no_comments;
182 my $add_drop_table = $translator->add_drop_table;
183 my $schema = $translator->schema;
186 $qt = '"' if ($translator->quote_table_names);
188 $qf = '"' if ($translator->quote_field_names);
191 $output .= header_comment unless ($no_comments);
192 # my %used_index_names;
194 my (@table_defs, @fks);
195 for my $table ( $schema->get_tables ) {
197 my ($table_def, $fks) = create_table($table,
198 { quote_table_names => $qt,
199 quote_field_names => $qf,
200 no_comments => $no_comments,
201 add_drop_table => $add_drop_table,});
202 push @table_defs, $table_def;
207 $output = join("\n\n", @table_defs);
209 $output .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
210 $output .= join( "\n\n", @fks ) . "\n";
215 warn "Truncated " . keys( %truncated ) . " names:\n";
216 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
220 warn "Encounted " . keys( %unreserve ) .
221 " unsafe names in schema (reserved or invalid):\n";
222 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
229 # -------------------------------------------------------------------
231 my $basename = shift || '';
232 my $type = shift || '';
233 my $scope = shift || '';
234 my $critical = shift || '';
235 my $basename_orig = $basename;
236 # my $max_id_length = 62;
238 ? $max_id_length - (length($type) + 1)
240 $basename = substr( $basename, 0, $max_name )
241 if length( $basename ) > $max_name;
242 my $name = $type ? "${type}_$basename" : $basename;
244 if ( $basename ne $basename_orig and $critical ) {
245 my $show_type = $type ? "+'$type'" : "";
246 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
247 "character limit to make '$name'\n" if $WARN;
248 $truncated{ $basename_orig } = $name;
251 $scope ||= \%global_names;
252 if ( my $prev = $scope->{ $name } ) {
253 my $name_orig = $name;
254 $name .= sprintf( "%02d", ++$prev );
255 substr($name, $max_id_length - 3) = "00"
256 if length( $name ) > $max_id_length;
258 warn "The name '$name_orig' has been changed to ",
259 "'$name' to make it unique.\n" if $WARN;
261 $scope->{ $name_orig }++;
268 # -------------------------------------------------------------------
270 my $name = shift || '';
271 my $schema_obj_name = shift || '';
273 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
275 # also trap fields that don't begin with a letter
276 return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
278 if ( $schema_obj_name ) {
279 ++$unreserve{"$schema_obj_name.$name"};
282 ++$unreserve{"$name (table name)"};
285 my $unreserve = sprintf '%s_', $name;
286 return $unreserve.$suffix;
289 # -------------------------------------------------------------------
290 sub next_unused_name {
291 my $name = shift || '';
292 my $used_names = shift || '';
294 my %used_names = %$used_names;
296 if ( !defined($used_names{$name}) ) {
297 $used_names{$name} = $name;
302 while ( defined($used_names{$name . $i}) ) {
306 $used_names{$name} = $name;
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;
319 my $table_name = $table->name or next;
320 $table_name = mk_name( $table_name, '', undef, 1 );
321 my $table_name_ur = $qt ? $table_name : unreserve($table_name);
322 $table->name($table_name_ur);
324 # print STDERR "$table_name table_name\n";
325 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
327 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
329 if ( $table->comments and !$no_comments ){
330 my $c = "-- Comments: \n-- ";
331 $c .= join "\n-- ", $table->comments;
339 my %field_name_scope;
340 for my $field ( $table->get_fields ) {
341 push @field_defs, create_field($field, { quote_table_names => $qt,
342 quote_field_names => $qf,
343 table_name => $table_name_ur,
344 constraint_defs => \@constraint_defs,});
351 # my $idx_name_default;
352 for my $index ( $table->get_indices ) {
353 my ($idef, $constraints) = create_index($index,
355 quote_field_names => $qf,
356 quote_table_names => $qt,
357 table_name => $table_name,
359 $idef and push @index_defs, $idef;
360 push @constraint_defs, @$constraints;
367 for my $c ( $table->get_constraints ) {
368 my ($cdefs, $fks) = create_constraint($c,
370 quote_field_names => $qf,
371 quote_table_names => $qt,
372 table_name => $table_name,
374 push @constraint_defs, @$cdefs;
378 my $create_statement;
379 $create_statement = join("\n", @comments);
380 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n]
382 $create_statement .= qq[CREATE TABLE $qt$table_name_ur$qt (\n].
383 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
387 $create_statement .= "\n" . join(";\n", @index_defs) . "\n";
389 return $create_statement, \@fks;
394 my %field_name_scope;
398 my ($field, $options) = @_;
400 my $qt = $options->{quote_table_names} || '';
401 my $qf = $options->{quote_field_names} || '';
402 my $table_name = $field->table->name;
403 my $constraint_defs = $options->{constraint_defs} || [];
405 $field_name_scope{$table_name} ||= {};
406 my $field_name = mk_name(
407 $field->name, '', $field_name_scope{$table_name}, 1
409 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
410 $field->name($field_name_ur);
411 my $field_comments = $field->comments
412 ? "-- " . $field->comments . "\n "
415 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
420 my @size = $field->size;
421 my $data_type = lc $field->data_type;
422 my %extra = $field->extra;
423 my $list = $extra{'list'} || [];
424 # todo deal with embedded quotes
425 my $commalist = join( ', ', map { qq['$_'] } @$list );
428 $field_def .= ' '. convert_datatype($field);
431 # Default value -- disallow for timestamps
433 # my $default = $data_type =~ /(timestamp|date)/i
434 # ? undef : $field->default_value;
435 my $default = $field->default_value;
436 if ( defined $default ) {
438 $qd = '' if ($default eq 'now()' ||
439 $default eq 'CURRENT_TIMESTAMP');
440 $field_def .= sprintf( ' DEFAULT %s',
441 ( $field->is_auto_increment && $seq_name )
442 ? qq[nextval('"$seq_name"'::text)] :
443 ( $default =~ m/null/i ) ? 'NULL' : "$qd$default$qd"
448 # Not null constraint
450 $field_def .= ' NOT NULL' unless $field->is_nullable;
457 my %used_index_names;
461 my ($index, $options) = @_;
463 my $qt = $options->{quote_table_names} ||'';
464 my $qf = $options->{quote_field_names} ||'';
465 my $table_name = $index->table->name;
466 # my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
468 my ($index_def, @constraint_defs);
470 $used_index_names{$table_name} ||= {};
471 my $name = $index->name || '';
473 $name = next_unused_name($name, $used_index_names{$table_name});
474 $used_index_names{$name} = $name;
477 my $type = $index->type || NORMAL;
479 map { $_ =~ s/\(.+\)//; $_ }
480 map { $qt ? $_ : unreserve($_, $table_name ) }
484 my $def_start = qq[Constraint "$name" ];
485 if ( $type eq PRIMARY_KEY ) {
486 push @constraint_defs, "${def_start}PRIMARY KEY ".
487 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
489 elsif ( $type eq UNIQUE ) {
490 push @constraint_defs, "${def_start}UNIQUE " .
491 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
493 elsif ( $type eq NORMAL ) {
495 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
496 join( ', ', map { qq[$qf$_$qf] } @fields ).
501 warn "Unknown index type ($type) on table $table_name.\n"
505 return $index_def, \@constraint_defs;
508 sub create_constraint
510 my ($c, $options) = @_;
512 my $qf = $options->{quote_field_names} ||'';
513 my $qt = $options->{quote_table_names} ||'';
514 my $table_name = $c->table->name;
515 my (@constraint_defs, @fks);
517 my $name = $c->name || '';
519 $name = next_unused_name($name, \%used_index_names);
520 $used_index_names{$name} = $name;
524 map { $_ =~ s/\(.+\)//; $_ }
525 map { $qt ? $_ : unreserve( $_, $table_name )}
529 map { $_ =~ s/\(.+\)//; $_ }
530 map { $qt ? $_ : unreserve( $_, $table_name )}
531 $c->reference_fields;
533 next if !@fields && $c->type ne CHECK_C;
534 my $def_start = $name ? qq[Constraint "$name" ] : '';
535 if ( $c->type eq PRIMARY_KEY ) {
536 push @constraint_defs, "${def_start}PRIMARY KEY ".
537 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
539 elsif ( $c->type eq UNIQUE ) {
540 $name = next_unused_name($name, \%used_index_names);
541 $used_index_names{$name} = $name;
542 push @constraint_defs, "${def_start}UNIQUE " .
543 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
545 elsif ( $c->type eq CHECK_C ) {
546 my $expression = $c->expression;
547 push @constraint_defs, "${def_start}CHECK ($expression)";
549 elsif ( $c->type eq FOREIGN_KEY ) {
550 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
551 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
552 "\n REFERENCES " . $qt . $c->reference_table . $qt;
555 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
558 if ( $c->match_type ) {
560 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
563 if ( $c->on_delete ) {
564 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
567 if ( $c->on_update ) {
568 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
574 return \@constraint_defs, \@fks;
582 my @size = $field->size;
583 my $data_type = lc $field->data_type;
585 if ( $data_type eq 'enum' ) {
587 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
588 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
589 # push @$constraint_defs,
590 # qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
591 # qq[IN ($commalist))];
592 $data_type = 'character varying';
594 elsif ( $data_type eq 'set' ) {
595 $data_type = 'character varying';
597 elsif ( $field->is_auto_increment ) {
598 if ( defined $size[0] && $size[0] > 11 ) {
599 $data_type = 'bigserial';
602 $data_type = 'serial';
607 $data_type = defined $translate{ $data_type } ?
608 $translate{ $data_type } :
612 if ( $data_type =~ /timestamp/i ) {
613 if ( defined $size[0] && $size[0] > 6 ) {
618 if ( $data_type eq 'integer' ) {
619 if ( defined $size[0] && $size[0] > 0) {
620 if ( $size[0] > 10 ) {
621 $data_type = 'bigint';
623 elsif ( $size[0] < 5 ) {
624 $data_type = 'smallint';
627 $data_type = 'integer';
631 $data_type = 'integer';
634 my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
635 integer smallint text line lseg macaddr money
636 path point polygon real/;
637 foreach (@type_without_size) {
638 if ( $data_type =~ qr/$_/ ) {
643 if ( defined $size[0] && $size[0] > 0 ) {
644 $data_type .= '(' . join( ',', @size ) . ')';
646 elsif (defined $size[0] && $data_type eq 'timestamp' ) {
647 $data_type .= '(' . join( ',', @size ) . ')';
657 my ($from_field, $to_field) = @_;
659 die "Can't alter field in another table"
660 if($from_field->table->name ne $to_field->table->name);
663 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
664 $to_field->table->name,
665 $to_field->name) if(!$to_field->is_nullable and
666 $from_field->is_nullable);
668 my $from_dt = convert_datatype($from_field);
669 my $to_dt = convert_datatype($to_field);
670 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
671 $to_field->table->name,
673 $to_dt) if($to_dt ne $from_dt);
675 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
676 $to_field->table->name,
678 $to_field->name) if($from_field->name ne $to_field->name);
680 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
681 $to_field->table->name,
683 $to_field->default_value)
684 if(defined $to_field->default_value &&
685 $from_field->default_value ne $to_field->default_value);
687 return wantarray ? @out : join("\n", @out);
693 my ($new_field) = @_;
695 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
696 $new_field->table->name,
697 create_field($new_field));
704 my ($old_field) = @_;
706 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
707 $old_field->table->name,
715 # -------------------------------------------------------------------
716 # Life is full of misery, loneliness, and suffering --
717 # and it's all over much too soon.
719 # -------------------------------------------------------------------
725 SQL::Translator, SQL::Translator::Producer::Oracle.
729 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.