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) . ";\n\n";
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 ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
333 my $table_name_ur = $qt ? $table_name
334 : $fql_tbl_name ? join('.', $table_name, unreserve($fql_tbl_name))
335 : unreserve($table_name);
336 $table->name($table_name_ur);
338 # print STDERR "$table_name table_name\n";
339 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
341 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
343 if ( $table->comments and !$no_comments ){
344 my $c = "-- Comments: \n-- ";
345 $c .= join "\n-- ", $table->comments;
353 my %field_name_scope;
354 for my $field ( $table->get_fields ) {
355 push @field_defs, create_field($field, { quote_table_names => $qt,
356 quote_field_names => $qf,
357 table_name => $table_name_ur,
358 postgres_version => $postgres_version,
359 type_defs => \@type_defs,
360 type_drops => \@type_drops,
361 constraint_defs => \@constraint_defs,});
368 # my $idx_name_default;
369 for my $index ( $table->get_indices ) {
370 my ($idef, $constraints) = create_index($index,
372 quote_field_names => $qf,
373 quote_table_names => $qt,
374 table_name => $table_name,
376 $idef and push @index_defs, $idef;
377 push @constraint_defs, @$constraints;
384 for my $c ( $table->get_constraints ) {
385 my ($cdefs, $fks) = create_constraint($c,
387 quote_field_names => $qf,
388 quote_table_names => $qt,
389 table_name => $table_name,
391 push @constraint_defs, @$cdefs;
398 if(exists $table->{extra}{temporary}) {
399 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
402 my $create_statement;
403 $create_statement = join("\n", @comments);
404 if ($add_drop_table) {
405 if ($postgres_version >= 8.2) {
406 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
407 $create_statement .= join ("\n", @type_drops) . "\n"
408 if $postgres_version >= 8.3;
410 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
413 $create_statement .= join("\n", @type_defs) . "\n"
414 if $postgres_version >= 8.3;
415 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
416 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
419 $create_statement .= @index_defs ? ';' : q{};
420 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
421 . join(";\n", @index_defs);
423 return $create_statement, \@fks;
427 my ($view, $options) = @_;
428 my $qt = $options->{quote_table_names} || '';
429 my $qf = $options->{quote_field_names} || '';
430 my $add_drop_view = $options->{add_drop_view};
432 my $view_name = $view->name;
433 debug("PKG: Looking at view '${view_name}'\n");
436 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
437 unless $options->{no_comments};
438 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
441 my $extra = $view->extra;
442 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
443 $create .= " VIEW ${qt}${view_name}${qt}";
445 if ( my @fields = $view->fields ) {
446 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
447 $create .= " ( ${field_list} )";
450 if ( my $sql = $view->sql ) {
451 $create .= " AS (\n ${sql}\n )";
454 if ( $extra->{check_option} ) {
455 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
463 my %field_name_scope;
467 my ($field, $options) = @_;
469 my $qt = $options->{quote_table_names} || '';
470 my $qf = $options->{quote_field_names} || '';
471 my $table_name = $field->table->name;
472 my $constraint_defs = $options->{constraint_defs} || [];
473 my $postgres_version = $options->{postgres_version} || 0;
474 my $type_defs = $options->{type_defs} || [];
475 my $type_drops = $options->{type_drops} || [];
477 $field_name_scope{$table_name} ||= {};
478 my $field_name = mk_name(
479 $field->name, '', $field_name_scope{$table_name}, 1
481 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
482 $field->name($field_name_ur);
483 my $field_comments = $field->comments
484 ? "-- " . $field->comments . "\n "
487 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
492 my @size = $field->size;
493 my $data_type = lc $field->data_type;
494 my %extra = $field->extra;
495 my $list = $extra{'list'} || [];
496 # todo deal with embedded quotes
497 my $commalist = join( ', ', map { qq['$_'] } @$list );
499 if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
500 my $type_name = $field->table->name . '_' . $field->name . '_type';
501 $field_def .= ' '. $type_name;
502 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
503 push @$type_drops, "DROP TYPE IF EXISTS $type_name";
505 $field_def .= ' '. convert_datatype($field);
511 my $default = $field->default_value;
512 if ( defined $default ) {
513 SQL::Translator::Producer->_apply_default_value(
519 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
525 # Not null constraint
527 $field_def .= ' NOT NULL' unless $field->is_nullable;
535 my ($index, $options) = @_;
537 my $qt = $options->{quote_table_names} ||'';
538 my $qf = $options->{quote_field_names} ||'';
539 my $table_name = $index->table->name;
540 # my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
542 my ($index_def, @constraint_defs);
544 my $name = $index->name || '';
546 $name = next_unused_name($name);
549 my $type = $index->type || NORMAL;
551 map { $_ =~ s/\(.+\)//; $_ }
552 map { $qt ? $_ : unreserve($_, $table_name ) }
556 my $def_start = qq[CONSTRAINT "$name" ];
557 if ( $type eq PRIMARY_KEY ) {
558 push @constraint_defs, "${def_start}PRIMARY KEY ".
559 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
561 elsif ( $type eq UNIQUE ) {
562 push @constraint_defs, "${def_start}UNIQUE " .
563 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
565 elsif ( $type eq NORMAL ) {
567 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
568 join( ', ', map { qq[$qf$_$qf] } @fields ).
573 warn "Unknown index type ($type) on table $table_name.\n"
577 return $index_def, \@constraint_defs;
580 sub create_constraint
582 my ($c, $options) = @_;
584 my $qf = $options->{quote_field_names} ||'';
585 my $qt = $options->{quote_table_names} ||'';
586 my $table_name = $c->table->name;
587 my (@constraint_defs, @fks);
589 my $name = $c->name || '';
591 $name = next_unused_name($name);
595 map { $_ =~ s/\(.+\)//; $_ }
596 map { $qt ? $_ : unreserve( $_, $table_name )}
600 map { $_ =~ s/\(.+\)//; $_ }
601 map { $qt ? $_ : unreserve( $_, $table_name )}
602 $c->reference_fields;
604 next if !@fields && $c->type ne CHECK_C;
605 my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
606 if ( $c->type eq PRIMARY_KEY ) {
607 push @constraint_defs, "${def_start}PRIMARY KEY ".
608 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
610 elsif ( $c->type eq UNIQUE ) {
611 $name = next_unused_name($name);
612 push @constraint_defs, "${def_start}UNIQUE " .
613 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
615 elsif ( $c->type eq CHECK_C ) {
616 my $expression = $c->expression;
617 push @constraint_defs, "${def_start}CHECK ($expression)";
619 elsif ( $c->type eq FOREIGN_KEY ) {
620 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
621 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
622 "\n REFERENCES " . $qt . $c->reference_table . $qt;
625 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
628 if ( $c->match_type ) {
630 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
633 if ( $c->on_delete ) {
634 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
637 if ( $c->on_update ) {
638 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
641 if ( $c->deferrable ) {
642 $def .= ' DEFERRABLE';
648 return \@constraint_defs, \@fks;
655 my @size = $field->size;
656 my $data_type = lc $field->data_type;
658 if ( $data_type eq 'enum' ) {
660 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
661 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
662 # push @$constraint_defs,
663 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
664 # qq[IN ($commalist))];
665 $data_type = 'character varying';
667 elsif ( $data_type eq 'set' ) {
668 $data_type = 'character varying';
670 elsif ( $field->is_auto_increment ) {
671 if ( defined $size[0] && $size[0] > 11 ) {
672 $data_type = 'bigserial';
675 $data_type = 'serial';
680 $data_type = defined $translate{ $data_type } ?
681 $translate{ $data_type } :
685 if ( $data_type =~ /timestamp/i ) {
686 if ( defined $size[0] && $size[0] > 6 ) {
691 if ( $data_type eq 'integer' ) {
692 if ( defined $size[0] && $size[0] > 0) {
693 if ( $size[0] > 10 ) {
694 $data_type = 'bigint';
696 elsif ( $size[0] < 5 ) {
697 $data_type = 'smallint';
700 $data_type = 'integer';
704 $data_type = 'integer';
707 my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
708 integer smallint text line lseg macaddr money
709 path point polygon real/;
710 foreach (@type_without_size) {
711 if ( $data_type =~ qr/$_/ ) {
716 if ( defined $size[0] && $size[0] > 0 ) {
717 $data_type .= '(' . join( ',', @size ) . ')';
719 elsif (defined $size[0] && $data_type eq 'timestamp' ) {
720 $data_type .= '(' . join( ',', @size ) . ')';
730 my ($from_field, $to_field) = @_;
732 die "Can't alter field in another table"
733 if($from_field->table->name ne $to_field->table->name);
736 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
737 $to_field->table->name,
738 $to_field->name) if(!$to_field->is_nullable and
739 $from_field->is_nullable);
741 my $from_dt = convert_datatype($from_field);
742 my $to_dt = convert_datatype($to_field);
743 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
744 $to_field->table->name,
746 $to_dt) if($to_dt ne $from_dt);
748 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
749 $to_field->table->name,
751 $to_field->name) if($from_field->name ne $to_field->name);
753 my $old_default = $from_field->default_value;
754 my $new_default = $to_field->default_value;
755 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
756 $to_field->table->name,
758 $to_field->default_value)
759 if ( defined $new_default &&
760 (!defined $old_default || $old_default ne $new_default) );
762 return wantarray ? @out : join("\n", @out);
765 sub rename_field { alter_field(@_) }
769 my ($new_field) = @_;
771 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
772 $new_field->table->name,
773 create_field($new_field));
780 my ($old_field) = @_;
782 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
783 $old_field->table->name,
790 my ($to_table, $options) = @_;
791 my $qt = $options->{quote_table_names} || '';
792 my $out = sprintf('ALTER TABLE %s %s',
793 $qt . $to_table->name . $qt,
794 $options->{alter_table_action});
799 my ($old_table, $new_table, $options) = @_;
800 my $qt = $options->{quote_table_names} || '';
801 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
802 return alter_table($old_table, $options);
805 sub alter_create_index {
806 my ($index, $options) = @_;
807 my $qt = $options->{quote_table_names} || '';
808 my $qf = $options->{quote_field_names} || '';
809 my ($idef, $constraints) = create_index($index, {
810 quote_field_names => $qf,
811 quote_table_names => $qt,
812 table_name => $index->table->name,
814 return $index->type eq NORMAL ? $idef
815 : sprintf('ALTER TABLE %s ADD %s',
816 $qt . $index->table->name . $qt,
817 join(q{}, @$constraints)
821 sub alter_drop_index {
822 my ($index, $options) = @_;
823 my $index_name = $index->name;
824 return "DROP INDEX $index_name";
827 sub alter_drop_constraint {
828 my ($c, $options) = @_;
829 my $qt = $options->{quote_table_names} || '';
830 my $qc = $options->{quote_field_names} || '';
831 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
832 $qt . $c->table->name . $qt,
833 $qc . $c->name . $qc );
837 sub alter_create_constraint {
838 my ($index, $options) = @_;
839 my $qt = $options->{quote_table_names} || '';
840 return $index->type eq FOREIGN_KEY ? join(q{}, @{create_constraint(@_)})
841 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
842 'ADD', join(q{}, map { @{$_} } create_constraint(@_))
847 my ($table, $options) = @_;
848 my $qt = $options->{quote_table_names} || '';
849 return "DROP TABLE $qt$table$qt CASCADE";
854 # -------------------------------------------------------------------
855 # Life is full of misery, loneliness, and suffering --
856 # and it's all over much too soon.
858 # -------------------------------------------------------------------
864 SQL::Translator, SQL::Translator::Producer::Oracle.
868 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.