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