projects / dbsrgits/SQL-Translator.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
PgSQL diff patch from wries
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / PostgreSQL.pm
CommitLineData
f8f0253c 1package SQL::Translator::Producer::PostgreSQL;
2
3# -------------------------------------------------------------------
7ed7402c 4# $Id: PostgreSQL.pm,v 1.29 2007-06-04 04:01:14 mwz444 Exp $
f8f0253c 5# -------------------------------------------------------------------
977651a5 6# Copyright (C) 2002-4 SQLFairy Authors
f8f0253c 7#
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.
11#
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.
16#
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
20# 02111-1307 USA
21# -------------------------------------------------------------------
22
96844cae 23=head1 NAME
24
25SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator
26
20770e44 27=head1 SYNOPSIS
28
29 my $t = SQL::Translator->new( parser => '...', producer => 'PostgreSQL' );
30 $t->translate;
31
32=head1 DESCRIPTION
33
34Creates a DDL suitable for PostgreSQL. Very heavily based on the Oracle
35producer.
36
96844cae 37=cut
38
f8f0253c 39use strict;
bfb5a568 40use warnings;
999859d7 41use vars qw[ $DEBUG $WARN $VERSION %used_names ];
7ed7402c 42$VERSION = sprintf "%d.%02d", q$Revision: 1.29 $ =~ /(\d+)\.(\d+)/;
a25ac5d2 43$DEBUG = 0 unless defined $DEBUG;
f8f0253c 44
0c43e0a1 45use SQL::Translator::Schema::Constants;
296c2701 46use SQL::Translator::Utils qw(debug header_comment);
f8f0253c 47use Data::Dumper;
48
bfb5a568 49my %translate;
50my $max_id_length;
51
52BEGIN {
53
54 %translate = (
d529894e 55 #
56 # MySQL types
57 #
58 bigint => 'bigint',
4328d7bd 59 double => 'numeric',
60 decimal => 'numeric',
61 float => 'numeric',
d529894e 62 int => 'integer',
63 mediumint => 'integer',
64 smallint => 'smallint',
65 tinyint => 'smallint',
c8c17a58 66 char => 'character',
da8e499e 67 varchar => 'character varying',
d529894e 68 longtext => 'text',
69 mediumtext => 'text',
70 text => 'text',
71 tinytext => 'text',
72 tinyblob => 'bytea',
73 blob => 'bytea',
74 mediumblob => 'bytea',
75 longblob => 'bytea',
da8e499e 76 enum => 'character varying',
77 set => 'character varying',
d529894e 78 date => 'date',
79 datetime => 'timestamp',
e56dabb7 80 time => 'time',
d529894e 81 timestamp => 'timestamp',
82 year => 'date',
83
84 #
85 # Oracle types
86 #
96844cae 87 number => 'integer',
c8c17a58 88 char => 'character',
da8e499e 89 varchar2 => 'character varying',
96844cae 90 long => 'text',
91 CLOB => 'bytea',
92 date => 'date',
93
94 #
95 # Sybase types
96 #
97 int => 'integer',
98 money => 'money',
da8e499e 99 varchar => 'character varying',
96844cae 100 datetime => 'timestamp',
101 text => 'text',
4328d7bd 102 real => 'numeric',
96844cae 103 comment => 'text',
104 bit => 'bit',
105 tinyint => 'smallint',
4328d7bd 106 float => 'numeric',
d529894e 107);
108
bfb5a568 109 $max_id_length = 62;
110}
96844cae 111my %reserved = map { $_, 1 } qw[
112 ALL ANALYSE ANALYZE AND ANY AS ASC
113 BETWEEN BINARY BOTH
114 CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
115 CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
116 DEFAULT DEFERRABLE DESC DISTINCT DO
117 ELSE END EXCEPT
118 FALSE FOR FOREIGN FREEZE FROM FULL
119 GROUP HAVING
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
127];
d529894e 128
bfb5a568 129# my $max_id_length = 62;
96844cae 130my %used_identifiers = ();
131my %global_names;
132my %unreserve;
133my %truncated;
134
135=pod
136
137=head1 PostgreSQL Create Table Syntax
138
139 CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
140 { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
141 | table_constraint } [, ... ]
142 )
143 [ INHERITS ( parent_table [, ... ] ) ]
144 [ WITH OIDS | WITHOUT OIDS ]
145
146where column_constraint is:
147
148 [ CONSTRAINT constraint_name ]
149 { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
150 CHECK (expression) |
151 REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
152 [ ON DELETE action ] [ ON UPDATE action ] }
153 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
154
155and table_constraint is:
156
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 ]
164
da8e499e 165=head1 Create Index Syntax
166
167 CREATE [ UNIQUE ] INDEX index_name ON table
168 [ USING acc_method ] ( column [ ops_name ] [, ...] )
169 [ WHERE predicate ]
170 CREATE [ UNIQUE ] INDEX index_name ON table
171 [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
172 [ WHERE predicate ]
173
96844cae 174=cut
f8f0253c 175
96844cae 176# -------------------------------------------------------------------
f8f0253c 177sub produce {
a1d94525 178 my $translator = shift;
a25ac5d2 179 local $DEBUG = $translator->debug;
180 local $WARN = $translator->show_warnings;
a1d94525 181 my $no_comments = $translator->no_comments;
182 my $add_drop_table = $translator->add_drop_table;
183 my $schema = $translator->schema;
5342f5c1 184 my $pargs = $translator->producer_args;
999859d7 185 local %used_names = ();
5342f5c1 186
187 my $postgres_version = $pargs->{postgres_version} || 0;
96844cae 188
bfb5a568 189 my $qt = '';
190 $qt = '"' if ($translator->quote_table_names);
191 my $qf = '';
192 $qf = '"' if ($translator->quote_field_names);
193
da8e499e 194 my $output;
5ee19df8 195 $output .= header_comment unless ($no_comments);
96844cae 196
08d91aad 197 my (@table_defs, @fks);
0c43e0a1 198 for my $table ( $schema->get_tables ) {
08d91aad 199
200 my ($table_def, $fks) = create_table($table,
201 { quote_table_names => $qt,
202 quote_field_names => $qf,
203 no_comments => $no_comments,
5342f5c1 204 postgres_version => $postgres_version,
08d91aad 205 add_drop_table => $add_drop_table,});
206 push @table_defs, $table_def;
207 push @fks, @$fks;
208
da8e499e 209 }
210
296c2701 211 for my $view ( $schema->get_views ) {
212 push @table_defs, create_view($view, {
a25ac5d2 213 add_drop_view => $add_drop_table,
296c2701 214 quote_table_names => $qt,
215 quote_field_names => $qf,
216 no_comments => $no_comments,
217 });
218 }
219
3406fd5b 220 $output = join(";\n\n", @table_defs) . ";\n\n";
08d91aad 221 if ( @fks ) {
222 $output .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
3406fd5b 223 $output .= join( ";\n\n", @fks ) . ";\n";
08d91aad 224 }
021dbce8 225
da8e499e 226 if ( $WARN ) {
227 if ( %truncated ) {
228 warn "Truncated " . keys( %truncated ) . " names:\n";
229 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
230 }
231
232 if ( %unreserve ) {
233 warn "Encounted " . keys( %unreserve ) .
234 " unsafe names in schema (reserved or invalid):\n";
235 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
236 }
f8f0253c 237 }
238
da8e499e 239 return $output;
f8f0253c 240}
241
96844cae 242# -------------------------------------------------------------------
243sub mk_name {
0c43e0a1 244 my $basename = shift || '';
245 my $type = shift || '';
246 my $scope = shift || '';
247 my $critical = shift || '';
96844cae 248 my $basename_orig = $basename;
bfb5a568 249# my $max_id_length = 62;
2ad4c2c8 250 my $max_name = $type
251 ? $max_id_length - (length($type) + 1)
252 : $max_id_length;
96844cae 253 $basename = substr( $basename, 0, $max_name )
254 if length( $basename ) > $max_name;
255 my $name = $type ? "${type}_$basename" : $basename;
256
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;
262 }
263
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;
270
271 warn "The name '$name_orig' has been changed to ",
272 "'$name' to make it unique.\n" if $WARN;
273
274 $scope->{ $name_orig }++;
f8f0253c 275 }
96844cae 276
277 $scope->{ $name }++;
278 return $name;
279}
280
281# -------------------------------------------------------------------
282sub unreserve {
0c43e0a1 283 my $name = shift || '';
284 my $schema_obj_name = shift || '';
285
96844cae 286 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
287
288 # also trap fields that don't begin with a letter
bfb5a568 289 return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
96844cae 290
291 if ( $schema_obj_name ) {
292 ++$unreserve{"$schema_obj_name.$name"};
293 }
294 else {
295 ++$unreserve{"$name (table name)"};
296 }
297
298 my $unreserve = sprintf '%s_', $name;
299 return $unreserve.$suffix;
f8f0253c 300}
301
50840472 302# -------------------------------------------------------------------
303sub next_unused_name {
999859d7 304 my $name = shift || '';
305 if ( !defined( $used_names{$name} ) ) {
50840472 306 $used_names{$name} = $name;
307 return $name;
308 }
999859d7 309
50840472 310 my $i = 2;
999859d7 311 while ( defined( $used_names{ $name . $i } ) ) {
50840472 312 ++$i;
313 }
314 $name .= $i;
315 $used_names{$name} = $name;
316 return $name;
317}
318
999859d7 319
bfb5a568 320sub create_table
321{
322 my ($table, $options) = @_;
323
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;
5342f5c1 328 my $postgres_version = $options->{postgres_version} || 0;
bfb5a568 329
3406fd5b 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);
bfb5a568 336 $table->name($table_name_ur);
337
338# print STDERR "$table_name table_name\n";
5342f5c1 339 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
bfb5a568 340
7ed7402c 341 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
bfb5a568 342
343 if ( $table->comments and !$no_comments ){
344 my $c = "-- Comments: \n-- ";
345 $c .= join "\n-- ", $table->comments;
7ed7402c 346 $c .= "\n--\n";
bfb5a568 347 push @comments, $c;
348 }
349
350 #
351 # Fields
352 #
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,
5342f5c1 358 postgres_version => $postgres_version,
359 type_defs => \@type_defs,
360 type_drops => \@type_drops,
bfb5a568 361 constraint_defs => \@constraint_defs,});
362 }
363
364 #
365 # Index Declarations
366 #
367 my @index_defs = ();
368 # my $idx_name_default;
369 for my $index ( $table->get_indices ) {
370 my ($idef, $constraints) = create_index($index,
371 {
372 quote_field_names => $qf,
373 quote_table_names => $qt,
374 table_name => $table_name,
375 });
7ed7402c 376 $idef and push @index_defs, $idef;
bfb5a568 377 push @constraint_defs, @$constraints;
378 }
379
380 #
381 # Table constraints
382 #
383 my $c_name_default;
384 for my $c ( $table->get_constraints ) {
385 my ($cdefs, $fks) = create_constraint($c,
386 {
387 quote_field_names => $qf,
388 quote_table_names => $qt,
389 table_name => $table_name,
390 });
391 push @constraint_defs, @$cdefs;
392 push @fks, @$fks;
393 }
394
395 my $create_statement;
396 $create_statement = join("\n", @comments);
5342f5c1 397 if ($add_drop_table) {
398 if ($postgres_version >= 8.2) {
399 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
400 $create_statement .= join ("\n", @type_drops) . "\n"
401 if $postgres_version >= 8.3;
402 } else {
403 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
404 }
405 }
406 $create_statement .= join("\n", @type_defs) . "\n"
407 if $postgres_version >= 8.3;
bfb5a568 408 $create_statement .= qq[CREATE TABLE $qt$table_name_ur$qt (\n].
409 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
3406fd5b 410 "\n)"
bfb5a568 411 ;
3406fd5b 412 $create_statement .= @index_defs ? ';' : q{};
413 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
414 . join(";\n", @index_defs);
bfb5a568 415
08d91aad 416 return $create_statement, \@fks;
bfb5a568 417}
418
296c2701 419sub create_view {
420 my ($view, $options) = @_;
421 my $qt = $options->{quote_table_names} || '';
422 my $qf = $options->{quote_field_names} || '';
a25ac5d2 423 my $add_drop_view = $options->{add_drop_view};
296c2701 424
425 my $view_name = $view->name;
426 debug("PKG: Looking at view '${view_name}'\n");
427
428 my $create = '';
429 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
430 unless $options->{no_comments};
a25ac5d2 431 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
296c2701 432 $create .= 'CREATE';
296c2701 433
434 my $extra = $view->extra;
435 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
436 $create .= " VIEW ${qt}${view_name}${qt}";
437
438 if ( my @fields = $view->fields ) {
439 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
440 $create .= " ( ${field_list} )";
441 }
442
443 if ( my $sql = $view->sql ) {
444 $create .= " AS (\n ${sql}\n )";
445 }
446
447 if ( $extra->{check_option} ) {
448 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
449 }
450
296c2701 451 return $create;
452}
453
bfb5a568 454{
455
456 my %field_name_scope;
457
458 sub create_field
459 {
460 my ($field, $options) = @_;
461
462 my $qt = $options->{quote_table_names} || '';
463 my $qf = $options->{quote_field_names} || '';
464 my $table_name = $field->table->name;
465 my $constraint_defs = $options->{constraint_defs} || [];
5342f5c1 466 my $postgres_version = $options->{postgres_version} || 0;
467 my $type_defs = $options->{type_defs} || [];
468 my $type_drops = $options->{type_drops} || [];
bfb5a568 469
470 $field_name_scope{$table_name} ||= {};
471 my $field_name = mk_name(
472 $field->name, '', $field_name_scope{$table_name}, 1
473 );
08d91aad 474 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
bfb5a568 475 $field->name($field_name_ur);
476 my $field_comments = $field->comments
477 ? "-- " . $field->comments . "\n "
478 : '';
479
480 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
481
482 #
483 # Datatype
484 #
485 my @size = $field->size;
486 my $data_type = lc $field->data_type;
487 my %extra = $field->extra;
488 my $list = $extra{'list'} || [];
489 # todo deal with embedded quotes
490 my $commalist = join( ', ', map { qq['$_'] } @$list );
bfb5a568 491
5342f5c1 492 if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
493 my $type_name = $field->table->name . '_' . $field->name . '_type';
494 $field_def .= ' '. $type_name;
3406fd5b 495 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
496 push @$type_drops, "DROP TYPE IF EXISTS $type_name";
5342f5c1 497 } else {
498 $field_def .= ' '. convert_datatype($field);
499 }
bfb5a568 500
501 #
bc8e2aa1 502 # Default value
bfb5a568 503 #
f39e9c12 504 my $default = $field->default_value;
bfb5a568 505 if ( defined $default ) {
bc8e2aa1 506 SQL::Translator::Producer->_apply_default_value(
507 \$field_def,
508 $default,
509 [
510 'NULL' => \'NULL',
511 'now()' => 'now()',
512 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
513 ],
514 );
bfb5a568 515 }
516
517 #
518 # Not null constraint
519 #
520 $field_def .= ' NOT NULL' unless $field->is_nullable;
521
522 return $field_def;
523 }
524}
525
bfb5a568 526 sub create_index
527 {
528 my ($index, $options) = @_;
529
530 my $qt = $options->{quote_table_names} ||'';
531 my $qf = $options->{quote_field_names} ||'';
532 my $table_name = $index->table->name;
08d91aad 533# my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
bfb5a568 534
535 my ($index_def, @constraint_defs);
536
bfb5a568 537 my $name = $index->name || '';
538 if ( $name ) {
999859d7 539 $name = next_unused_name($name);
bfb5a568 540 }
541
542 my $type = $index->type || NORMAL;
543 my @fields =
544 map { $_ =~ s/\(.+\)//; $_ }
08d91aad 545 map { $qt ? $_ : unreserve($_, $table_name ) }
bfb5a568 546 $index->fields;
547 next unless @fields;
548
3406fd5b 549 my $def_start = qq[CONSTRAINT "$name" ];
bfb5a568 550 if ( $type eq PRIMARY_KEY ) {
551 push @constraint_defs, "${def_start}PRIMARY KEY ".
552 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
553 }
554 elsif ( $type eq UNIQUE ) {
555 push @constraint_defs, "${def_start}UNIQUE " .
556 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
557 }
558 elsif ( $type eq NORMAL ) {
559 $index_def =
08d91aad 560 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
bfb5a568 561 join( ', ', map { qq[$qf$_$qf] } @fields ).
3406fd5b 562 ')'
bfb5a568 563 ;
564 }
565 else {
566 warn "Unknown index type ($type) on table $table_name.\n"
567 if $WARN;
568 }
569
570 return $index_def, \@constraint_defs;
571 }
572
573 sub create_constraint
574 {
575 my ($c, $options) = @_;
576
577 my $qf = $options->{quote_field_names} ||'';
578 my $qt = $options->{quote_table_names} ||'';
579 my $table_name = $c->table->name;
580 my (@constraint_defs, @fks);
581
582 my $name = $c->name || '';
583 if ( $name ) {
999859d7 584 $name = next_unused_name($name);
bfb5a568 585 }
586
587 my @fields =
588 map { $_ =~ s/\(.+\)//; $_ }
08d91aad 589 map { $qt ? $_ : unreserve( $_, $table_name )}
bfb5a568 590 $c->fields;
591
592 my @rfields =
593 map { $_ =~ s/\(.+\)//; $_ }
08d91aad 594 map { $qt ? $_ : unreserve( $_, $table_name )}
bfb5a568 595 $c->reference_fields;
596
597 next if !@fields && $c->type ne CHECK_C;
3406fd5b 598 my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
bfb5a568 599 if ( $c->type eq PRIMARY_KEY ) {
600 push @constraint_defs, "${def_start}PRIMARY KEY ".
601 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
602 }
603 elsif ( $c->type eq UNIQUE ) {
999859d7 604 $name = next_unused_name($name);
bfb5a568 605 push @constraint_defs, "${def_start}UNIQUE " .
606 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
607 }
608 elsif ( $c->type eq CHECK_C ) {
609 my $expression = $c->expression;
610 push @constraint_defs, "${def_start}CHECK ($expression)";
611 }
612 elsif ( $c->type eq FOREIGN_KEY ) {
613 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
614 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
615 "\n REFERENCES " . $qt . $c->reference_table . $qt;
616
617 if ( @rfields ) {
618 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
619 }
620
621 if ( $c->match_type ) {
622 $def .= ' MATCH ' .
623 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
624 }
625
626 if ( $c->on_delete ) {
627 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
628 }
629
630 if ( $c->on_update ) {
631 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
632 }
633
5342f5c1 634 if ( $c->deferrable ) {
635 $def .= ' DEFERRABLE';
636 }
637
3406fd5b 638 push @fks, "$def";
bfb5a568 639 }
640
641 return \@constraint_defs, \@fks;
642 }
bfb5a568 643
644sub convert_datatype
645{
646 my ($field) = @_;
647
648 my @size = $field->size;
649 my $data_type = lc $field->data_type;
650
651 if ( $data_type eq 'enum' ) {
652# my $len = 0;
653# $len = ($len < length($_)) ? length($_) : $len for (@$list);
654# my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
655# push @$constraint_defs,
3406fd5b 656# qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
bfb5a568 657# qq[IN ($commalist))];
658 $data_type = 'character varying';
659 }
660 elsif ( $data_type eq 'set' ) {
661 $data_type = 'character varying';
662 }
663 elsif ( $field->is_auto_increment ) {
664 if ( defined $size[0] && $size[0] > 11 ) {
665 $data_type = 'bigserial';
666 }
667 else {
668 $data_type = 'serial';
669 }
670 undef @size;
671 }
672 else {
673 $data_type = defined $translate{ $data_type } ?
674 $translate{ $data_type } :
675 $data_type;
676 }
677
678 if ( $data_type =~ /timestamp/i ) {
679 if ( defined $size[0] && $size[0] > 6 ) {
680 $size[0] = 6;
681 }
682 }
683
684 if ( $data_type eq 'integer' ) {
685 if ( defined $size[0] && $size[0] > 0) {
686 if ( $size[0] > 10 ) {
687 $data_type = 'bigint';
688 }
689 elsif ( $size[0] < 5 ) {
690 $data_type = 'smallint';
691 }
692 else {
693 $data_type = 'integer';
694 }
695 }
696 else {
697 $data_type = 'integer';
698 }
699 }
e56dabb7 700 my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
701 integer smallint text line lseg macaddr money
702 path point polygon real/;
703 foreach (@type_without_size) {
704 if ( $data_type =~ qr/$_/ ) {
705 undef @size; last;
706 }
707 }
bfb5a568 708
bfb5a568 709 if ( defined $size[0] && $size[0] > 0 ) {
710 $data_type .= '(' . join( ',', @size ) . ')';
711 }
08d91aad 712 elsif (defined $size[0] && $data_type eq 'timestamp' ) {
713 $data_type .= '(' . join( ',', @size ) . ')';
714 }
bfb5a568 715
716
717 return $data_type;
718}
719
720
721sub alter_field
722{
723 my ($from_field, $to_field) = @_;
724
725 die "Can't alter field in another table"
726 if($from_field->table->name ne $to_field->table->name);
727
728 my @out;
3406fd5b 729 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
bfb5a568 730 $to_field->table->name,
731 $to_field->name) if(!$to_field->is_nullable and
732 $from_field->is_nullable);
733
734 my $from_dt = convert_datatype($from_field);
735 my $to_dt = convert_datatype($to_field);
3406fd5b 736 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
bfb5a568 737 $to_field->table->name,
738 $to_field->name,
739 $to_dt) if($to_dt ne $from_dt);
740
3406fd5b 741 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
bfb5a568 742 $to_field->table->name,
743 $from_field->name,
744 $to_field->name) if($from_field->name ne $to_field->name);
745
3406fd5b 746 my $old_default = $from_field->default_value;
747 my $new_default = $to_field->default_value;
748 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
bfb5a568 749 $to_field->table->name,
750 $to_field->name,
3406fd5b 751 $to_field->default_value)
752 if ( defined $new_default &&
753 (!defined $old_default || $old_default ne $new_default) );
bfb5a568 754
755 return wantarray ? @out : join("\n", @out);
bfb5a568 756}
757
3406fd5b 758sub rename_field { alter_field(@_) }
759
bfb5a568 760sub add_field
761{
762 my ($new_field) = @_;
763
3406fd5b 764 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
bfb5a568 765 $new_field->table->name,
766 create_field($new_field));
767 return $out;
768
769}
770
771sub drop_field
772{
773 my ($old_field) = @_;
774
3406fd5b 775 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
bfb5a568 776 $old_field->table->name,
777 $old_field->name);
778
779 return $out;
780}
781
3406fd5b 782sub alter_table {
783 my ($to_table, $options) = @_;
784 my $qt = $options->{quote_table_names} || '';
785 my $out = sprintf('ALTER TABLE %s %s',
786 $qt . $to_table->name . $qt,
787 $options->{alter_table_action});
788 return $out;
789}
790
791sub rename_table {
792 my ($old_table, $new_table, $options) = @_;
793 my $qt = $options->{quote_table_names} || '';
794 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
795 return alter_table($old_table, $options);
796}
797
798sub alter_create_index {
799 my ($index, $options) = @_;
800 my $qt = $options->{quote_table_names} || '';
801 my $qf = $options->{quote_field_names} || '';
802 my ($idef, $constraints) = create_index($index, {
803 quote_field_names => $qf,
804 quote_table_names => $qt,
805 table_name => $index->table->name,
806 });
807 return $index->type eq NORMAL ? $idef
808 : sprintf('ALTER TABLE %s ADD %s',
809 $qt . $index->table->name . $qt,
810 join(q{}, @$constraints)
811 );
812}
813
814sub alter_drop_index {
815 my ($index, $options) = @_;
816 my $index_name = $index->name;
817 return "DROP INDEX $index_name";
818}
819
820sub alter_drop_constraint {
821 my ($c, $options) = @_;
822 my $qt = $options->{quote_table_names} || '';
823 my $qc = $options->{quote_field_names} || '';
824 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
825 $qt . $c->table->name . $qt,
826 $qc . $c->name . $qc );
827 return $out;
828}
829
830sub alter_create_constraint {
831 my ($index, $options) = @_;
832 my $qt = $options->{quote_table_names} || '';
833 return $index->type eq FOREIGN_KEY ? join(q{}, @{create_constraint(@_)})
834 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
835 'ADD', join(q{}, map { @{$_} } create_constraint(@_))
836 );
837}
838
839sub drop_table {
840 my ($table, $options) = @_;
841 my $qt = $options->{quote_table_names} || '';
842 return "DROP TABLE $qt$table$qt CASCADE";
843}
844
f8f0253c 8451;
f8f0253c 846
96844cae 847# -------------------------------------------------------------------
848# Life is full of misery, loneliness, and suffering --
849# and it's all over much too soon.
850# Woody Allen
851# -------------------------------------------------------------------
f8f0253c 852
96844cae 853=pod
f8f0253c 854
20770e44 855=head1 SEE ALSO
856
857SQL::Translator, SQL::Translator::Producer::Oracle.
858
f8f0253c 859=head1 AUTHOR
860
20770e44 861Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
f8f0253c 862
863=cut
DDL Tool (dbsrgits@git.shadowcat.co.uk:SQL-Translator.git)