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