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