2 role SQL::Translator::Producer::SQL::PostgreSQL {
3 use SQL::Translator::Constants qw(:sqlt_types :sqlt_constants);
4 use SQL::Translator::Types qw(Column Constraint Index Table View);
19 mediumint => 'integer',
20 smallint => 'smallint',
21 tinyint => 'smallint',
23 varchar => 'character varying',
30 mediumblob => 'bytea',
32 enum => 'character varying',
33 set => 'character varying',
35 datetime => 'timestamp',
37 timestamp => 'timestamp',
45 varchar2 => 'character varying',
55 varchar => 'character varying',
56 datetime => 'timestamp',
61 tinyint => 'smallint',
67 my %reserved = map { $_, 1 } qw[
68 ALL ANALYSE ANALYZE AND ANY AS ASC
70 CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
71 CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
72 DEFAULT DEFERRABLE DESC DISTINCT DO
74 FALSE FOR FOREIGN FREEZE FROM FULL
76 ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
77 JOIN LEADING LEFT LIKE LIMIT
78 NATURAL NEW NOT NOTNULL NULL
79 OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
80 PRIMARY PUBLIC REFERENCES RIGHT
81 SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
82 UNION UNIQUE USER USING VERBOSE WHEN WHERE
85 # my $max_id_length = 62;
87 my %used_identifiers = ();
92 # -------------------------------------------------------------------
94 my $translator = $self->translator;
95 # local $DEBUG = $translator->debug;
96 # local $WARN = $translator->show_warnings;
97 my $no_comments = $translator->no_comments;
98 my $add_drop_table = $translator->add_drop_table;
99 my $schema = $translator->schema;
100 my $pargs = $translator->producer_args;
101 my $postgres_version = $pargs->{postgres_version} || 0;
103 my $qt = $translator->quote_table_names ? q{"} : q{};
104 my $qf = $translator->quote_field_names ? q{"} : q{};
107 push @output, $self->header_comment unless ($no_comments);
109 my (@table_defs, @fks);
110 for my $table ( $schema->get_tables ) {
112 my ($table_def, $fks) = $self->create_table($table, {
113 quote_table_names => $qt,
114 quote_field_names => $qf,
115 no_comments => $no_comments,
116 postgres_version => $postgres_version,
117 add_drop_table => $add_drop_table,
120 push @table_defs, $table_def;
124 for my $view ( $schema->get_views ) {
125 push @table_defs, $self->create_view($view, {
126 add_drop_view => $add_drop_table,
127 quote_table_names => $qt,
128 quote_field_names => $qf,
129 no_comments => $no_comments,
133 push @output, map { "$_;\n\n" } @table_defs;
135 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
136 push @output, map { "$_;\n\n" } @fks;
140 # if ( %truncated ) {
141 # warn "Truncated " . keys( %truncated ) . " names:\n";
142 # warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
145 # if ( %unreserve ) {
146 # warn "Encounted " . keys( %unreserve ) .
147 # " unsafe names in schema (reserved or invalid):\n";
148 # warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
154 : join ('', @output);
157 # -------------------------------------------------------------------
158 method mk_name($basename = '', $type = '', $scope = '', $critical = '') {
159 my $basename_orig = $basename;
160 # my $max_id_length = 62;
162 ? $max_id_length - (length($type) + 1)
164 $basename = substr( $basename, 0, $max_name )
165 if length( $basename ) > $max_name;
166 my $name = $type ? "${type}_$basename" : $basename;
168 if ( $basename ne $basename_orig and $critical ) {
169 my $show_type = $type ? "+'$type'" : "";
170 # warn "Truncating '$basename_orig'$show_type to $max_id_length ",
171 # "character limit to make '$name'\n" if $WARN;
172 $truncated{ $basename_orig } = $name;
175 $scope ||= \%global_names;
176 if ( my $prev = $scope->{ $name } ) {
177 my $name_orig = $name;
178 $name .= sprintf( "%02d", ++$prev );
179 substr($name, $max_id_length - 3) = "00"
180 if length( $name ) > $max_id_length;
182 # warn "The name '$name_orig' has been changed to ",
183 # "'$name' to make it unique.\n" if $WARN;
185 $scope->{ $name_orig }++;
192 # -------------------------------------------------------------------
193 method unreserve($name = '', $schema_obj_name = '') {
194 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
196 # also trap fields that don't begin with a letter
197 return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
199 if ( $schema_obj_name ) {
200 ++$unreserve{"$schema_obj_name.$name"};
203 ++$unreserve{"$name (table name)"};
206 my $unreserve = sprintf '%s_', $name;
207 return $unreserve.$suffix;
210 # -------------------------------------------------------------------
211 method next_unused_name($orig_name?) {
212 return unless $orig_name;
213 my $name = $orig_name;
215 my $suffix_gen = sub {
217 return ++$suffix ? '' : $suffix;
221 $name = $orig_name . $suffix_gen->();
222 last if $used_names{ $name }++;
228 method create_table(Table $table, $options?) {
229 my $qt = $options->{quote_table_names} || '';
230 my $qf = $options->{quote_field_names} || '';
231 my $no_comments = $options->{no_comments} || 0;
232 my $add_drop_table = $options->{add_drop_table} || 0;
233 my $postgres_version = $options->{postgres_version} || 0;
235 my $table_name = $table->name or next;
236 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
237 my $table_name_ur = $qt ? $table_name
238 : $fql_tbl_name ? join('.', $table_name, $self->unreserve($fql_tbl_name))
239 : $self->unreserve($table_name);
240 $table->name($table_name_ur);
242 # print STDERR "$table_name table_name\n";
243 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
245 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
247 if ( $table->comments and !$no_comments ){
248 my $c = "-- Comments: \n-- ";
249 $c .= join "\n-- ", $table->comments;
257 my %field_name_scope;
258 for my $field ( $table->get_fields ) {
259 push @field_defs, $self->create_field($field, { quote_table_names => $qt,
260 quote_field_names => $qf,
261 table_name => $table_name_ur,
262 postgres_version => $postgres_version,
263 type_defs => \@type_defs,
264 type_drops => \@type_drops,
265 constraint_defs => \@constraint_defs,});
272 # my $idx_name_default;
273 for my $index ( $table->get_indices ) {
274 my ($idef, $constraints) = $self->create_index($index,
276 quote_field_names => $qf,
277 quote_table_names => $qt,
278 table_name => $table_name,
280 $idef and push @index_defs, $idef;
281 push @constraint_defs, @$constraints;
288 for my $c ( $table->get_constraints ) {
289 my ($cdefs, $fks) = $self->create_constraint($c,
291 quote_field_names => $qf,
292 quote_table_names => $qt,
293 table_name => $table_name,
295 push @constraint_defs, @$cdefs;
301 if(exists $table->{extra}{temporary}) {
302 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
305 my $create_statement;
306 $create_statement = join("\n", @comments);
307 if ($add_drop_table) {
308 if ($postgres_version >= 8.2) {
309 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
310 $create_statement .= join (";\n", @type_drops) . ";\n"
311 if $postgres_version >= 8.3 && scalar @type_drops;
313 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
316 $create_statement .= join(";\n", @type_defs) . ";\n"
317 if $postgres_version >= 8.3 && scalar @type_defs;
318 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
319 join( ",\n", map { " $_" } @field_defs, @constraint_defs ) .
322 $create_statement .= @index_defs ? ';' : q{};
323 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
324 . join(";\n", @index_defs);
326 return $create_statement, \@fks;
329 method create_view(View $view, $options?) {
330 my $qt = $options->{quote_table_names} || '';
331 my $qf = $options->{quote_field_names} || '';
332 my $add_drop_view = $options->{add_drop_view};
334 my $view_name = $view->name;
335 # debug("PKG: Looking at view '${view_name}'\n");
338 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
339 unless $options->{no_comments};
340 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
343 my $extra = $view->extra;
344 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
345 $create .= " VIEW ${qt}${view_name}${qt}";
347 if ( my @fields = $view->fields ) {
348 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
349 $create .= " ( ${field_list} )";
352 if ( my $sql = $view->sql ) {
353 $create .= " AS\n ${sql}\n";
356 if ( $extra->{check_option} ) {
357 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
365 my %field_name_scope;
367 method create_field(Column $field, $options?) {
368 my $qt = $options->{quote_table_names} || '';
369 my $qf = $options->{quote_field_names} || '';
370 my $table_name = $field->table->name;
371 my $constraint_defs = $options->{constraint_defs} || [];
372 my $postgres_version = $options->{postgres_version} || 0;
373 my $type_defs = $options->{type_defs} || [];
374 my $type_drops = $options->{type_drops} || [];
376 $field_name_scope{$table_name} ||= {};
377 my $field_name = $field->name;
378 my $field_name_ur = $qf ? $field_name : $self->unreserve($field_name, $table_name );
379 $field->name($field_name_ur);
380 my $field_comments = $field->comments
381 ? "-- " . $field->comments . "\n "
384 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
389 my @size = $field->size;
390 my $data_type = lc $field->data_type;
391 my %extra = $field->extra;
392 my $list = $extra{'list'} || [];
393 # todo deal with embedded quotes
394 my $commalist = join( ', ', map { qq['$_'] } @$list );
396 if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
397 my $type_name = $field->table->name . '_' . $field->name . '_type';
398 $field_def .= ' '. $type_name;
399 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
400 push @$type_drops, "DROP TYPE IF EXISTS $type_name";
402 $field_def .= ' '. $self->convert_datatype($field);
408 my $default = $field->default_value;
410 # if ( defined $default ) {
411 # SQL::Translator::Producer->_apply_default_value(
416 # 'now()' => 'now()',
417 # 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
423 # Not null constraint
425 $field_def .= ' NOT NULL' unless $field->is_nullable;
431 method create_index(Index $index, $options?) {
432 my $qt = $options->{quote_table_names} ||'';
433 my $qf = $options->{quote_field_names} ||'';
434 my $table_name = $index->table->name;
435 # my $table_name_ur = $qt ? $self->unreserve($table_name) : $table_name;
437 my ($index_def, @constraint_defs);
439 my $name = $self->next_unused_name(
441 || join('_', $table_name, 'idx', ++$index_name{ $table_name })
444 my $type = $index->type || NORMAL;
446 map { $_ =~ s/\(.+\)//; $_ }
447 map { $qt ? $_ : $self->unreserve($_, $table_name ) }
449 return ('', []) unless @fields;
451 my $def_start = qq[CONSTRAINT "$name" ];
452 if ( $type eq PRIMARY_KEY ) {
453 push @constraint_defs, "${def_start}PRIMARY KEY ".
454 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
456 elsif ( $type eq UNIQUE ) {
457 push @constraint_defs, "${def_start}UNIQUE " .
458 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
460 elsif ( $type eq NORMAL ) {
462 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
463 join( ', ', map { qq[$qf$_$qf] } @fields ).
468 # warn "Unknown index type ($type) on table $table_name.\n"
472 return $index_def, \@constraint_defs;
475 method create_constraint(Constraint $c, $options?) {
476 my $qf = $options->{quote_field_names} ||'';
477 my $qt = $options->{quote_table_names} ||'';
478 my $table_name = $c->table->name;
479 my (@constraint_defs, @fks);
481 my $name = $c->name || '';
483 $name = $self->next_unused_name($name);
487 map { $_ =~ s/\(.+\)//; $_ }
488 map { $qt ? $_ : $self->unreserve( $_, $table_name )}
491 map { $_ =~ s/\(.+\)//; $_ }
492 map { $qt ? $_ : $self->unreserve( $_, $table_name )}
493 $c->reference_fields;
494 return ([], []) if !@fields && $c->type ne CHECK_C;
496 my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
497 if ( $c->type eq PRIMARY_KEY ) {
498 push @constraint_defs, "${def_start}PRIMARY KEY ".
499 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
501 elsif ( $c->type eq UNIQUE ) {
502 $name = $self->next_unused_name($name);
503 push @constraint_defs, "${def_start}UNIQUE " .
504 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
506 elsif ( $c->type eq CHECK_C ) {
507 my $expression = $c->expression;
508 push @constraint_defs, "${def_start}CHECK ($expression)";
510 elsif ( $c->type eq FOREIGN_KEY ) {
511 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
512 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
513 "\n REFERENCES " . $qt . $c->reference_table . $qt;
516 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
519 if ( $c->match_type ) {
520 $def .= ' MATCH ' . ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
523 # if ( $c->on_delete ) {
524 # $def .= ' ON DELETE '.join( ' ', $c->on_delete );
527 # if ( $c->on_update ) {
528 # $def .= ' ON UPDATE '.join( ' ', $c->on_update );
531 if ( $c->deferrable ) {
532 $def .= ' DEFERRABLE';
538 return \@constraint_defs, \@fks;
541 method convert_datatype(Column $field) {
542 my @size = $field->size;
543 my $data_type = lc $field->data_type;
545 if ( $data_type eq 'enum' ) {
547 # $len = ($len < length($_)) ? length($_) : $len for (@$list);
548 # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
549 # push @$constraint_defs,
550 # qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
551 # qq[IN ($commalist))];
552 $data_type = 'character varying';
554 elsif ( $data_type eq 'set' ) {
555 $data_type = 'character varying';
557 elsif ( $field->is_auto_increment ) {
558 if ( defined $size[0] && $size[0] > 11 ) {
559 $data_type = 'bigserial';
562 $data_type = 'serial';
567 $data_type = defined $translate{ $data_type } ?
568 $translate{ $data_type } :
572 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
573 if ( defined $size[0] && $size[0] > 6 ) {
578 if ( $data_type eq 'integer' ) {
579 if ( defined $size[0] && $size[0] > 0) {
580 if ( $size[0] > 10 ) {
581 $data_type = 'bigint';
583 elsif ( $size[0] < 5 ) {
584 $data_type = 'smallint';
587 $data_type = 'integer';
591 $data_type = 'integer';
595 my $type_with_size = join('|',
596 'bit', 'varbit', 'character', 'bit varying', 'character varying',
597 'time', 'timestamp', 'interval'
600 if ( $data_type !~ /$type_with_size/ ) {
604 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
605 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
606 $data_type .= $2 if(defined $2);
607 } elsif ( defined $size[0] && $size[0] > 0 ) {
608 $data_type .= '(' . join( ',', @size ) . ')';
615 method alter_field(Column $from_field, Column $to_field) {
616 die "Can't alter field in another table"
617 if($from_field->table->name ne $to_field->table->name);
620 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
621 $to_field->table->name,
622 $to_field->name) if(!$to_field->is_nullable and
623 $from_field->is_nullable);
625 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
626 $to_field->table->name,
628 if ( !$from_field->is_nullable and $to_field->is_nullable );
631 my $from_dt = $self->convert_datatype($from_field);
632 my $to_dt = $self->convert_datatype($to_field);
633 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
634 $to_field->table->name,
636 $to_dt) if($to_dt ne $from_dt);
638 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
639 $to_field->table->name,
641 $to_field->name) if($from_field->name ne $to_field->name);
643 my $old_default = $from_field->default_value;
644 my $new_default = $to_field->default_value;
645 my $default_value = $to_field->default_value;
647 # fixes bug where output like this was created:
648 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
649 if(ref $default_value eq "SCALAR" ) {
650 $default_value = $$default_value;
651 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
652 $default_value =~ s/'/''/xsmg;
653 $default_value = q(') . $default_value . q(');
656 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
657 $to_field->table->name,
660 if ( defined $new_default &&
661 (!defined $old_default || $old_default ne $new_default) );
663 # fixes bug where removing the DEFAULT statement of a column
664 # would result in no change
666 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
667 $to_field->table->name,
669 if ( !defined $new_default && defined $old_default );
672 return wantarray ? @out : join("\n", @out);
675 method rename_field(@args) { $self->alter_field(@args) }
677 method add_field(Column $new_field) {
678 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
679 $new_field->table->name,
680 $self->create_field($new_field));
685 method drop_field(Column $old_field) {
686 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
687 $old_field->table->name,
693 method alter_table(Column $to_table, $options?) {
694 my $qt = $options->{quote_table_names} || '';
695 my $out = sprintf('ALTER TABLE %s %s',
696 $qt . $to_table->name . $qt,
697 $options->{alter_table_action});
701 method rename_table(Table $old_table, Table $new_table, $options?) {
702 my $qt = $options->{quote_table_names} || '';
703 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
704 return alter_table($old_table, $options);
707 method alter_create_index(Index $index, $options?) {
708 my $qt = $options->{quote_table_names} || '';
709 my $qf = $options->{quote_field_names} || '';
710 my ($idef, $constraints) = create_index($index, {
711 quote_field_names => $qf,
712 quote_table_names => $qt,
713 table_name => $index->table->name,
715 return $index->type eq NORMAL ? $idef
716 : sprintf('ALTER TABLE %s ADD %s',
717 $qt . $index->table->name . $qt,
718 join(q{}, @$constraints)
722 method alter_drop_index(Index $index, $options?) {
723 my $index_name = $index->name;
724 return "DROP INDEX $index_name";
727 method alter_drop_constraint(Constraint $c, $options?) {
728 my $qt = $options->{quote_table_names} || '';
729 my $qc = $options->{quote_field_names} || '';
730 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
731 $qt . $c->table->name . $qt,
732 $qc . $c->name . $qc );
736 method alter_create_constraint(Index $index, $options?) {
737 my $qt = $options->{quote_table_names} || '';
738 my ($defs, $fks) = create_constraint(@_);
740 # return if there are no constraint definitions so we don't run
741 # into output like this:
742 # ALTER TABLE users ADD ;
744 return unless(@{$defs} || @{$fks});
745 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
746 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
747 'ADD', join(q{}, @{$defs}, @{$fks})
751 method drop_table(Str $table, $options?) {
752 my $qt = $options->{quote_table_names} || '';
753 return "DROP TABLE $qt$table$qt CASCADE";
756 method header_comment($producer?, $comment_char?) {
757 $producer ||= caller;
758 my $now = scalar localtime;
759 my $DEFAULT_COMMENT = '-- ';
761 $comment_char = $DEFAULT_COMMENT
762 unless defined $comment_char;
764 my $header_comment =<<"HEADER_COMMENT";
766 ${comment_char}Created by $producer
767 ${comment_char}Created on $now
771 # Any additional stuff passed in
772 for my $additional_comment (@_) {
773 $header_comment .= "${comment_char}${additional_comment}\n";
776 return $header_comment;