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 %used_names ];
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(debug 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;
184 my $pargs = $translator->producer_args;
185 local %used_names = ();
187 my $postgres_version = $pargs->{postgres_version} || 0;
190 $qt = '"' if ($translator->quote_table_names);
192 $qf = '"' if ($translator->quote_field_names);
195 $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,});
206 push @table_defs, $table_def;
211 for my $view ( $schema->get_views ) {
212 push @table_defs, create_view($view, {
213 add_replace_view => $add_drop_table,
214 quote_table_names => $qt,
215 quote_field_names => $qf,
216 no_comments => $no_comments,
220 $output = join("\n\n", @table_defs);
222 $output .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
223 $output .= join( "\n\n", @fks ) . "\n";
228 warn "Truncated " . keys( %truncated ) . " names:\n";
229 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
233 warn "Encounted " . keys( %unreserve ) .
234 " unsafe names in schema (reserved or invalid):\n";
235 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
242 # -------------------------------------------------------------------
244 my $basename = shift || '';
245 my $type = shift || '';
246 my $scope = shift || '';
247 my $critical = shift || '';
248 my $basename_orig = $basename;
249 # my $max_id_length = 62;
251 ? $max_id_length - (length($type) + 1)
253 $basename = substr( $basename, 0, $max_name )
254 if length( $basename ) > $max_name;
255 my $name = $type ? "${type}_$basename" : $basename;
257 if ( $basename ne $basename_orig and $critical ) {
258 my $show_type = $type ? "+'$type'" : "";
259 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
260 "character limit to make '$name'\n" if $WARN;
261 $truncated{ $basename_orig } = $name;
264 $scope ||= \%global_names;
265 if ( my $prev = $scope->{ $name } ) {
266 my $name_orig = $name;
267 $name .= sprintf( "%02d", ++$prev );
268 substr($name, $max_id_length - 3) = "00"
269 if length( $name ) > $max_id_length;
271 warn "The name '$name_orig' has been changed to ",
272 "'$name' to make it unique.\n" if $WARN;
274 $scope->{ $name_orig }++;
281 # -------------------------------------------------------------------
283 my $name = shift || '';
284 my $schema_obj_name = shift || '';
286 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
288 # also trap fields that don't begin with a letter
289 return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
291 if ( $schema_obj_name ) {
292 ++$unreserve{"$schema_obj_name.$name"};
295 ++$unreserve{"$name (table name)"};
298 my $unreserve = sprintf '%s_', $name;
299 return $unreserve.$suffix;
302 # -------------------------------------------------------------------
303 sub next_unused_name {
304 my $name = shift || '';
305 if ( !defined( $used_names{$name} ) ) {
306 $used_names{$name} = $name;
311 while ( defined( $used_names{ $name . $i } ) ) {
315 $used_names{$name} = $name;
322 my ($table, $options) = @_;
324 my $qt = $options->{quote_table_names} || '';
325 my $qf = $options->{quote_field_names} || '';
326 my $no_comments = $options->{no_comments} || 0;
327 my $add_drop_table = $options->{add_drop_table} || 0;
328 my $postgres_version = $options->{postgres_version} || 0;
330 my $table_name = $table->name or next;
331 $table_name = mk_name( $table_name, '', undef, 1 );
332 my $table_name_ur = $qt ? $table_name : unreserve($table_name);
333 $table->name($table_name_ur);
335 # print STDERR "$table_name table_name\n";
336 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
338 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
340 if ( $table->comments and !$no_comments ){
341 my $c = "-- Comments: \n-- ";
342 $c .= join "\n-- ", $table->comments;
350 my %field_name_scope;
351 for my $field ( $table->get_fields ) {
352 push @field_defs, create_field($field, { quote_table_names => $qt,
353 quote_field_names => $qf,
354 table_name => $table_name_ur,
355 postgres_version => $postgres_version,
356 type_defs => \@type_defs,
357 type_drops => \@type_drops,
358 constraint_defs => \@constraint_defs,});
365 # my $idx_name_default;
366 for my $index ( $table->get_indices ) {
367 my ($idef, $constraints) = create_index($index,
369 quote_field_names => $qf,
370 quote_table_names => $qt,
371 table_name => $table_name,
373 $idef and push @index_defs, $idef;
374 push @constraint_defs, @$constraints;
381 for my $c ( $table->get_constraints ) {
382 my ($cdefs, $fks) = create_constraint($c,
384 quote_field_names => $qf,
385 quote_table_names => $qt,
386 table_name => $table_name,
388 push @constraint_defs, @$cdefs;
392 my $create_statement;
393 $create_statement = join("\n", @comments);
394 if ($add_drop_table) {
395 if ($postgres_version >= 8.2) {
396 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
397 $create_statement .= join ("\n", @type_drops) . "\n"
398 if $postgres_version >= 8.3;
400 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
403 $create_statement .= join("\n", @type_defs) . "\n"
404 if $postgres_version >= 8.3;
405 $create_statement .= qq[CREATE TABLE $qt$table_name_ur$qt (\n].
406 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
410 $create_statement .= "\n" . join("\n", @index_defs) . "\n";
412 return $create_statement, \@fks;
416 my ($view, $options) = @_;
417 my $qt = $options->{quote_table_names} || '';
418 my $qf = $options->{quote_field_names} || '';
420 my $view_name = $view->name;
421 debug("PKG: Looking at view '${view_name}'\n");
424 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
425 unless $options->{no_comments};
427 $create .= ' OR REPLACE' if $options->{add_replace_view};
429 my $extra = $view->extra;
430 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
431 $create .= " VIEW ${qt}${view_name}${qt}";
433 if ( my @fields = $view->fields ) {
434 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
435 $create .= " ( ${field_list} )";
438 if ( my $sql = $view->sql ) {
439 $create .= " AS (\n ${sql}\n )";
442 if ( $extra->{check_option} ) {
443 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
452 my %field_name_scope;
456 my ($field, $options) = @_;
458 my $qt = $options->{quote_table_names} || '';
459 my $qf = $options->{quote_field_names} || '';
460 my $table_name = $field->table->name;
461 my $constraint_defs = $options->{constraint_defs} || [];
462 my $postgres_version = $options->{postgres_version} || 0;
463 my $type_defs = $options->{type_defs} || [];
464 my $type_drops = $options->{type_drops} || [];
466 $field_name_scope{$table_name} ||= {};
467 my $field_name = mk_name(
468 $field->name, '', $field_name_scope{$table_name}, 1
470 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
471 $field->name($field_name_ur);
472 my $field_comments = $field->comments
473 ? "-- " . $field->comments . "\n "
476 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
481 my @size = $field->size;
482 my $data_type = lc $field->data_type;
483 my %extra = $field->extra;
484 my $list = $extra{'list'} || [];
485 # todo deal with embedded quotes
486 my $commalist = join( ', ', map { qq['$_'] } @$list );
489 if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
490 my $type_name = $field->table->name . '_' . $field->name . '_type';
491 $field_def .= ' '. $type_name;
492 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist);";
493 push @$type_drops, "DROP TYPE IF EXISTS $type_name;";
495 $field_def .= ' '. convert_datatype($field);
499 # Default value -- disallow for timestamps
501 # my $default = $data_type =~ /(timestamp|date)/i
502 # ? undef : $field->default_value;
503 my $default = $field->default_value;
504 if ( defined $default ) {
506 $qd = '' if ($default eq 'now()' ||
507 $default eq 'CURRENT_TIMESTAMP');
508 $field_def .= sprintf( ' DEFAULT %s',
509 ( $field->is_auto_increment && $seq_name )
510 ? qq[nextval('"$seq_name"'::text)] :
511 ( $default =~ m/null/i ) ? 'NULL' : "$qd$default$qd"
516 # Not null constraint
518 $field_def .= ' NOT NULL' unless $field->is_nullable;
526 my ($index, $options) = @_;
528 my $qt = $options->{quote_table_names} ||'';
529 my $qf = $options->{quote_field_names} ||'';
530 my $table_name = $index->table->name;
531 # my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
533 my ($index_def, @constraint_defs);
535 my $name = $index->name || '';
537 $name = next_unused_name($name);
540 my $type = $index->type || NORMAL;
542 map { $_ =~ s/\(.+\)//; $_ }
543 map { $qt ? $_ : unreserve($_, $table_name ) }
547 my $def_start = qq[Constraint "$name" ];
548 if ( $type eq PRIMARY_KEY ) {
549 push @constraint_defs, "${def_start}PRIMARY KEY ".
550 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
552 elsif ( $type eq UNIQUE ) {
553 push @constraint_defs, "${def_start}UNIQUE " .
554 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
556 elsif ( $type eq NORMAL ) {
558 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
559 join( ', ', map { qq[$qf$_$qf] } @fields ).
564 warn "Unknown index type ($type) on table $table_name.\n"
568 return $index_def, \@constraint_defs;
571 sub create_constraint
573 my ($c, $options) = @_;
575 my $qf = $options->{quote_field_names} ||'';
576 my $qt = $options->{quote_table_names} ||'';
577 my $table_name = $c->table->name;
578 my (@constraint_defs, @fks);
580 my $name = $c->name || '';
582 $name = next_unused_name($name);
586 map { $_ =~ s/\(.+\)//; $_ }
587 map { $qt ? $_ : unreserve( $_, $table_name )}
591 map { $_ =~ s/\(.+\)//; $_ }
592 map { $qt ? $_ : unreserve( $_, $table_name )}
593 $c->reference_fields;
595 next if !@fields && $c->type ne CHECK_C;
596 my $def_start = $name ? qq[Constraint "$name" ] : '';
597 if ( $c->type eq PRIMARY_KEY ) {
598 push @constraint_defs, "${def_start}PRIMARY KEY ".
599 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
601 elsif ( $c->type eq UNIQUE ) {
602 $name = next_unused_name($name);
603 push @constraint_defs, "${def_start}UNIQUE " .
604 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
606 elsif ( $c->type eq CHECK_C ) {
607 my $expression = $c->expression;
608 push @constraint_defs, "${def_start}CHECK ($expression)";
610 elsif ( $c->type eq FOREIGN_KEY ) {
611 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
612 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
613 "\n REFERENCES " . $qt . $c->reference_table . $qt;
616 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
619 if ( $c->match_type ) {
621 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
624 if ( $c->on_delete ) {
625 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
628 if ( $c->on_update ) {
629 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
632 if ( $c->deferrable ) {
633 $def .= ' DEFERRABLE';
639 return \@constraint_defs, \@fks;
646 my @size = $field->size;
647 my $data_type = lc $field->data_type;
649 if ( $data_type eq 'enum' ) {
651 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
652 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
653 # push @$constraint_defs,
654 # qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
655 # qq[IN ($commalist))];
656 $data_type = 'character varying';
658 elsif ( $data_type eq 'set' ) {
659 $data_type = 'character varying';
661 elsif ( $field->is_auto_increment ) {
662 if ( defined $size[0] && $size[0] > 11 ) {
663 $data_type = 'bigserial';
666 $data_type = 'serial';
671 $data_type = defined $translate{ $data_type } ?
672 $translate{ $data_type } :
676 if ( $data_type =~ /timestamp/i ) {
677 if ( defined $size[0] && $size[0] > 6 ) {
682 if ( $data_type eq 'integer' ) {
683 if ( defined $size[0] && $size[0] > 0) {
684 if ( $size[0] > 10 ) {
685 $data_type = 'bigint';
687 elsif ( $size[0] < 5 ) {
688 $data_type = 'smallint';
691 $data_type = 'integer';
695 $data_type = 'integer';
698 my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
699 integer smallint text line lseg macaddr money
700 path point polygon real/;
701 foreach (@type_without_size) {
702 if ( $data_type =~ qr/$_/ ) {
707 if ( defined $size[0] && $size[0] > 0 ) {
708 $data_type .= '(' . join( ',', @size ) . ')';
710 elsif (defined $size[0] && $data_type eq 'timestamp' ) {
711 $data_type .= '(' . join( ',', @size ) . ')';
721 my ($from_field, $to_field) = @_;
723 die "Can't alter field in another table"
724 if($from_field->table->name ne $to_field->table->name);
727 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
728 $to_field->table->name,
729 $to_field->name) if(!$to_field->is_nullable and
730 $from_field->is_nullable);
732 my $from_dt = convert_datatype($from_field);
733 my $to_dt = convert_datatype($to_field);
734 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
735 $to_field->table->name,
737 $to_dt) if($to_dt ne $from_dt);
739 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
740 $to_field->table->name,
742 $to_field->name) if($from_field->name ne $to_field->name);
744 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
745 $to_field->table->name,
747 $to_field->default_value)
748 if(defined $to_field->default_value &&
749 $from_field->default_value ne $to_field->default_value);
751 return wantarray ? @out : join("\n", @out);
757 my ($new_field) = @_;
759 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
760 $new_field->table->name,
761 create_field($new_field));
768 my ($old_field) = @_;
770 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
771 $old_field->table->name,
779 # -------------------------------------------------------------------
780 # Life is full of misery, loneliness, and suffering --
781 # and it's all over much too soon.
783 # -------------------------------------------------------------------
789 SQL::Translator, SQL::Translator::Producer::Oracle.
793 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.