Add support for PostGIS Geometry and Geography data types
[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
e83ad71c 35Now handles PostGIS Geometry and Geography data types on table definitions.
36Does not yet support PostGIS Views.
37
96844cae 38=cut
39
f8f0253c 40use strict;
bfb5a568 41use warnings;
da06ac74 42use vars qw[ $DEBUG $WARN $VERSION %used_names ];
11ad2df9 43$VERSION = '1.59';
a25ac5d2 44$DEBUG = 0 unless defined $DEBUG;
f8f0253c 45
8d11f4cb 46use base qw(SQL::Translator::Producer);
0c43e0a1 47use SQL::Translator::Schema::Constants;
7b4b17aa 48use SQL::Translator::Utils qw(debug header_comment parse_dbms_version);
f8f0253c 49use Data::Dumper;
50
892573f2 51my ( %translate, %index_name );
bfb5a568 52my $max_id_length;
53
54BEGIN {
55
56 %translate = (
d529894e 57 #
58 # MySQL types
59 #
60 bigint => 'bigint',
4328d7bd 61 double => 'numeric',
62 decimal => 'numeric',
63 float => 'numeric',
d529894e 64 int => 'integer',
65 mediumint => 'integer',
66 smallint => 'smallint',
67 tinyint => 'smallint',
c8c17a58 68 char => 'character',
da8e499e 69 varchar => 'character varying',
d529894e 70 longtext => 'text',
71 mediumtext => 'text',
72 text => 'text',
73 tinytext => 'text',
74 tinyblob => 'bytea',
75 blob => 'bytea',
76 mediumblob => 'bytea',
77 longblob => 'bytea',
da8e499e 78 enum => 'character varying',
79 set => 'character varying',
d529894e 80 date => 'date',
81 datetime => 'timestamp',
e56dabb7 82 time => 'time',
d529894e 83 timestamp => 'timestamp',
84 year => 'date',
85
86 #
87 # Oracle types
88 #
96844cae 89 number => 'integer',
c8c17a58 90 char => 'character',
da8e499e 91 varchar2 => 'character varying',
96844cae 92 long => 'text',
93 CLOB => 'bytea',
94 date => 'date',
95
96 #
97 # Sybase types
98 #
99 int => 'integer',
100 money => 'money',
da8e499e 101 varchar => 'character varying',
96844cae 102 datetime => 'timestamp',
103 text => 'text',
4328d7bd 104 real => 'numeric',
96844cae 105 comment => 'text',
106 bit => 'bit',
107 tinyint => 'smallint',
4328d7bd 108 float => 'numeric',
d529894e 109);
110
bfb5a568 111 $max_id_length = 62;
112}
96844cae 113my %reserved = map { $_, 1 } qw[
114 ALL ANALYSE ANALYZE AND ANY AS ASC
115 BETWEEN BINARY BOTH
116 CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
117 CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
118 DEFAULT DEFERRABLE DESC DISTINCT DO
119 ELSE END EXCEPT
120 FALSE FOR FOREIGN FREEZE FROM FULL
121 GROUP HAVING
122 ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
123 JOIN LEADING LEFT LIKE LIMIT
124 NATURAL NEW NOT NOTNULL NULL
125 OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
126 PRIMARY PUBLIC REFERENCES RIGHT
127 SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
128 UNION UNIQUE USER USING VERBOSE WHEN WHERE
129];
d529894e 130
bfb5a568 131# my $max_id_length = 62;
96844cae 132my %used_identifiers = ();
133my %global_names;
134my %unreserve;
135my %truncated;
136
137=pod
138
139=head1 PostgreSQL Create Table Syntax
140
141 CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
142 { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
143 | table_constraint } [, ... ]
144 )
145 [ INHERITS ( parent_table [, ... ] ) ]
146 [ WITH OIDS | WITHOUT OIDS ]
147
148where column_constraint is:
149
150 [ CONSTRAINT constraint_name ]
151 { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
152 CHECK (expression) |
153 REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
154 [ ON DELETE action ] [ ON UPDATE action ] }
155 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
156
157and table_constraint is:
158
159 [ CONSTRAINT constraint_name ]
160 { UNIQUE ( column_name [, ... ] ) |
161 PRIMARY KEY ( column_name [, ... ] ) |
162 CHECK ( expression ) |
163 FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
164 [ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
165 [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
166
da8e499e 167=head1 Create Index Syntax
168
169 CREATE [ UNIQUE ] INDEX index_name ON table
170 [ USING acc_method ] ( column [ ops_name ] [, ...] )
171 [ WHERE predicate ]
172 CREATE [ UNIQUE ] INDEX index_name ON table
173 [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
174 [ WHERE predicate ]
175
96844cae 176=cut
f8f0253c 177
96844cae 178# -------------------------------------------------------------------
f8f0253c 179sub produce {
e189562c 180 my $translator = shift;
181 local $DEBUG = $translator->debug;
182 local $WARN = $translator->show_warnings;
183 my $no_comments = $translator->no_comments;
184 my $add_drop_table = $translator->add_drop_table;
185 my $schema = $translator->schema;
186 my $pargs = $translator->producer_args;
7b4b17aa 187 my $postgres_version = parse_dbms_version(
188 $pargs->{postgres_version}, 'perl'
189 );
96844cae 190
e189562c 191 my $qt = $translator->quote_table_names ? q{"} : q{};
192 my $qf = $translator->quote_field_names ? q{"} : q{};
bfb5a568 193
bf75adec 194 my @output;
195 push @output, header_comment unless ($no_comments);
96844cae 196
08d91aad 197 my (@table_defs, @fks);
0c43e0a1 198 for my $table ( $schema->get_tables ) {
08d91aad 199
e189562c 200 my ($table_def, $fks) = create_table($table, {
201 quote_table_names => $qt,
202 quote_field_names => $qf,
203 no_comments => $no_comments,
204 postgres_version => $postgres_version,
205 add_drop_table => $add_drop_table,
206 });
207
08d91aad 208 push @table_defs, $table_def;
209 push @fks, @$fks;
da8e499e 210 }
211
296c2701 212 for my $view ( $schema->get_views ) {
213 push @table_defs, create_view($view, {
a25ac5d2 214 add_drop_view => $add_drop_table,
296c2701 215 quote_table_names => $qt,
216 quote_field_names => $qf,
217 no_comments => $no_comments,
218 });
219 }
220
bf75adec 221 push @output, map { "$_;\n\n" } @table_defs;
08d91aad 222 if ( @fks ) {
bf75adec 223 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
224 push @output, map { "$_;\n\n" } @fks;
08d91aad 225 }
021dbce8 226
da8e499e 227 if ( $WARN ) {
228 if ( %truncated ) {
229 warn "Truncated " . keys( %truncated ) . " names:\n";
230 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
231 }
232
233 if ( %unreserve ) {
234 warn "Encounted " . keys( %unreserve ) .
235 " unsafe names in schema (reserved or invalid):\n";
236 warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
237 }
f8f0253c 238 }
239
bf75adec 240 return wantarray
241 ? @output
242 : join ('', @output);
f8f0253c 243}
244
96844cae 245# -------------------------------------------------------------------
246sub mk_name {
0c43e0a1 247 my $basename = shift || '';
248 my $type = shift || '';
249 my $scope = shift || '';
250 my $critical = shift || '';
96844cae 251 my $basename_orig = $basename;
bfb5a568 252# my $max_id_length = 62;
2ad4c2c8 253 my $max_name = $type
254 ? $max_id_length - (length($type) + 1)
255 : $max_id_length;
96844cae 256 $basename = substr( $basename, 0, $max_name )
257 if length( $basename ) > $max_name;
258 my $name = $type ? "${type}_$basename" : $basename;
259
260 if ( $basename ne $basename_orig and $critical ) {
261 my $show_type = $type ? "+'$type'" : "";
262 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
263 "character limit to make '$name'\n" if $WARN;
264 $truncated{ $basename_orig } = $name;
265 }
266
267 $scope ||= \%global_names;
268 if ( my $prev = $scope->{ $name } ) {
269 my $name_orig = $name;
270 $name .= sprintf( "%02d", ++$prev );
271 substr($name, $max_id_length - 3) = "00"
272 if length( $name ) > $max_id_length;
273
274 warn "The name '$name_orig' has been changed to ",
275 "'$name' to make it unique.\n" if $WARN;
276
277 $scope->{ $name_orig }++;
f8f0253c 278 }
96844cae 279
280 $scope->{ $name }++;
281 return $name;
282}
283
284# -------------------------------------------------------------------
285sub unreserve {
0c43e0a1 286 my $name = shift || '';
287 my $schema_obj_name = shift || '';
288
96844cae 289 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
290
291 # also trap fields that don't begin with a letter
bfb5a568 292 return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
96844cae 293
294 if ( $schema_obj_name ) {
295 ++$unreserve{"$schema_obj_name.$name"};
296 }
297 else {
298 ++$unreserve{"$name (table name)"};
299 }
300
301 my $unreserve = sprintf '%s_', $name;
302 return $unreserve.$suffix;
f8f0253c 303}
304
50840472 305# -------------------------------------------------------------------
306sub next_unused_name {
f5191f69 307 my $orig_name = shift or return;
308 my $name = $orig_name;
309
310 my $suffix_gen = sub {
311 my $suffix = 0;
312 return ++$suffix ? '' : $suffix;
313 };
999859d7 314
f5191f69 315 for (;;) {
316 $name = $orig_name . $suffix_gen->();
317 last if $used_names{ $name }++;
50840472 318 }
f5191f69 319
50840472 320 return $name;
321}
322
e83ad71c 323sub is_geometry
324{
325 my $field = shift;
326 return 1 if $field->data_type eq 'geometry' || $field->data_type eq 'geography';
327}
328
bfb5a568 329sub create_table
330{
331 my ($table, $options) = @_;
332
333 my $qt = $options->{quote_table_names} || '';
334 my $qf = $options->{quote_field_names} || '';
335 my $no_comments = $options->{no_comments} || 0;
336 my $add_drop_table = $options->{add_drop_table} || 0;
5342f5c1 337 my $postgres_version = $options->{postgres_version} || 0;
bfb5a568 338
3406fd5b 339 my $table_name = $table->name or next;
3406fd5b 340 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
341 my $table_name_ur = $qt ? $table_name
342 : $fql_tbl_name ? join('.', $table_name, unreserve($fql_tbl_name))
343 : unreserve($table_name);
bfb5a568 344 $table->name($table_name_ur);
345
124b192c 346# print STDERR "$table_name table_name\n";
5342f5c1 347 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
bfb5a568 348
7ed7402c 349 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
bfb5a568 350
351 if ( $table->comments and !$no_comments ){
352 my $c = "-- Comments: \n-- ";
353 $c .= join "\n-- ", $table->comments;
7ed7402c 354 $c .= "\n--\n";
bfb5a568 355 push @comments, $c;
356 }
357
358 #
359 # Fields
360 #
361 my %field_name_scope;
362 for my $field ( $table->get_fields ) {
363 push @field_defs, create_field($field, { quote_table_names => $qt,
364 quote_field_names => $qf,
365 table_name => $table_name_ur,
5342f5c1 366 postgres_version => $postgres_version,
367 type_defs => \@type_defs,
368 type_drops => \@type_drops,
bfb5a568 369 constraint_defs => \@constraint_defs,});
370 }
371
372 #
373 # Index Declarations
374 #
375 my @index_defs = ();
376 # my $idx_name_default;
377 for my $index ( $table->get_indices ) {
378 my ($idef, $constraints) = create_index($index,
379 {
380 quote_field_names => $qf,
381 quote_table_names => $qt,
382 table_name => $table_name,
383 });
7ed7402c 384 $idef and push @index_defs, $idef;
bfb5a568 385 push @constraint_defs, @$constraints;
386 }
387
388 #
389 # Table constraints
390 #
391 my $c_name_default;
392 for my $c ( $table->get_constraints ) {
393 my ($cdefs, $fks) = create_constraint($c,
394 {
395 quote_field_names => $qf,
396 quote_table_names => $qt,
397 table_name => $table_name,
398 });
399 push @constraint_defs, @$cdefs;
400 push @fks, @$fks;
401 }
402
3e98f7d9 403
404 my $temporary = "";
405
406 if(exists $table->{extra}{temporary}) {
407 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
408 }
409
bfb5a568 410 my $create_statement;
411 $create_statement = join("\n", @comments);
5342f5c1 412 if ($add_drop_table) {
7b4b17aa 413 if ($postgres_version >= 8.002) {
5342f5c1 414 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
938464ee 415 $create_statement .= join (";\n", @type_drops) . ";\n"
7b4b17aa 416 if $postgres_version >= 8.003 && scalar @type_drops;
5342f5c1 417 } else {
418 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
419 }
420 }
938464ee 421 $create_statement .= join(";\n", @type_defs) . ";\n"
7b4b17aa 422 if $postgres_version >= 8.003 && scalar @type_defs;
3e98f7d9 423 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
bfb5a568 424 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
3406fd5b 425 "\n)"
bfb5a568 426 ;
3406fd5b 427 $create_statement .= @index_defs ? ';' : q{};
428 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
429 . join(";\n", @index_defs);
bfb5a568 430
e83ad71c 431 #
432 # Geometry
433 #
434 if(grep { is_geometry($_) } $table->get_fields){
435 $create_statement .= ";";
436 $create_statement .= "\n".join("\n", map { drop_geometry_column($_) if is_geometry($_); } $table->get_fields) if $options->{add_drop_table};
437 $create_statement .= "\n".join("\n", map { add_geometry_column($_) if is_geometry($_);} $table->get_fields);
438 }
439
08d91aad 440 return $create_statement, \@fks;
bfb5a568 441}
442
296c2701 443sub create_view {
444 my ($view, $options) = @_;
445 my $qt = $options->{quote_table_names} || '';
446 my $qf = $options->{quote_field_names} || '';
a25ac5d2 447 my $add_drop_view = $options->{add_drop_view};
296c2701 448
449 my $view_name = $view->name;
450 debug("PKG: Looking at view '${view_name}'\n");
451
452 my $create = '';
453 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
454 unless $options->{no_comments};
a25ac5d2 455 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
296c2701 456 $create .= 'CREATE';
296c2701 457
458 my $extra = $view->extra;
459 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
460 $create .= " VIEW ${qt}${view_name}${qt}";
461
462 if ( my @fields = $view->fields ) {
463 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
464 $create .= " ( ${field_list} )";
465 }
466
467 if ( my $sql = $view->sql ) {
f59b2c0e 468 $create .= " AS\n ${sql}\n";
296c2701 469 }
470
471 if ( $extra->{check_option} ) {
472 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
473 }
474
296c2701 475 return $create;
476}
477
bfb5a568 478{
479
480 my %field_name_scope;
481
482 sub create_field
483 {
484 my ($field, $options) = @_;
485
486 my $qt = $options->{quote_table_names} || '';
487 my $qf = $options->{quote_field_names} || '';
488 my $table_name = $field->table->name;
489 my $constraint_defs = $options->{constraint_defs} || [];
5342f5c1 490 my $postgres_version = $options->{postgres_version} || 0;
491 my $type_defs = $options->{type_defs} || [];
492 my $type_drops = $options->{type_drops} || [];
bfb5a568 493
494 $field_name_scope{$table_name} ||= {};
912e67a1 495 my $field_name = $field->name;
08d91aad 496 my $field_name_ur = $qf ? $field_name : unreserve($field_name, $table_name );
bfb5a568 497 $field->name($field_name_ur);
498 my $field_comments = $field->comments
499 ? "-- " . $field->comments . "\n "
500 : '';
501
502 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
503
504 #
505 # Datatype
506 #
507 my @size = $field->size;
508 my $data_type = lc $field->data_type;
509 my %extra = $field->extra;
510 my $list = $extra{'list'} || [];
511 # todo deal with embedded quotes
512 my $commalist = join( ', ', map { qq['$_'] } @$list );
bfb5a568 513
7b4b17aa 514 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
5342f5c1 515 my $type_name = $field->table->name . '_' . $field->name . '_type';
516 $field_def .= ' '. $type_name;
3406fd5b 517 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
518 push @$type_drops, "DROP TYPE IF EXISTS $type_name";
5342f5c1 519 } else {
520 $field_def .= ' '. convert_datatype($field);
521 }
bfb5a568 522
523 #
bc8e2aa1 524 # Default value
bfb5a568 525 #
06baeb21 526 SQL::Translator::Producer->_apply_default_value(
527 $field,
528 \$field_def,
529 [
530 'NULL' => \'NULL',
531 'now()' => 'now()',
532 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
533 ],
534 );
bfb5a568 535
536 #
537 # Not null constraint
538 #
539 $field_def .= ' NOT NULL' unless $field->is_nullable;
540
e83ad71c 541 #
542 # Geometry constraints
543 #
544 if(is_geometry($field)){
545 foreach ( create_geometry_constraints($field) ) {
546 my ($cdefs, $fks) = create_constraint($_,
547 {
548 quote_field_names => $qf,
549 quote_table_names => $qt,
550 table_name => $table_name,
551 });
552 push @$constraint_defs, @$cdefs;
553 push @$fks, @$fks;
554 }
555 }
556
bfb5a568 557 return $field_def;
558 }
559}
560
e83ad71c 561sub create_geometry_constraints{
562 my $field = shift;
563
564 my @constraints;
565 push @constraints, SQL::Translator::Schema::Constraint->new(
566 name => "enforce_dims_".$field->name,
567 expression => "(st_ndims($field) = ".$field->{extra}{dimensions}.")",
568 table => $field->table,
569 type => CHECK_C,
570 );
571
572 push @constraints, SQL::Translator::Schema::Constraint->new(
573 name => "enforce_srid_".$field->name,
574 expression => "(st_srid($field) = ".$field->{extra}{srid}.")",
575 table => $field->table,
576 type => CHECK_C,
577 );
578 push @constraints, SQL::Translator::Schema::Constraint->new(
579 name => "enforce_geotype_".$field->name,
580 expression => "(geometrytype($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
581 table => $field->table,
582 type => CHECK_C,
583 );
584
585 return @constraints;
586}
587
892573f2 588sub create_index
589{
590 my ($index, $options) = @_;
bfb5a568 591
892573f2 592 my $qt = $options->{quote_table_names} ||'';
593 my $qf = $options->{quote_field_names} ||'';
594 my $table_name = $index->table->name;
124b192c 595# my $table_name_ur = $qt ? unreserve($table_name) : $table_name;
bfb5a568 596
892573f2 597 my ($index_def, @constraint_defs);
bfb5a568 598
892573f2 599 my $name = next_unused_name(
600 $index->name
601 || join('_', $table_name, 'idx', ++$index_name{ $table_name })
602 );
bfb5a568 603
892573f2 604 my $type = $index->type || NORMAL;
605 my @fields =
606 map { $_ =~ s/\(.+\)//; $_ }
607 map { $qt ? $_ : unreserve($_, $table_name ) }
608 $index->fields;
609 next unless @fields;
bfb5a568 610
892573f2 611 my $def_start = qq[CONSTRAINT "$name" ];
612 if ( $type eq PRIMARY_KEY ) {
613 push @constraint_defs, "${def_start}PRIMARY KEY ".
614 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
615 }
616 elsif ( $type eq UNIQUE ) {
617 push @constraint_defs, "${def_start}UNIQUE " .
618 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
619 }
620 elsif ( $type eq NORMAL ) {
621 $index_def =
622 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
623 join( ', ', map { qq[$qf$_$qf] } @fields ).
624 ')'
625 ;
626 }
627 else {
628 warn "Unknown index type ($type) on table $table_name.\n"
629 if $WARN;
124b192c 630 }
bfb5a568 631
892573f2 632 return $index_def, \@constraint_defs;
633}
bfb5a568 634
892573f2 635sub create_constraint
636{
637 my ($c, $options) = @_;
bfb5a568 638
892573f2 639 my $qf = $options->{quote_field_names} ||'';
640 my $qt = $options->{quote_table_names} ||'';
641 my $table_name = $c->table->name;
642 my (@constraint_defs, @fks);
bfb5a568 643
892573f2 644 my $name = $c->name || '';
645 if ( $name ) {
646 $name = next_unused_name($name);
647 }
bfb5a568 648
892573f2 649 my @fields =
650 map { $_ =~ s/\(.+\)//; $_ }
651 map { $qt ? $_ : unreserve( $_, $table_name )}
652 $c->fields;
653
654 my @rfields =
655 map { $_ =~ s/\(.+\)//; $_ }
656 map { $qt ? $_ : unreserve( $_, $table_name )}
657 $c->reference_fields;
658
659 next if !@fields && $c->type ne CHECK_C;
660 my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
661 if ( $c->type eq PRIMARY_KEY ) {
662 push @constraint_defs, "${def_start}PRIMARY KEY ".
663 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
664 }
665 elsif ( $c->type eq UNIQUE ) {
666 $name = next_unused_name($name);
667 push @constraint_defs, "${def_start}UNIQUE " .
668 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
669 }
670 elsif ( $c->type eq CHECK_C ) {
671 my $expression = $c->expression;
672 push @constraint_defs, "${def_start}CHECK ($expression)";
673 }
674 elsif ( $c->type eq FOREIGN_KEY ) {
675 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
676 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
677 "\n REFERENCES " . $qt . $c->reference_table . $qt;
bfb5a568 678
892573f2 679 if ( @rfields ) {
680 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
681 }
bfb5a568 682
892573f2 683 if ( $c->match_type ) {
684 $def .= ' MATCH ' .
685 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
686 }
5342f5c1 687
892573f2 688 if ( $c->on_delete ) {
689 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
690 }
bfb5a568 691
892573f2 692 if ( $c->on_update ) {
693 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
694 }
124b192c 695
892573f2 696 if ( $c->deferrable ) {
697 $def .= ' DEFERRABLE';
124b192c 698 }
699
892573f2 700 push @fks, "$def";
124b192c 701 }
bfb5a568 702
892573f2 703 return \@constraint_defs, \@fks;
704}
705
bfb5a568 706sub convert_datatype
707{
708 my ($field) = @_;
709
710 my @size = $field->size;
711 my $data_type = lc $field->data_type;
712
713 if ( $data_type eq 'enum' ) {
714# my $len = 0;
715# $len = ($len < length($_)) ? length($_) : $len for (@$list);
716# my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
717# push @$constraint_defs,
3406fd5b 718# qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
bfb5a568 719# qq[IN ($commalist))];
720 $data_type = 'character varying';
721 }
722 elsif ( $data_type eq 'set' ) {
723 $data_type = 'character varying';
724 }
725 elsif ( $field->is_auto_increment ) {
726 if ( defined $size[0] && $size[0] > 11 ) {
727 $data_type = 'bigserial';
728 }
729 else {
730 $data_type = 'serial';
731 }
732 undef @size;
733 }
734 else {
735 $data_type = defined $translate{ $data_type } ?
736 $translate{ $data_type } :
737 $data_type;
738 }
739
ad258776 740 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
bfb5a568 741 if ( defined $size[0] && $size[0] > 6 ) {
742 $size[0] = 6;
743 }
744 }
745
746 if ( $data_type eq 'integer' ) {
747 if ( defined $size[0] && $size[0] > 0) {
748 if ( $size[0] > 10 ) {
749 $data_type = 'bigint';
750 }
751 elsif ( $size[0] < 5 ) {
752 $data_type = 'smallint';
753 }
754 else {
755 $data_type = 'integer';
756 }
757 }
758 else {
759 $data_type = 'integer';
760 }
761 }
52bc2e13 762
763 my $type_with_size = join('|',
e189562c 764 'bit', 'varbit', 'character', 'bit varying', 'character varying',
c3bddac9 765 'time', 'timestamp', 'interval', 'numeric'
52bc2e13 766 );
767
768 if ( $data_type !~ /$type_with_size/ ) {
769 @size = ();
e56dabb7 770 }
bfb5a568 771
ad258776 772 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
773 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
774 $data_type .= $2 if(defined $2);
775 } elsif ( defined $size[0] && $size[0] > 0 ) {
e189562c 776 $data_type .= '(' . join( ',', @size ) . ')';
08d91aad 777 }
bfb5a568 778
779 return $data_type;
780}
781
782
783sub alter_field
784{
785 my ($from_field, $to_field) = @_;
786
787 die "Can't alter field in another table"
788 if($from_field->table->name ne $to_field->table->name);
789
790 my @out;
e83ad71c 791
792 # drop geometry column and constraints
793 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
794 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
795
3406fd5b 796 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
bfb5a568 797 $to_field->table->name,
798 $to_field->name) if(!$to_field->is_nullable and
799 $from_field->is_nullable);
800
90726ffd 801 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
802 $to_field->table->name,
803 $to_field->name)
804 if ( !$from_field->is_nullable and $to_field->is_nullable );
805
806
bfb5a568 807 my $from_dt = convert_datatype($from_field);
808 my $to_dt = convert_datatype($to_field);
3406fd5b 809 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
bfb5a568 810 $to_field->table->name,
811 $to_field->name,
812 $to_dt) if($to_dt ne $from_dt);
813
3406fd5b 814 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
bfb5a568 815 $to_field->table->name,
816 $from_field->name,
817 $to_field->name) if($from_field->name ne $to_field->name);
818
3406fd5b 819 my $old_default = $from_field->default_value;
820 my $new_default = $to_field->default_value;
90726ffd 821 my $default_value = $to_field->default_value;
822
823 # fixes bug where output like this was created:
824 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
825 if(ref $default_value eq "SCALAR" ) {
826 $default_value = $$default_value;
827 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
828 $default_value =~ s/'/''/xsmg;
829 $default_value = q(') . $default_value . q(');
830 }
831
3406fd5b 832 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
bfb5a568 833 $to_field->table->name,
834 $to_field->name,
90726ffd 835 $default_value)
3406fd5b 836 if ( defined $new_default &&
837 (!defined $old_default || $old_default ne $new_default) );
bfb5a568 838
90726ffd 839 # fixes bug where removing the DEFAULT statement of a column
840 # would result in no change
841
842 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
843 $to_field->table->name,
844 $to_field->name)
845 if ( !defined $new_default && defined $old_default );
846
e83ad71c 847 # add geometry column and contraints
848 push @out, add_geometry_column($to_field) if is_geometry($to_field);
849 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
850
bfb5a568 851 return wantarray ? @out : join("\n", @out);
bfb5a568 852}
853
3406fd5b 854sub rename_field { alter_field(@_) }
855
bfb5a568 856sub add_field
857{
858 my ($new_field) = @_;
859
3406fd5b 860 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
bfb5a568 861 $new_field->table->name,
862 create_field($new_field));
e83ad71c 863 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
864 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
bfb5a568 865 return $out;
866
867}
868
869sub drop_field
870{
871 my ($old_field) = @_;
872
3406fd5b 873 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
bfb5a568 874 $old_field->table->name,
875 $old_field->name);
e83ad71c 876 $out .= "\n".drop_geometry_column($old_field) if is_geometry($old_field);
bfb5a568 877 return $out;
878}
879
e83ad71c 880sub add_geometry_column{
881 my ($field,$options) = @_;
882
883 my $out = sprintf("INSERT INTO geometry_columns VALUES ('%s','%s','%s','%s','%s','%s','%s')",
884 '',
885 $field->table->schema->name,
886 $options->{table} ? $options->{table} : $field->table->name,
887 $field->name,
888 $field->{extra}{dimensions},
889 $field->{extra}{srid},
890 $field->{extra}{geometry_type});
891 return $out;
892}
893
894sub drop_geometry_column
895{
896 my $field = shift;
897
898 my $out = sprintf("DELETE FROM geometry_columns WHERE f_table_schema = '%s' AND f_table_name = '%s' AND f_geometry_column = '%s'",
899 $field->table->schema->name,
900 $field->table->name,
901 $field->name);
902 return $out;
903}
904
905sub add_geometry_constraints{
906 my $field = shift;
907
908 my @constraints = create_geometry_constraints($field);
909
910 my $out = join("\n", map { alter_create_constraint($_); } @constraints);
911
912 return $out;
913}
914
915sub drop_geometry_constraints{
916 my $field = shift;
917
918 my @constraints = create_geometry_constraints($field);
919
920 my $out = join("\n", map { alter_drop_constraint($_); } @constraints);
921
922 return $out;
923}
924
3406fd5b 925sub alter_table {
926 my ($to_table, $options) = @_;
927 my $qt = $options->{quote_table_names} || '';
928 my $out = sprintf('ALTER TABLE %s %s',
929 $qt . $to_table->name . $qt,
930 $options->{alter_table_action});
e83ad71c 931 $out .= "\n".$options->{geometry_changes} if $options->{geometry_changes};
3406fd5b 932 return $out;
933}
934
935sub rename_table {
936 my ($old_table, $new_table, $options) = @_;
937 my $qt = $options->{quote_table_names} || '';
938 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
e83ad71c 939
940 my @geometry_changes;
941 push @geometry_changes, map { drop_geometry_column($_); } grep { is_geometry($_) } $old_table->get_fields;
942 push @geometry_changes, map { add_geometry_column($_, { table => $new_table }); } grep { is_geometry($_) } $old_table->get_fields;
943
944 $options->{geometry_changes} = join ("\n",@geometry_changes) if scalar(@geometry_changes);
945
3406fd5b 946 return alter_table($old_table, $options);
947}
948
949sub alter_create_index {
950 my ($index, $options) = @_;
951 my $qt = $options->{quote_table_names} || '';
952 my $qf = $options->{quote_field_names} || '';
953 my ($idef, $constraints) = create_index($index, {
954 quote_field_names => $qf,
955 quote_table_names => $qt,
956 table_name => $index->table->name,
957 });
958 return $index->type eq NORMAL ? $idef
959 : sprintf('ALTER TABLE %s ADD %s',
960 $qt . $index->table->name . $qt,
961 join(q{}, @$constraints)
962 );
963}
964
965sub alter_drop_index {
966 my ($index, $options) = @_;
967 my $index_name = $index->name;
968 return "DROP INDEX $index_name";
969}
970
971sub alter_drop_constraint {
972 my ($c, $options) = @_;
973 my $qt = $options->{quote_table_names} || '';
974 my $qc = $options->{quote_field_names} || '';
975 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
976 $qt . $c->table->name . $qt,
977 $qc . $c->name . $qc );
978 return $out;
979}
980
981sub alter_create_constraint {
982 my ($index, $options) = @_;
983 my $qt = $options->{quote_table_names} || '';
90726ffd 984 my ($defs, $fks) = create_constraint(@_);
985
986 # return if there are no constraint definitions so we don't run
987 # into output like this:
988 # ALTER TABLE users ADD ;
989
990 return unless(@{$defs} || @{$fks});
991 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
3406fd5b 992 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
90726ffd 993 'ADD', join(q{}, @{$defs}, @{$fks})
3406fd5b 994 );
995}
996
997sub drop_table {
998 my ($table, $options) = @_;
999 my $qt = $options->{quote_table_names} || '';
e83ad71c 1000 my $out = "DROP TABLE $qt$table$qt CASCADE";
1001
1002 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
1003
1004 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
1005 return $out;
3406fd5b 1006}
1007
f8f0253c 10081;
f8f0253c 1009
96844cae 1010# -------------------------------------------------------------------
1011# Life is full of misery, loneliness, and suffering --
1012# and it's all over much too soon.
1013# Woody Allen
1014# -------------------------------------------------------------------
f8f0253c 1015
96844cae 1016=pod
f8f0253c 1017
20770e44 1018=head1 SEE ALSO
1019
1020SQL::Translator, SQL::Translator::Producer::Oracle.
1021
f8f0253c 1022=head1 AUTHOR
1023
f997b9ab 1024Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
f8f0253c 1025
1026=cut