projects / dbsrgits/SQL-Translator.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
fix test expectations
[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 );
bfb5a568 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 #
bc8e2aa1 499 # Default value
bfb5a568 500 #
f39e9c12 501 my $default = $field->default_value;
bfb5a568 502 if ( defined $default ) {
bc8e2aa1 503 SQL::Translator::Producer->_apply_default_value(
504 \$field_def,
505 $default,
506 [
507 'NULL' => \'NULL',
508 'now()' => 'now()',
509 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
510 ],
511 );
bfb5a568 512 }
513
514 #
515 # Not null constraint
516 #
517 $field_def .= ' NOT NULL' unless $field->is_nullable;
518
519 return $field_def;
520 }
521}
522
bfb5a568 523 sub create_index
524 {
525 my ($index, $options) = @_;
526
527 my $qt = $options->{quote_table_names} ||'';
528 my $qf = $options->{quote_field_names} ||'';
529 my $table_name = $index->table->name;
08d91aad 530# my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
bfb5a568 531
532 my ($index_def, @constraint_defs);
533
bfb5a568 534 my $name = $index->name || '';
535 if ( $name ) {
999859d7 536 $name = next_unused_name($name);
bfb5a568 537 }
538
539 my $type = $index->type || NORMAL;
540 my @fields =
541 map { $_ =~ s/\(.+\)//; $_ }
08d91aad 542 map { $qt ? $_ : unreserve($_, $table_name ) }
bfb5a568 543 $index->fields;
544 next unless @fields;
545
546 my $def_start = qq[Constraint "$name" ];
547 if ( $type eq PRIMARY_KEY ) {
548 push @constraint_defs, "${def_start}PRIMARY KEY ".
549 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
550 }
551 elsif ( $type eq UNIQUE ) {
552 push @constraint_defs, "${def_start}UNIQUE " .
553 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
554 }
555 elsif ( $type eq NORMAL ) {
556 $index_def =
08d91aad 557 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
bfb5a568 558 join( ', ', map { qq[$qf$_$qf] } @fields ).
559 ');'
560 ;
561 }
562 else {
563 warn "Unknown index type ($type) on table $table_name.\n"
564 if $WARN;
565 }
566
567 return $index_def, \@constraint_defs;
568 }
569
570 sub create_constraint
571 {
572 my ($c, $options) = @_;
573
574 my $qf = $options->{quote_field_names} ||'';
575 my $qt = $options->{quote_table_names} ||'';
576 my $table_name = $c->table->name;
577 my (@constraint_defs, @fks);
578
579 my $name = $c->name || '';
580 if ( $name ) {
999859d7 581 $name = next_unused_name($name);
bfb5a568 582 }
583
584 my @fields =
585 map { $_ =~ s/\(.+\)//; $_ }
08d91aad 586 map { $qt ? $_ : unreserve( $_, $table_name )}
bfb5a568 587 $c->fields;
588
589 my @rfields =
590 map { $_ =~ s/\(.+\)//; $_ }
08d91aad 591 map { $qt ? $_ : unreserve( $_, $table_name )}
bfb5a568 592 $c->reference_fields;
593
594 next if !@fields && $c->type ne CHECK_C;
595 my $def_start = $name ? qq[Constraint "$name" ] : '';
596 if ( $c->type eq PRIMARY_KEY ) {
597 push @constraint_defs, "${def_start}PRIMARY KEY ".
598 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
599 }
600 elsif ( $c->type eq UNIQUE ) {
999859d7 601 $name = next_unused_name($name);
bfb5a568 602 push @constraint_defs, "${def_start}UNIQUE " .
603 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
604 }
605 elsif ( $c->type eq CHECK_C ) {
606 my $expression = $c->expression;
607 push @constraint_defs, "${def_start}CHECK ($expression)";
608 }
609 elsif ( $c->type eq FOREIGN_KEY ) {
610 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
611 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
612 "\n REFERENCES " . $qt . $c->reference_table . $qt;
613
614 if ( @rfields ) {
615 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
616 }
617
618 if ( $c->match_type ) {
619 $def .= ' MATCH ' .
620 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
621 }
622
623 if ( $c->on_delete ) {
624 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
625 }
626
627 if ( $c->on_update ) {
628 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
629 }
630
5342f5c1 631 if ( $c->deferrable ) {
632 $def .= ' DEFERRABLE';
633 }
634
bfb5a568 635 push @fks, "$def;";
636 }
637
638 return \@constraint_defs, \@fks;
639 }
bfb5a568 640
641sub convert_datatype
642{
643 my ($field) = @_;
644
645 my @size = $field->size;
646 my $data_type = lc $field->data_type;
647
648 if ( $data_type eq 'enum' ) {
649# my $len = 0;
650# $len = ($len < length($_)) ? length($_) : $len for (@$list);
651# my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
652# push @$constraint_defs,
653# qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ].
654# qq[IN ($commalist))];
655 $data_type = 'character varying';
656 }
657 elsif ( $data_type eq 'set' ) {
658 $data_type = 'character varying';
659 }
660 elsif ( $field->is_auto_increment ) {
661 if ( defined $size[0] && $size[0] > 11 ) {
662 $data_type = 'bigserial';
663 }
664 else {
665 $data_type = 'serial';
666 }
667 undef @size;
668 }
669 else {
670 $data_type = defined $translate{ $data_type } ?
671 $translate{ $data_type } :
672 $data_type;
673 }
674
675 if ( $data_type =~ /timestamp/i ) {
676 if ( defined $size[0] && $size[0] > 6 ) {
677 $size[0] = 6;
678 }
679 }
680
681 if ( $data_type eq 'integer' ) {
682 if ( defined $size[0] && $size[0] > 0) {
683 if ( $size[0] > 10 ) {
684 $data_type = 'bigint';
685 }
686 elsif ( $size[0] < 5 ) {
687 $data_type = 'smallint';
688 }
689 else {
690 $data_type = 'integer';
691 }
692 }
693 else {
694 $data_type = 'integer';
695 }
696 }
e56dabb7 697 my @type_without_size = qw/bigint boolean box bytea cidr circle date inet
698 integer smallint text line lseg macaddr money
699 path point polygon real/;
700 foreach (@type_without_size) {
701 if ( $data_type =~ qr/$_/ ) {
702 undef @size; last;
703 }
704 }
bfb5a568 705
bfb5a568 706 if ( defined $size[0] && $size[0] > 0 ) {
707 $data_type .= '(' . join( ',', @size ) . ')';
708 }
08d91aad 709 elsif (defined $size[0] && $data_type eq 'timestamp' ) {
710 $data_type .= '(' . join( ',', @size ) . ')';
711 }
bfb5a568 712
713
714 return $data_type;
715}
716
717
718sub alter_field
719{
720 my ($from_field, $to_field) = @_;
721
722 die "Can't alter field in another table"
723 if($from_field->table->name ne $to_field->table->name);
724
725 my @out;
726 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;',
727 $to_field->table->name,
728 $to_field->name) if(!$to_field->is_nullable and
729 $from_field->is_nullable);
730
731 my $from_dt = convert_datatype($from_field);
732 my $to_dt = convert_datatype($to_field);
733 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;',
734 $to_field->table->name,
735 $to_field->name,
736 $to_dt) if($to_dt ne $from_dt);
737
738 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;',
739 $to_field->table->name,
740 $from_field->name,
741 $to_field->name) if($from_field->name ne $to_field->name);
742
743 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;',
744 $to_field->table->name,
745 $to_field->name,
746 $to_field->default_value)
747 if(defined $to_field->default_value &&
748 $from_field->default_value ne $to_field->default_value);
749
750 return wantarray ? @out : join("\n", @out);
751
752}
753
754sub add_field
755{
756 my ($new_field) = @_;
757
758 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s;',
759 $new_field->table->name,
760 create_field($new_field));
761 return $out;
762
763}
764
765sub drop_field
766{
767 my ($old_field) = @_;
768
769 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;',
770 $old_field->table->name,
771 $old_field->name);
772
773 return $out;
774}
775
f8f0253c 7761;
f8f0253c 777
96844cae 778# -------------------------------------------------------------------
779# Life is full of misery, loneliness, and suffering --
780# and it's all over much too soon.
781# Woody Allen
782# -------------------------------------------------------------------
f8f0253c 783
96844cae 784=pod
f8f0253c 785
20770e44 786=head1 SEE ALSO
787
788SQL::Translator, SQL::Translator::Producer::Oracle.
789
f8f0253c 790=head1 AUTHOR
791
20770e44 792Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
f8f0253c 793
794=cut
DDL Tool (dbsrgits@git.shadowcat.co.uk:SQL-Translator.git)