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