projects / dbsrgits/SQL-Translator.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
added kaitlyn's patch for mysql->sqlite translation
[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;
681dc480 42use vars qw[ $DEBUG $WARN $VERSION ];
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, {
0e758018 215 postgres_version => $postgres_version,
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 }
f8f0253c 235 }
236
bf75adec 237 return wantarray
238 ? @output
239 : join ('', @output);
f8f0253c 240}
241
96844cae 242# -------------------------------------------------------------------
243sub mk_name {
0c43e0a1 244 my $basename = shift || '';
245 my $type = shift || '';
246 my $scope = shift || '';
247 my $critical = shift || '';
96844cae 248 my $basename_orig = $basename;
bfb5a568 249# my $max_id_length = 62;
2ad4c2c8 250 my $max_name = $type
251 ? $max_id_length - (length($type) + 1)
252 : $max_id_length;
96844cae 253 $basename = substr( $basename, 0, $max_name )
254 if length( $basename ) > $max_name;
255 my $name = $type ? "${type}_$basename" : $basename;
256
257 if ( $basename ne $basename_orig and $critical ) {
258 my $show_type = $type ? "+'$type'" : "";
259 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
260 "character limit to make '$name'\n" if $WARN;
261 $truncated{ $basename_orig } = $name;
262 }
263
264 $scope ||= \%global_names;
265 if ( my $prev = $scope->{ $name } ) {
266 my $name_orig = $name;
267 $name .= sprintf( "%02d", ++$prev );
268 substr($name, $max_id_length - 3) = "00"
269 if length( $name ) > $max_id_length;
270
271 warn "The name '$name_orig' has been changed to ",
272 "'$name' to make it unique.\n" if $WARN;
273
274 $scope->{ $name_orig }++;
f8f0253c 275 }
96844cae 276
277 $scope->{ $name }++;
278 return $name;
279}
280
e83ad71c 281sub is_geometry
282{
283 my $field = shift;
140a1dad 284 return 1 if $field->data_type eq 'geometry';
285}
286
287sub is_geography
288{
289 my $field = shift;
290 return 1 if $field->data_type eq 'geography';
e83ad71c 291}
292
bfb5a568 293sub create_table
294{
295 my ($table, $options) = @_;
296
297 my $qt = $options->{quote_table_names} || '';
298 my $qf = $options->{quote_field_names} || '';
299 my $no_comments = $options->{no_comments} || 0;
300 my $add_drop_table = $options->{add_drop_table} || 0;
5342f5c1 301 my $postgres_version = $options->{postgres_version} || 0;
79f55d7e 302 my $type_defs = $options->{type_defs} || {};
bfb5a568 303
3406fd5b 304 my $table_name = $table->name or next;
3406fd5b 305 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
306 my $table_name_ur = $qt ? $table_name
5f31ed66 307 : $fql_tbl_name ? join('.', $table_name, $fql_tbl_name)
308 : $table_name;
bfb5a568 309 $table->name($table_name_ur);
310
124b192c 311# print STDERR "$table_name table_name\n";
79f55d7e 312 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks );
bfb5a568 313
7ed7402c 314 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
bfb5a568 315
316 if ( $table->comments and !$no_comments ){
317 my $c = "-- Comments: \n-- ";
318 $c .= join "\n-- ", $table->comments;
7ed7402c 319 $c .= "\n--\n";
bfb5a568 320 push @comments, $c;
321 }
322
323 #
324 # Fields
325 #
326 my %field_name_scope;
327 for my $field ( $table->get_fields ) {
328 push @field_defs, create_field($field, { quote_table_names => $qt,
329 quote_field_names => $qf,
330 table_name => $table_name_ur,
5342f5c1 331 postgres_version => $postgres_version,
79f55d7e 332 type_defs => $type_defs,
bfb5a568 333 constraint_defs => \@constraint_defs,});
334 }
335
336 #
337 # Index Declarations
338 #
339 my @index_defs = ();
340 # my $idx_name_default;
341 for my $index ( $table->get_indices ) {
342 my ($idef, $constraints) = create_index($index,
343 {
344 quote_field_names => $qf,
345 quote_table_names => $qt,
346 table_name => $table_name,
347 });
7ed7402c 348 $idef and push @index_defs, $idef;
bfb5a568 349 push @constraint_defs, @$constraints;
350 }
351
352 #
353 # Table constraints
354 #
355 my $c_name_default;
356 for my $c ( $table->get_constraints ) {
357 my ($cdefs, $fks) = create_constraint($c,
358 {
359 quote_field_names => $qf,
360 quote_table_names => $qt,
361 table_name => $table_name,
362 });
363 push @constraint_defs, @$cdefs;
364 push @fks, @$fks;
365 }
366
3e98f7d9 367
368 my $temporary = "";
369
370 if(exists $table->{extra}{temporary}) {
371 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
372 }
373
bfb5a568 374 my $create_statement;
375 $create_statement = join("\n", @comments);
5342f5c1 376 if ($add_drop_table) {
7b4b17aa 377 if ($postgres_version >= 8.002) {
5342f5c1 378 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
5342f5c1 379 } else {
380 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
381 }
382 }
3e98f7d9 383 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
bfb5a568 384 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
3406fd5b 385 "\n)"
bfb5a568 386 ;
3406fd5b 387 $create_statement .= @index_defs ? ';' : q{};
388 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
389 . join(";\n", @index_defs);
bfb5a568 390
e83ad71c 391 #
392 # Geometry
393 #
394 if(grep { is_geometry($_) } $table->get_fields){
395 $create_statement .= ";";
140a1dad 396 my @geometry_columns;
397 foreach my $col ($table->get_fields) { push(@geometry_columns,$col) if is_geometry($col); }
398 $create_statement .= "\n".join("\n", map{ drop_geometry_column($_) } @geometry_columns) if $options->{add_drop_table};
399 $create_statement .= "\n".join("\n", map{ add_geometry_column($_) } @geometry_columns);
e83ad71c 400 }
401
08d91aad 402 return $create_statement, \@fks;
bfb5a568 403}
404
296c2701 405sub create_view {
406 my ($view, $options) = @_;
407 my $qt = $options->{quote_table_names} || '';
408 my $qf = $options->{quote_field_names} || '';
0e758018 409 my $postgres_version = $options->{postgres_version} || 0;
a25ac5d2 410 my $add_drop_view = $options->{add_drop_view};
296c2701 411
412 my $view_name = $view->name;
413 debug("PKG: Looking at view '${view_name}'\n");
414
415 my $create = '';
416 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
417 unless $options->{no_comments};
0e758018 418 if ($add_drop_view) {
419 if ($postgres_version >= 8.002) {
420 $create .= "DROP VIEW IF EXISTS ${qt}${view_name}${qt};\n";
421 } else {
422 $create .= "DROP VIEW ${qt}${view_name}${qt};\n";
423 }
424 }
296c2701 425 $create .= 'CREATE';
296c2701 426
427 my $extra = $view->extra;
428 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
429 $create .= " VIEW ${qt}${view_name}${qt}";
430
431 if ( my @fields = $view->fields ) {
432 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
433 $create .= " ( ${field_list} )";
434 }
435
436 if ( my $sql = $view->sql ) {
f59b2c0e 437 $create .= " AS\n ${sql}\n";
296c2701 438 }
439
440 if ( $extra->{check_option} ) {
441 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
442 }
443
296c2701 444 return $create;
445}
446
bfb5a568 447{
448
449 my %field_name_scope;
450
451 sub create_field
452 {
453 my ($field, $options) = @_;
454
455 my $qt = $options->{quote_table_names} || '';
456 my $qf = $options->{quote_field_names} || '';
457 my $table_name = $field->table->name;
458 my $constraint_defs = $options->{constraint_defs} || [];
5342f5c1 459 my $postgres_version = $options->{postgres_version} || 0;
79f55d7e 460 my $type_defs = $options->{type_defs} || {};
bfb5a568 461
462 $field_name_scope{$table_name} ||= {};
912e67a1 463 my $field_name = $field->name;
bfb5a568 464 my $field_comments = $field->comments
465 ? "-- " . $field->comments . "\n "
466 : '';
467
5f31ed66 468 my $field_def = $field_comments.qq[$qf$field_name$qf];
bfb5a568 469
470 #
471 # Datatype
472 #
473 my @size = $field->size;
474 my $data_type = lc $field->data_type;
475 my %extra = $field->extra;
476 my $list = $extra{'list'} || [];
477 # todo deal with embedded quotes
478 my $commalist = join( ', ', map { qq['$_'] } @$list );
bfb5a568 479
7b4b17aa 480 if ($postgres_version >= 8.003 && $field->data_type eq 'enum') {
79f55d7e 481 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
5342f5c1 482 $field_def .= ' '. $type_name;
d25db732 483 my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
79f55d7e 484 "CREATE TYPE $type_name AS ENUM ($commalist)";
485 if (! exists $type_defs->{$type_name} ) {
486 $type_defs->{$type_name} = $new_type_def;
487 } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
488 die "Attempted to redefine type name '$type_name' as a different type.\n";
489 }
5342f5c1 490 } else {
491 $field_def .= ' '. convert_datatype($field);
492 }
bfb5a568 493
494 #
bc8e2aa1 495 # Default value
bfb5a568 496 #
06baeb21 497 SQL::Translator::Producer->_apply_default_value(
498 $field,
499 \$field_def,
500 [
501 'NULL' => \'NULL',
502 'now()' => 'now()',
503 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
504 ],
505 );
bfb5a568 506
507 #
508 # Not null constraint
509 #
510 $field_def .= ' NOT NULL' unless $field->is_nullable;
511
e83ad71c 512 #
513 # Geometry constraints
514 #
515 if(is_geometry($field)){
516 foreach ( create_geometry_constraints($field) ) {
517 my ($cdefs, $fks) = create_constraint($_,
518 {
519 quote_field_names => $qf,
520 quote_table_names => $qt,
521 table_name => $table_name,
522 });
523 push @$constraint_defs, @$cdefs;
524 push @$fks, @$fks;
525 }
526 }
527
bfb5a568 528 return $field_def;
529 }
530}
531
e83ad71c 532sub create_geometry_constraints{
533 my $field = shift;
534
535 my @constraints;
536 push @constraints, SQL::Translator::Schema::Constraint->new(
537 name => "enforce_dims_".$field->name,
42bab2bc 538 expression => "(ST_NDims($field) = ".$field->{extra}{dimensions}.")",
e83ad71c 539 table => $field->table,
540 type => CHECK_C,
541 );
542
543 push @constraints, SQL::Translator::Schema::Constraint->new(
544 name => "enforce_srid_".$field->name,
42bab2bc 545 expression => "(ST_SRID($field) = ".$field->{extra}{srid}.")",
e83ad71c 546 table => $field->table,
547 type => CHECK_C,
548 );
549 push @constraints, SQL::Translator::Schema::Constraint->new(
550 name => "enforce_geotype_".$field->name,
42bab2bc 551 expression => "(GeometryType($field) = '".$field->{extra}{geometry_type}."'::text OR $field IS NULL)",
e83ad71c 552 table => $field->table,
553 type => CHECK_C,
554 );
555
556 return @constraints;
557}
558
892573f2 559sub create_index
560{
561 my ($index, $options) = @_;
bfb5a568 562
892573f2 563 my $qt = $options->{quote_table_names} ||'';
564 my $qf = $options->{quote_field_names} ||'';
565 my $table_name = $index->table->name;
bfb5a568 566
892573f2 567 my ($index_def, @constraint_defs);
bfb5a568 568
681dc480 569 my $name
570 = $index->name
571 || join('_', $table_name, 'idx', ++$index_name{ $table_name });
bfb5a568 572
892573f2 573 my $type = $index->type || NORMAL;
5f31ed66 574 my @fields = $index->fields;
892573f2 575 next unless @fields;
bfb5a568 576
5f31ed66 577 my $def_start = qq[CONSTRAINT ${qf}$name${qf} ];
578 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
892573f2 579 if ( $type eq PRIMARY_KEY ) {
5f31ed66 580 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
892573f2 581 }
582 elsif ( $type eq UNIQUE ) {
5f31ed66 583 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
892573f2 584 }
585 elsif ( $type eq NORMAL ) {
586 $index_def =
5f31ed66 587 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} ".$field_names
892573f2 588 ;
589 }
590 else {
591 warn "Unknown index type ($type) on table $table_name.\n"
592 if $WARN;
124b192c 593 }
bfb5a568 594
892573f2 595 return $index_def, \@constraint_defs;
596}
bfb5a568 597
892573f2 598sub create_constraint
599{
600 my ($c, $options) = @_;
bfb5a568 601
892573f2 602 my $qf = $options->{quote_field_names} ||'';
603 my $qt = $options->{quote_table_names} ||'';
604 my $table_name = $c->table->name;
605 my (@constraint_defs, @fks);
bfb5a568 606
892573f2 607 my $name = $c->name || '';
bfb5a568 608
5f31ed66 609 my @fields = grep { defined } $c->fields;
892573f2 610
5f31ed66 611 my @rfields = grep { defined } $c->reference_fields;
892573f2 612
613 next if !@fields && $c->type ne CHECK_C;
5f31ed66 614 my $def_start = $name ? qq[CONSTRAINT ${qf}$name${qf} ] : '';
615 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ($qf . $_ . $qf ) } @fields)) . ')';
892573f2 616 if ( $c->type eq PRIMARY_KEY ) {
5f31ed66 617 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
892573f2 618 }
619 elsif ( $c->type eq UNIQUE ) {
5f31ed66 620 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
892573f2 621 }
622 elsif ( $c->type eq CHECK_C ) {
623 my $expression = $c->expression;
624 push @constraint_defs, "${def_start}CHECK ($expression)";
625 }
626 elsif ( $c->type eq FOREIGN_KEY ) {
681dc480 627 my $def .= "ALTER TABLE $qt$table_name$qt ADD ${def_start}FOREIGN KEY $field_names"
628 . "\n REFERENCES " . $qt . $c->reference_table . $qt;
bfb5a568 629
892573f2 630 if ( @rfields ) {
631 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
632 }
bfb5a568 633
892573f2 634 if ( $c->match_type ) {
635 $def .= ' MATCH ' .
636 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
637 }
5342f5c1 638
892573f2 639 if ( $c->on_delete ) {
640 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
641 }
bfb5a568 642
892573f2 643 if ( $c->on_update ) {
644 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
645 }
124b192c 646
892573f2 647 if ( $c->deferrable ) {
648 $def .= ' DEFERRABLE';
124b192c 649 }
650
892573f2 651 push @fks, "$def";
124b192c 652 }
bfb5a568 653
892573f2 654 return \@constraint_defs, \@fks;
655}
656
bfb5a568 657sub convert_datatype
658{
659 my ($field) = @_;
660
661 my @size = $field->size;
662 my $data_type = lc $field->data_type;
aacb3187 663 my $array = $data_type =~ s/\[\]$//;
bfb5a568 664
665 if ( $data_type eq 'enum' ) {
666# my $len = 0;
667# $len = ($len < length($_)) ? length($_) : $len for (@$list);
668# my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
669# push @$constraint_defs,
3406fd5b 670# qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
bfb5a568 671# qq[IN ($commalist))];
672 $data_type = 'character varying';
673 }
674 elsif ( $data_type eq 'set' ) {
675 $data_type = 'character varying';
676 }
677 elsif ( $field->is_auto_increment ) {
678 if ( defined $size[0] && $size[0] > 11 ) {
679 $data_type = 'bigserial';
680 }
681 else {
682 $data_type = 'serial';
683 }
684 undef @size;
685 }
686 else {
687 $data_type = defined $translate{ $data_type } ?
688 $translate{ $data_type } :
689 $data_type;
690 }
691
ad258776 692 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
bfb5a568 693 if ( defined $size[0] && $size[0] > 6 ) {
694 $size[0] = 6;
695 }
696 }
697
698 if ( $data_type eq 'integer' ) {
699 if ( defined $size[0] && $size[0] > 0) {
700 if ( $size[0] > 10 ) {
701 $data_type = 'bigint';
702 }
703 elsif ( $size[0] < 5 ) {
704 $data_type = 'smallint';
705 }
706 else {
707 $data_type = 'integer';
708 }
709 }
710 else {
711 $data_type = 'integer';
712 }
713 }
52bc2e13 714
715 my $type_with_size = join('|',
e189562c 716 'bit', 'varbit', 'character', 'bit varying', 'character varying',
c3bddac9 717 'time', 'timestamp', 'interval', 'numeric'
52bc2e13 718 );
719
720 if ( $data_type !~ /$type_with_size/ ) {
721 @size = ();
e56dabb7 722 }
bfb5a568 723
ad258776 724 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
725 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
726 $data_type .= $2 if(defined $2);
727 } elsif ( defined $size[0] && $size[0] > 0 ) {
e189562c 728 $data_type .= '(' . join( ',', @size ) . ')';
08d91aad 729 }
aacb3187 730 if($array)
731 {
732 $data_type .= '[]';
733 }
bfb5a568 734
140a1dad 735 #
736 # Geography
737 #
738 if($data_type eq 'geography'){
739 $data_type .= '('.$field->{extra}{geography_type}.','. $field->{extra}{srid} .')'
740 }
741
bfb5a568 742 return $data_type;
743}
744
745
746sub alter_field
747{
748 my ($from_field, $to_field) = @_;
749
750 die "Can't alter field in another table"
751 if($from_field->table->name ne $to_field->table->name);
752
753 my @out;
e83ad71c 754
755 # drop geometry column and constraints
c50d1a0a 756 push @out, drop_geometry_column($from_field) if is_geometry($from_field);
757 push @out, drop_geometry_constraints($from_field) if is_geometry($from_field);
758
759 # it's necessary to start with rename column cause this would affect
760 # all of the following statements which would be broken if do the
761 # rename later
762 # BUT: drop geometry is done before the rename, cause it work's on the
763 # $from_field directly
764 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
765 $to_field->table->name,
766 $from_field->name,
767 $to_field->name) if($from_field->name ne $to_field->name);
768
e83ad71c 769
3406fd5b 770 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
bfb5a568 771 $to_field->table->name,
772 $to_field->name) if(!$to_field->is_nullable and
773 $from_field->is_nullable);
774
90726ffd 775 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
776 $to_field->table->name,
777 $to_field->name)
778 if ( !$from_field->is_nullable and $to_field->is_nullable );
779
780
bfb5a568 781 my $from_dt = convert_datatype($from_field);
782 my $to_dt = convert_datatype($to_field);
3406fd5b 783 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
bfb5a568 784 $to_field->table->name,
785 $to_field->name,
786 $to_dt) if($to_dt ne $from_dt);
787
3406fd5b 788 my $old_default = $from_field->default_value;
789 my $new_default = $to_field->default_value;
90726ffd 790 my $default_value = $to_field->default_value;
791
792 # fixes bug where output like this was created:
793 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
794 if(ref $default_value eq "SCALAR" ) {
795 $default_value = $$default_value;
796 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
797 $default_value =~ s/'/''/xsmg;
798 $default_value = q(') . $default_value . q(');
799 }
800
3406fd5b 801 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
bfb5a568 802 $to_field->table->name,
803 $to_field->name,
90726ffd 804 $default_value)
3406fd5b 805 if ( defined $new_default &&
806 (!defined $old_default || $old_default ne $new_default) );
bfb5a568 807
90726ffd 808 # fixes bug where removing the DEFAULT statement of a column
809 # would result in no change
810
811 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
812 $to_field->table->name,
813 $to_field->name)
814 if ( !defined $new_default && defined $old_default );
815
e83ad71c 816 # add geometry column and contraints
817 push @out, add_geometry_column($to_field) if is_geometry($to_field);
818 push @out, add_geometry_constraints($to_field) if is_geometry($to_field);
819
c50d1a0a 820 return wantarray ? @out : join(";\n", @out);
bfb5a568 821}
822
3406fd5b 823sub rename_field { alter_field(@_) }
824
bfb5a568 825sub add_field
826{
827 my ($new_field) = @_;
828
3406fd5b 829 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
bfb5a568 830 $new_field->table->name,
831 create_field($new_field));
e83ad71c 832 $out .= "\n".add_geometry_column($new_field) if is_geometry($new_field);
833 $out .= "\n".add_geometry_constraints($new_field) if is_geometry($new_field);
bfb5a568 834 return $out;
835
836}
837
838sub drop_field
839{
c50d1a0a 840 my ($old_field, $options) = @_;
841
842 my $qt = $options->{quote_table_names} ||'';
843 my $qf = $options->{quote_field_names} ||'';
bfb5a568 844
3406fd5b 845 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
c50d1a0a 846 $qt . $old_field->table->name . $qt,
847 $qf . $old_field->name . $qf);
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} || '';
c50d1a0a 947
948 return sprintf(
949 'ALTER TABLE %s DROP CONSTRAINT %s',
950 $qt . $c->table->name . $qt,
951 # attention: Postgres has a very special naming structure
952 # for naming foreign keys, it names them uses the name of
953 # the table as prefix and fkey as suffix, concatenated by a underscore
954 $c->type eq FOREIGN_KEY
681dc480 955 ? $c->name
956 ? $qc . $c->name . $qc
957 : $qc . $c->table->name . '_' . ($c->fields)[0] . '_fkey' . $qc
c50d1a0a 958 : $qc . $c->name . $qc
959 );
3406fd5b 960}
961
962sub alter_create_constraint {
963 my ($index, $options) = @_;
964 my $qt = $options->{quote_table_names} || '';
90726ffd 965 my ($defs, $fks) = create_constraint(@_);
966
967 # return if there are no constraint definitions so we don't run
968 # into output like this:
969 # ALTER TABLE users ADD ;
970
971 return unless(@{$defs} || @{$fks});
972 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
3406fd5b 973 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
90726ffd 974 'ADD', join(q{}, @{$defs}, @{$fks})
3406fd5b 975 );
976}
977
978sub drop_table {
979 my ($table, $options) = @_;
980 my $qt = $options->{quote_table_names} || '';
e83ad71c 981 my $out = "DROP TABLE $qt$table$qt CASCADE";
982
983 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
984
985 $out .= "\n".join("\n",@geometry_drops) if scalar(@geometry_drops);
986 return $out;
3406fd5b 987}
988
f8f0253c 9891;
f8f0253c 990
96844cae 991# -------------------------------------------------------------------
992# Life is full of misery, loneliness, and suffering --
993# and it's all over much too soon.
994# Woody Allen
995# -------------------------------------------------------------------
f8f0253c 996
96844cae 997=pod
f8f0253c 998
20770e44 999=head1 SEE ALSO
1000
1001SQL::Translator, SQL::Translator::Producer::Oracle.
1002
f8f0253c 1003=head1 AUTHOR
1004
f997b9ab 1005Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
f8f0253c 1006
1007=cut
DDL Tool (dbsrgits@git.shadowcat.co.uk:SQL-Translator.git)