lukes' patch: drop if exists under sqlite 3.3+
[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
bfb5a568 220 $output = join("\n\n", @table_defs);
08d91aad 221 if ( @fks ) {
222 $output .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
b08b5416 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
330 my $table_name = $table->name or next;
331 $table_name = mk_name( $table_name, '', undef, 1 );
08d91aad 332 my $table_name_ur = $qt ? $table_name : unreserve($table_name);
bfb5a568 333 $table->name($table_name_ur);
334
335# print STDERR "$table_name table_name\n";
5342f5c1 336 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
bfb5a568 337
7ed7402c 338 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
bfb5a568 339
340 if ( $table->comments and !$no_comments ){
341 my $c = "-- Comments: \n-- ";
342 $c .= join "\n-- ", $table->comments;
7ed7402c 343 $c .= "\n--\n";
bfb5a568 344 push @comments, $c;
345 }
346
347 #
348 # Fields
349 #
350 my %field_name_scope;
351 for my $field ( $table->get_fields ) {
352 push @field_defs, create_field($field, { quote_table_names => $qt,
353 quote_field_names => $qf,
354 table_name => $table_name_ur,
5342f5c1 355 postgres_version => $postgres_version,
356 type_defs => \@type_defs,
357 type_drops => \@type_drops,
bfb5a568 358 constraint_defs => \@constraint_defs,});
359 }
360
361 #
362 # Index Declarations
363 #
364 my @index_defs = ();
365 # my $idx_name_default;
366 for my $index ( $table->get_indices ) {
367 my ($idef, $constraints) = create_index($index,
368 {
369 quote_field_names => $qf,
370 quote_table_names => $qt,
371 table_name => $table_name,
372 });
7ed7402c 373 $idef and push @index_defs, $idef;
bfb5a568 374 push @constraint_defs, @$constraints;
375 }
376
377 #
378 # Table constraints
379 #
380 my $c_name_default;
381 for my $c ( $table->get_constraints ) {
382 my ($cdefs, $fks) = create_constraint($c,
383 {
384 quote_field_names => $qf,
385 quote_table_names => $qt,
386 table_name => $table_name,
387 });
388 push @constraint_defs, @$cdefs;
389 push @fks, @$fks;
390 }
391
392 my $create_statement;
393 $create_statement = join("\n", @comments);
5342f5c1 394 if ($add_drop_table) {
395 if ($postgres_version >= 8.2) {
396 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
397 $create_statement .= join ("\n", @type_drops) . "\n"
398 if $postgres_version >= 8.3;
399 } else {
400 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
401 }
402 }
403 $create_statement .= join("\n", @type_defs) . "\n"
404 if $postgres_version >= 8.3;
bfb5a568 405 $create_statement .= qq[CREATE TABLE $qt$table_name_ur$qt (\n].
406 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
407 "\n);"
408 ;
bfb5a568 409
999859d7 410 $create_statement .= "\n" . join("\n", @index_defs) . "\n";
bfb5a568 411
08d91aad 412 return $create_statement, \@fks;
bfb5a568 413}
414
296c2701 415sub create_view {
416 my ($view, $options) = @_;
417 my $qt = $options->{quote_table_names} || '';
418 my $qf = $options->{quote_field_names} || '';
a25ac5d2 419 my $add_drop_view = $options->{add_drop_view};
296c2701 420
421 my $view_name = $view->name;
422 debug("PKG: Looking at view '${view_name}'\n");
423
424 my $create = '';
425 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
426 unless $options->{no_comments};
a25ac5d2 427 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
296c2701 428 $create .= 'CREATE';
296c2701 429
430 my $extra = $view->extra;
431 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
432 $create .= " VIEW ${qt}${view_name}${qt}";
433
434 if ( my @fields = $view->fields ) {
435 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
436 $create .= " ( ${field_list} )";
437 }
438
439 if ( my $sql = $view->sql ) {
440 $create .= " AS (\n ${sql}\n )";
441 }
442
443 if ( $extra->{check_option} ) {
444 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
445 }
446
447 $create .= ";\n\n";
448 return $create;
449}
450
bfb5a568 451{
452
453 my %field_name_scope;
454
455 sub create_field
456 {
457 my ($field, $options) = @_;
458
459 my $qt = $options->{quote_table_names} || '';
460 my $qf = $options->{quote_field_names} || '';
461 my $table_name = $field->table->name;
462 my $constraint_defs = $options->{constraint_defs} || [];
5342f5c1 463 my $postgres_version = $options->{postgres_version} || 0;
464 my $type_defs = $options->{type_defs} || [];
465 my $type_drops = $options->{type_drops} || [];
bfb5a568 466
467 $field_name_scope{$table_name} ||= {};
468 my $field_name = mk_name(
469 $field->name, '', $field_name_scope{$table_name}, 1
470 );
08d91aad 471 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
bfb5a568 472 $field->name($field_name_ur);
473 my $field_comments = $field->comments
474 ? "-- " . $field->comments . "\n "
475 : '';
476
477 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
478
479 #
480 # Datatype
481 #
482 my @size = $field->size;
483 my $data_type = lc $field->data_type;
484 my %extra = $field->extra;
485 my $list = $extra{'list'} || [];
486 # todo deal with embedded quotes
487 my $commalist = join( ', ', map { qq['$_'] } @$list );
488 my $seq_name;
489
5342f5c1 490 if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
491 my $type_name = $field->table->name . '_' . $field->name . '_type';
492 $field_def .= ' '. $type_name;
493 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist);";
494 push @$type_drops, "DROP TYPE IF EXISTS $type_name;";
495 } else {
496 $field_def .= ' '. convert_datatype($field);
497 }
bfb5a568 498
499 #
500 # Default value -- disallow for timestamps
501 #
f39e9c12 502# my $default = $data_type =~ /(timestamp|date)/i
503# ? undef : $field->default_value;
504 my $default = $field->default_value;
bfb5a568 505 if ( defined $default ) {
f39e9c12 506 my $qd = "'";
507 $qd = '' if ($default eq 'now()' ||
508 $default eq 'CURRENT_TIMESTAMP');
bfb5a568 509 $field_def .= sprintf( ' DEFAULT %s',
510 ( $field->is_auto_increment && $seq_name )
511 ? qq[nextval('"$seq_name"'::text)] :
f39e9c12 512 ( $default =~ m/null/i ) ? 'NULL' : "$qd$default$qd"
bfb5a568 513 );
514 }
515
516 #
517 # Not null constraint
518 #
519 $field_def .= ' NOT NULL' unless $field->is_nullable;
520
521 return $field_def;
522 }
523}
524
bfb5a568 525 sub create_index
526 {
527 my ($index, $options) = @_;
528
529 my $qt = $options->{quote_table_names} ||'';
530 my $qf = $options->{quote_field_names} ||'';
531 my $table_name = $index->table->name;
08d91aad 532# my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
bfb5a568 533
534 my ($index_def, @constraint_defs);
535
bfb5a568 536 my $name = $index->name || '';
537 if ( $name ) {
999859d7 538 $name = next_unused_name($name);
bfb5a568 539 }
540
541 my $type = $index->type || NORMAL;
542 my @fields =
543 map { $_ =~ s/\(.+\)//; $_ }
08d91aad 544 map { $qt ? $_ : unreserve($_, $table_name ) }
bfb5a568 545 $index->fields;
546 next unless @fields;
547
548 my $def_start = qq[Constraint "$name" ];
549 if ( $type eq PRIMARY_KEY ) {
550 push @constraint_defs, "${def_start}PRIMARY KEY ".
551 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
552 }
553 elsif ( $type eq UNIQUE ) {
554 push @constraint_defs, "${def_start}UNIQUE " .
555 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
556 }
557 elsif ( $type eq NORMAL ) {
558 $index_def =
08d91aad 559 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
bfb5a568 560 join( ', ', map { qq[$qf$_$qf] } @fields ).
561 ');'
562 ;
563 }
564 else {
565 warn "Unknown index type ($type) on table $table_name.\n"
566 if $WARN;
567 }
568
569 return $index_def, \@constraint_defs;
570 }
571
572 sub create_constraint
573 {
574 my ($c, $options) = @_;
575
576 my $qf = $options->{quote_field_names} ||'';
577 my $qt = $options->{quote_table_names} ||'';
578 my $table_name = $c->table->name;
579 my (@constraint_defs, @fks);
580
581 my $name = $c->name || '';
582 if ( $name ) {
999859d7 583 $name = next_unused_name($name);
bfb5a568 584 }
585
586 my @fields =
587 map { $_ =~ s/\(.+\)//; $_ }
08d91aad 588 map { $qt ? $_ : unreserve( $_, $table_name )}
bfb5a568 589 $c->fields;
590
591 my @rfields =
592 map { $_ =~ s/\(.+\)//; $_ }
08d91aad 593 map { $qt ? $_ : unreserve( $_, $table_name )}
bfb5a568 594 $c->reference_fields;
595
596 next if !@fields && $c->type ne CHECK_C;
597 my $def_start = $name ? qq[Constraint "$name" ] : '';
598 if ( $c->type eq PRIMARY_KEY ) {
599 push @constraint_defs, "${def_start}PRIMARY KEY ".
600 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
601 }
602 elsif ( $c->type eq UNIQUE ) {
999859d7 603 $name = next_unused_name($name);
bfb5a568 604 push @constraint_defs, "${def_start}UNIQUE " .
605 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
606 }
607 elsif ( $c->type eq CHECK_C ) {
608 my $expression = $c->expression;
609 push @constraint_defs, "${def_start}CHECK ($expression)";
610 }
611 elsif ( $c->type eq FOREIGN_KEY ) {
612 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
613 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
614 "\n REFERENCES " . $qt . $c->reference_table . $qt;
615
616 if ( @rfields ) {
617 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
618 }
619
620 if ( $c->match_type ) {
621 $def .= ' MATCH ' .
622 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
623 }
624
625 if ( $c->on_delete ) {
626 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
627 }
628
629 if ( $c->on_update ) {
630 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
631 }
632
5342f5c1 633 if ( $c->deferrable ) {
634 $def .= ' DEFERRABLE';
635 }
636
bfb5a568 637 push @fks, "$def;";
638 }
639
640 return \@constraint_defs, \@fks;
641 }
bfb5a568 642
643sub convert_datatype
644{
645 my ($field) = @_;
646
647 my @size = $field->size;
648 my $data_type = lc $field->data_type;
649
650 if ( $data_type eq 'enum' ) {
651# my $len = 0;
652# $len = ($len < length($_)) ? length($_) : $len for (@$list);
653# my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
654# push @$constraint_defs,
655# qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
656# qq[IN ($commalist))];
657 $data_type = 'character varying';
658 }
659 elsif ( $data_type eq 'set' ) {
660 $data_type = 'character varying';
661 }
662 elsif ( $field->is_auto_increment ) {
663 if ( defined $size[0] && $size[0] > 11 ) {
664 $data_type = 'bigserial';
665 }
666 else {
667 $data_type = 'serial';
668 }
669 undef @size;
670 }
671 else {
672 $data_type = defined $translate{ $data_type } ?
673 $translate{ $data_type } :
674 $data_type;
675 }
676
677 if ( $data_type =~ /timestamp/i ) {
678 if ( defined $size[0] && $size[0] > 6 ) {
679 $size[0] = 6;
680 }
681 }
682
683 if ( $data_type eq 'integer' ) {
684 if ( defined $size[0] && $size[0] > 0) {
685 if ( $size[0] > 10 ) {
686 $data_type = 'bigint';
687 }
688 elsif ( $size[0] < 5 ) {
689 $data_type = 'smallint';
690 }
691 else {
692 $data_type = 'integer';
693 }
694 }
695 else {
696 $data_type = 'integer';
697 }
698 }
e56dabb7 699 my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
700 integer smallint text line lseg macaddr money
701 path point polygon real/;
702 foreach (@type_without_size) {
703 if ( $data_type =~ qr/$_/ ) {
704 undef @size; last;
705 }
706 }
bfb5a568 707
bfb5a568 708 if ( defined $size[0] && $size[0] > 0 ) {
709 $data_type .= '(' . join( ',', @size ) . ')';
710 }
08d91aad 711 elsif (defined $size[0] && $data_type eq 'timestamp' ) {
712 $data_type .= '(' . join( ',', @size ) . ')';
713 }
bfb5a568 714
715
716 return $data_type;
717}
718
719
720sub alter_field
721{
722 my ($from_field, $to_field) = @_;
723
724 die "Can't alter field in another table"
725 if($from_field->table->name ne $to_field->table->name);
726
727 my @out;
728 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
729 $to_field->table->name,
730 $to_field->name) if(!$to_field->is_nullable and
731 $from_field->is_nullable);
732
733 my $from_dt = convert_datatype($from_field);
734 my $to_dt = convert_datatype($to_field);
735 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
736 $to_field->table->name,
737 $to_field->name,
738 $to_dt) if($to_dt ne $from_dt);
739
740 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
741 $to_field->table->name,
742 $from_field->name,
743 $to_field->name) if($from_field->name ne $to_field->name);
744
745 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
746 $to_field->table->name,
747 $to_field->name,
748 $to_field->default_value)
749 if(defined $to_field->default_value &&
750 $from_field->default_value ne $to_field->default_value);
751
752 return wantarray ? @out : join("\n", @out);
753
754}
755
756sub add_field
757{
758 my ($new_field) = @_;
759
760 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
761 $new_field->table->name,
762 create_field($new_field));
763 return $out;
764
765}
766
767sub drop_field
768{
769 my ($old_field) = @_;
770
771 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
772 $old_field->table->name,
773 $old_field->name);
774
775 return $out;
776}
777
f8f0253c 7781;
f8f0253c 779
96844cae 780# -------------------------------------------------------------------
781# Life is full of misery, loneliness, and suffering --
782# and it's all over much too soon.
783# Woody Allen
784# -------------------------------------------------------------------
f8f0253c 785
96844cae 786=pod
f8f0253c 787
20770e44 788=head1 SEE ALSO
789
790SQL::Translator, SQL::Translator::Producer::Oracle.
791
f8f0253c 792=head1 AUTHOR
793
20770e44 794Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
f8f0253c 795
796=cut