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 = 0 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 local $DEBUG = $translator->debug;
180 local $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_drop_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} || '';
419 my $add_drop_view = $options->{add_drop_view};
421 my $view_name = $view->name;
422 debug("PKG: Looking at view '${view_name}'\n");
425 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
426 unless $options->{no_comments};
427 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
430 my $extra = $view->extra;
431 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
432 $create .= " VIEW ${qt}${view_name}${qt}";
434 if ( my @fields = $view->fields ) {
435 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
436 $create .= " ( ${field_list} )";
439 if ( my $sql = $view->sql ) {
440 $create .= " AS (\n ${sql}\n )";
443 if ( $extra->{check_option} ) {
444 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
453 my %field_name_scope;
457 my ($field, $options) = @_;
459 my $qt = $options->{quote_table_names} || '';
460 my $qf = $options->{quote_field_names} || '';
461 my $table_name = $field->table->name;
462 my $constraint_defs = $options->{constraint_defs} || [];
463 my $postgres_version = $options->{postgres_version} || 0;
464 my $type_defs = $options->{type_defs} || [];
465 my $type_drops = $options->{type_drops} || [];
467 $field_name_scope{$table_name} ||= {};
468 my $field_name = mk_name(
469 $field->name, '', $field_name_scope{$table_name}, 1
471 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
472 $field->name($field_name_ur);
473 my $field_comments = $field->comments
474 ? "-- " . $field->comments . "\n "
477 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
482 my @size = $field->size;
483 my $data_type = lc $field->data_type;
484 my %extra = $field->extra;
485 my $list = $extra{'list'} || [];
486 # todo deal with embedded quotes
487 my $commalist = join( ', ', map { qq['$_'] } @$list );
490 if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
491 my $type_name = $field->table->name . '_' . $field->name . '_type';
492 $field_def .= ' '. $type_name;
493 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist);";
494 push @$type_drops, "DROP TYPE IF EXISTS $type_name;";
496 $field_def .= ' '. convert_datatype($field);
500 # Default value -- disallow for timestamps
502 # my $default = $data_type =~ /(timestamp|date)/i
503 # ? undef : $field->default_value;
504 my $default = $field->default_value;
505 if ( defined $default ) {
507 $qd = '' if ($default eq 'now()' ||
508 $default eq 'CURRENT_TIMESTAMP');
509 $field_def .= sprintf( ' DEFAULT %s',
510 ( $field->is_auto_increment && $seq_name )
511 ? qq[nextval('"$seq_name"'::text)] :
512 ( $default =~ m/null/i ) ? 'NULL' : "$qd$default$qd"
517 # Not null constraint
519 $field_def .= ' NOT NULL' unless $field->is_nullable;
527 my ($index, $options) = @_;
529 my $qt = $options->{quote_table_names} ||'';
530 my $qf = $options->{quote_field_names} ||'';
531 my $table_name = $index->table->name;
532 # my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
534 my ($index_def, @constraint_defs);
536 my $name = $index->name || '';
538 $name = next_unused_name($name);
541 my $type = $index->type || NORMAL;
543 map { $_ =~ s/\(.+\)//; $_ }
544 map { $qt ? $_ : unreserve($_, $table_name ) }
548 my $def_start = qq[Constraint "$name" ];
549 if ( $type eq PRIMARY_KEY ) {
550 push @constraint_defs, "${def_start}PRIMARY KEY ".
551 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
553 elsif ( $type eq UNIQUE ) {
554 push @constraint_defs, "${def_start}UNIQUE " .
555 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
557 elsif ( $type eq NORMAL ) {
559 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
560 join( ', ', map { qq[$qf$_$qf] } @fields ).
565 warn "Unknown index type ($type) on table $table_name.\n"
569 return $index_def, \@constraint_defs;
572 sub create_constraint
574 my ($c, $options) = @_;
576 my $qf = $options->{quote_field_names} ||'';
577 my $qt = $options->{quote_table_names} ||'';
578 my $table_name = $c->table->name;
579 my (@constraint_defs, @fks);
581 my $name = $c->name || '';
583 $name = next_unused_name($name);
587 map { $_ =~ s/\(.+\)//; $_ }
588 map { $qt ? $_ : unreserve( $_, $table_name )}
592 map { $_ =~ s/\(.+\)//; $_ }
593 map { $qt ? $_ : unreserve( $_, $table_name )}
594 $c->reference_fields;
596 next if !@fields && $c->type ne CHECK_C;
597 my $def_start = $name ? qq[Constraint "$name" ] : '';
598 if ( $c->type eq PRIMARY_KEY ) {
599 push @constraint_defs, "${def_start}PRIMARY KEY ".
600 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
602 elsif ( $c->type eq UNIQUE ) {
603 $name = next_unused_name($name);
604 push @constraint_defs, "${def_start}UNIQUE " .
605 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
607 elsif ( $c->type eq CHECK_C ) {
608 my $expression = $c->expression;
609 push @constraint_defs, "${def_start}CHECK ($expression)";
611 elsif ( $c->type eq FOREIGN_KEY ) {
612 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
613 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
614 "\n REFERENCES " . $qt . $c->reference_table . $qt;
617 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
620 if ( $c->match_type ) {
622 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
625 if ( $c->on_delete ) {
626 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
629 if ( $c->on_update ) {
630 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
633 if ( $c->deferrable ) {
634 $def .= ' DEFERRABLE';
640 return \@constraint_defs, \@fks;
647 my @size = $field->size;
648 my $data_type = lc $field->data_type;
650 if ( $data_type eq 'enum' ) {
652 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
653 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
654 # push @$constraint_defs,
655 # qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
656 # qq[IN ($commalist))];
657 $data_type = 'character varying';
659 elsif ( $data_type eq 'set' ) {
660 $data_type = 'character varying';
662 elsif ( $field->is_auto_increment ) {
663 if ( defined $size[0] && $size[0] > 11 ) {
664 $data_type = 'bigserial';
667 $data_type = 'serial';
672 $data_type = defined $translate{ $data_type } ?
673 $translate{ $data_type } :
677 if ( $data_type =~ /timestamp/i ) {
678 if ( defined $size[0] && $size[0] > 6 ) {
683 if ( $data_type eq 'integer' ) {
684 if ( defined $size[0] && $size[0] > 0) {
685 if ( $size[0] > 10 ) {
686 $data_type = 'bigint';
688 elsif ( $size[0] < 5 ) {
689 $data_type = 'smallint';
692 $data_type = 'integer';
696 $data_type = 'integer';
699 my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
700 integer smallint text line lseg macaddr money
701 path point polygon real/;
702 foreach (@type_without_size) {
703 if ( $data_type =~ qr/$_/ ) {
708 if ( defined $size[0] && $size[0] > 0 ) {
709 $data_type .= '(' . join( ',', @size ) . ')';
711 elsif (defined $size[0] && $data_type eq 'timestamp' ) {
712 $data_type .= '(' . join( ',', @size ) . ')';
722 my ($from_field, $to_field) = @_;
724 die "Can't alter field in another table"
725 if($from_field->table->name ne $to_field->table->name);
728 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
729 $to_field->table->name,
730 $to_field->name) if(!$to_field->is_nullable and
731 $from_field->is_nullable);
733 my $from_dt = convert_datatype($from_field);
734 my $to_dt = convert_datatype($to_field);
735 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
736 $to_field->table->name,
738 $to_dt) if($to_dt ne $from_dt);
740 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
741 $to_field->table->name,
743 $to_field->name) if($from_field->name ne $to_field->name);
745 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
746 $to_field->table->name,
748 $to_field->default_value)
749 if(defined $to_field->default_value &&
750 $from_field->default_value ne $to_field->default_value);
752 return wantarray ? @out : join("\n", @out);
758 my ($new_field) = @_;
760 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
761 $new_field->table->name,
762 create_field($new_field));
769 my ($old_field) = @_;
771 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
772 $old_field->table->name,
780 # -------------------------------------------------------------------
781 # Life is full of misery, loneliness, and suffering --
782 # and it's all over much too soon.
784 # -------------------------------------------------------------------
790 SQL::Translator, SQL::Translator::Producer::Oracle.
794 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.