File Coverage

blib/lib/SQL/Translator/Producer/PostgreSQL.pm
Criterion Covered Total %
statement 377 418 90.1
branch 174 242 71.9
condition 86 113 76.1
subroutine 36 38 94.7
pod 10 28 35.7
total 683 839 81.4


line stmt bran cond sub pod time code
1             package SQL::Translator::Producer::PostgreSQL;
2              
3             =head1 NAME
4              
5             SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator
6              
7             =head1 SYNOPSIS
8              
9             my $t = SQL::Translator->new( parser => '...', producer => 'PostgreSQL' );
10             $t->translate;
11              
12             =head1 DESCRIPTION
13              
14             Creates a DDL suitable for PostgreSQL. Very heavily based on the Oracle
15             producer.
16              
17             Now handles PostGIS Geometry and Geography data types on table definitions.
18             Does not yet support PostGIS Views.
19              
20             =head2 Producer Args
21              
22             You can change the global behavior of the producer by passing the following options to the
23             C attribute of C.
24              
25             =over 4
26              
27             =item postgres_version
28              
29             The version of postgres to generate DDL for. Turns on features only available in later versions. The following features are supported
30              
31             =over 4
32              
33             =item IF EXISTS
34              
35             If your postgres_version is higher than 8.003 (I should hope it is by now), then the DDL
36             generated for dropping objects in the database will contain IF EXISTS.
37              
38             =back
39              
40             =item attach_comments
41              
42             Generates table and column comments via the COMMENT command rather than as a comment in
43             the DDL. You could then look it up with \dt+ or \d+ (for tables and columns respectively)
44             in psql. The comment is dollar quoted with $comment$ so you can include ' in it. Just to clarify: you get this
45            
46             CREATE TABLE foo ...;
47             COMMENT on TABLE foo IS $comment$hi there$comment$;
48              
49             instead of this
50              
51             -- comment
52             CREAT TABLE foo ...;
53              
54             =back
55              
56             =head2 Extra args
57              
58             Various schema types support various options via the C attribute.
59              
60             =over 2
61              
62             =item Tables
63              
64             =over 2
65              
66             =item temporary
67              
68             Produces a temporary table.
69              
70             =back
71              
72             =item Views
73              
74             =over 2
75              
76             =item temporary
77              
78             Produces a temporary view.
79              
80             =item materialized
81              
82             Produces a materialized view.
83              
84             =back
85              
86             =item Fields
87              
88             =over 2
89              
90             =item list, custom_type_name
91              
92             For enum types, list is the list of valid values, and custom_type_name is the name that
93             the type should have. Defaults to $table_$field_type.
94              
95             =item geometry_type, srid, dimensions, geography_type
96              
97             Fields for use with PostGIS types.
98              
99             =back
100              
101             =back
102              
103             =cut
104              
105 6     6   2835 use strict;
  6         12  
  6         180  
106 6     6   30 use warnings;
  6         11  
  6         410  
107             our ( $DEBUG, $WARN );
108             our $VERSION = '1.6_3';
109             $DEBUG = 0 unless defined $DEBUG;
110              
111 6     6   41 use base qw(SQL::Translator::Producer);
  6         12  
  6         1267  
112 6     6   43 use SQL::Translator::Schema::Constants;
  6         14  
  6         466  
113 6     6   771 use SQL::Translator::Utils qw(debug header_comment parse_dbms_version batch_alter_table_statements normalize_quote_options);
  6         14  
  6         452  
114 6     6   2215 use SQL::Translator::Generator::DDL::PostgreSQL;
  6         21  
  6         193  
115 6     6   45 use Data::Dumper;
  6         12  
  6         316  
116              
117 6     6   41 use constant MAX_ID_LENGTH => 62;
  6         14  
  6         1230  
118              
119             {
120             my ($quoting_generator, $nonquoting_generator);
121             sub _generator {
122 316     316   623 my $options = shift;
123 316 100       982 return $options->{generator} if exists $options->{generator};
124              
125 157 100 66     418 return normalize_quote_options($options)
      66        
126             ? $quoting_generator ||= SQL::Translator::Generator::DDL::PostgreSQL->new
127             : $nonquoting_generator ||= SQL::Translator::Generator::DDL::PostgreSQL->new(
128             quote_chars => [],
129             );
130             }
131             }
132              
133             my ( %translate );
134              
135             BEGIN {
136              
137 6     6   29685 %translate = (
138             #
139             # MySQL types
140             #
141             double => 'double precision',
142             decimal => 'numeric',
143             int => 'integer',
144             mediumint => 'integer',
145             tinyint => 'smallint',
146             char => 'character',
147             varchar => 'character varying',
148             longtext => 'text',
149             mediumtext => 'text',
150             tinytext => 'text',
151             tinyblob => 'bytea',
152             blob => 'bytea',
153             mediumblob => 'bytea',
154             longblob => 'bytea',
155             enum => 'character varying',
156             set => 'character varying',
157             datetime => 'timestamp',
158             year => 'date',
159              
160             #
161             # Oracle types
162             #
163             number => 'integer',
164             varchar2 => 'character varying',
165             long => 'text',
166             clob => 'text',
167              
168             #
169             # Sybase types
170             #
171             comment => 'text',
172              
173             #
174             # MS Access types
175             #
176             memo => 'text',
177             );
178             }
179             my %truncated;
180              
181             =pod
182              
183             =head1 PostgreSQL Create Table Syntax
184              
185             CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
186             { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
187             | table_constraint } [, ... ]
188             )
189             [ INHERITS ( parent_table [, ... ] ) ]
190             [ WITH OIDS | WITHOUT OIDS ]
191              
192             where column_constraint is:
193              
194             [ CONSTRAINT constraint_name ]
195             { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
196             CHECK (expression) |
197             REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
198             [ ON DELETE action ] [ ON UPDATE action ] }
199             [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
200              
201             and table_constraint is:
202              
203             [ CONSTRAINT constraint_name ]
204             { UNIQUE ( column_name [, ... ] ) |
205             PRIMARY KEY ( column_name [, ... ] ) |
206             CHECK ( expression ) |
207             FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
208             [ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
209             [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
210              
211             =head1 Create Index Syntax
212              
213             CREATE [ UNIQUE ] INDEX index_name ON table
214             [ USING acc_method ] ( column [ ops_name ] [, ...] )
215             [ INCLUDE ( column [, ...] ) ]
216             [ WHERE predicate ]
217             CREATE [ UNIQUE ] INDEX index_name ON table
218             [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
219             [ WHERE predicate ]
220              
221             =cut
222              
223             sub produce {
224 8     8 1 25 my $translator = shift;
225 8         33 local $DEBUG = $translator->debug;
226 8         191 local $WARN = $translator->show_warnings;
227 8         173 my $no_comments = $translator->no_comments;
228 8         197 my $add_drop_table = $translator->add_drop_table;
229 8         177 my $schema = $translator->schema;
230 8         187 my $pargs = $translator->producer_args;
231             my $postgres_version = parse_dbms_version(
232 8         52 $pargs->{postgres_version}, 'perl'
233             );
234              
235 8         153 my $generator = _generator({ quote_identifiers => $translator->quote_identifiers });
236              
237 8         46 my @output;
238 8 50       36 push @output, header_comment unless ($no_comments);
239              
240 8         27 my (@table_defs, @fks);
241 8         0 my %type_defs;
242 8         47 for my $table ( $schema->get_tables ) {
243              
244             my ($table_def, $fks) = create_table($table, {
245             generator => $generator,
246             no_comments => $no_comments,
247             postgres_version => $postgres_version,
248             add_drop_table => $add_drop_table,
249             type_defs => \%type_defs,
250             attach_comments => $pargs->{attach_comments}
251 22         201 });
252              
253 22         98 push @table_defs, $table_def;
254 22         64 push @fks, @$fks;
255             }
256              
257 8         60 for my $view ( $schema->get_views ) {
258 5         45 push @table_defs, create_view($view, {
259             postgres_version => $postgres_version,
260             add_drop_view => $add_drop_table,
261             generator => $generator,
262             no_comments => $no_comments,
263             });
264             }
265              
266 8         53 for my $trigger ( $schema->get_triggers ) {
267 14         69 push @table_defs, create_trigger( $trigger, {
268             add_drop_trigger => $add_drop_table,
269             generator => $generator,
270             no_comments => $no_comments,
271             });
272             }
273              
274 8         28 push @output, map { "$_;\n\n" } values %type_defs;
  0         0  
275 8         22 push @output, map { "$_;\n\n" } @table_defs;
  55         197  
276 8 100       41 if ( @fks ) {
277 5 50       16 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
278 5         12 push @output, map { "$_;\n\n" } @fks;
  5         20  
279             }
280              
281 8 100       36 if ( $WARN ) {
282 1 50       3 if ( %truncated ) {
283 0         0 warn "Truncated " . keys( %truncated ) . " names:\n";
284 0         0 warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
285             }
286             }
287              
288             return wantarray
289             ? @output
290 8 100       1862 : join ('', @output);
291             }
292              
293             {
294             my %global_names;
295             sub mk_name {
296 0   0 0 0 0 my $basename = shift || '';
297 0   0     0 my $type = shift || '';
298 0   0     0 my $scope = shift || '';
299 0   0     0 my $critical = shift || '';
300 0         0 my $basename_orig = $basename;
301              
302 0 0       0 my $max_name = $type
303             ? MAX_ID_LENGTH - (length($type) + 1)
304             : MAX_ID_LENGTH;
305 0 0       0 $basename = substr( $basename, 0, $max_name )
306             if length( $basename ) > $max_name;
307 0 0       0 my $name = $type ? "${type}_$basename" : $basename;
308              
309 0 0 0     0 if ( $basename ne $basename_orig and $critical ) {
310 0 0       0 my $show_type = $type ? "+'$type'" : "";
311 0 0       0 warn "Truncating '$basename_orig'$show_type to ", MAX_ID_LENGTH,
312             " character limit to make '$name'\n" if $WARN;
313 0         0 $truncated{ $basename_orig } = $name;
314             }
315              
316 0   0     0 $scope ||= \%global_names;
317 0 0       0 if ( my $prev = $scope->{ $name } ) {
318 0         0 my $name_orig = $name;
319 0         0 $name .= sprintf( "%02d", ++$prev );
320 0 0       0 substr($name, MAX_ID_LENGTH - 3) = "00"
321             if length( $name ) > MAX_ID_LENGTH;
322              
323 0 0       0 warn "The name '$name_orig' has been changed to ",
324             "'$name' to make it unique.\n" if $WARN;
325              
326 0         0 $scope->{ $name_orig }++;
327             }
328              
329 0         0 $scope->{ $name }++;
330 0         0 return $name;
331             }
332             }
333              
334             sub is_geometry {
335 234     234 0 367 my $field = shift;
336 234 100       1067 return 1 if $field->data_type eq 'geometry';
337             }
338              
339             sub is_geography {
340 0     0 0 0 my $field = shift;
341 0 0       0 return 1 if $field->data_type eq 'geography';
342             }
343              
344             sub create_table
345             {
346 24     24 1 92 my ($table, $options) = @_;
347              
348 24         82 my $generator = _generator($options);
349 24   100     109 my $no_comments = $options->{no_comments} || 0;
350 24   100     92 my $add_drop_table = $options->{add_drop_table} || 0;
351 24   50     165 my $postgres_version = $options->{postgres_version} || 0;
352 24   100     93 my $type_defs = $options->{type_defs} || {};
353 24         87 my $attach_comments = $options->{attach_comments};
354              
355 24 50       545 my $table_name = $table->name or next;
356 24         567 my $table_name_qt = $generator->quote($table_name);
357              
358 24         78 my ( @comments, @field_defs, @index_defs, @constraint_defs, @fks );
359              
360 24 100       76 push @comments, "--\n-- Table: $table_name\n--\n" unless $no_comments;
361              
362 24         47 my @comment_statements;
363 24 100       436 if ( my $comments = $table->comments ) {
364 1 50       3 if ( $attach_comments) {
    0          
365             # this follows the example in the MySQL producer, where all comments are added as
366             # table comments, even though they could have originally been parsed as DDL comments
367             # quoted via $$ string so there can be 'quotes' inside the comments
368 1         4 my $comment_ddl = "COMMENT on TABLE $table_name_qt IS \$comment\$$comments\$comment\$";
369 1         2 push @comment_statements, $comment_ddl;
370             } elsif (!$no_comments) {
371 0         0 $comments =~ s/^/-- /mg;
372 0         0 push @comments, "-- Comments:\n$comments\n--\n";
373             }
374             }
375              
376             #
377             # Fields
378             #
379 24         112 for my $field ( $table->get_fields ) {
380 74         495 push @field_defs, create_field($field, {
381             generator => $generator,
382             postgres_version => $postgres_version,
383             type_defs => $type_defs,
384             constraint_defs => \@constraint_defs,
385             attach_comments => $attach_comments
386             });
387 74 100       334 if ( $attach_comments ) {
388 12         204 my $field_comments = $field->comments;
389 12 100       119 next unless $field_comments;
390 2         35 my $field_name_qt = $generator->quote($field->name);
391 2         12 my $comment_ddl =
392             "COMMENT on COLUMN $table_name_qt.$field_name_qt IS \$comment\$$field_comments\$comment\$";
393 2         8 push @comment_statements, $comment_ddl;
394             }
395              
396             }
397              
398             #
399             # Index Declarations
400             #
401 24         132 for my $index ( $table->get_indices ) {
402 5         83 my ($idef, $constraints) = create_index($index, {
403             generator => $generator,
404             postgres_version => $postgres_version,
405             });
406 5 50       26 $idef and push @index_defs, $idef;
407 5         15 push @constraint_defs, @$constraints;
408             }
409              
410             #
411             # Table constraints
412             #
413 24         96 for my $c ( $table->get_constraints ) {
414 35         279 my ($cdefs, $fks) = create_constraint($c, {
415             generator => $generator,
416             });
417 35         102 push @constraint_defs, @$cdefs;
418 35         92 push @fks, @$fks;
419             }
420              
421              
422 24         79 my $create_statement = join("\n", @comments);
423 24 100       91 if ($add_drop_table) {
424 20 50       76 if ($postgres_version >= 8.002) {
425 0         0 $create_statement .= "DROP TABLE IF EXISTS $table_name_qt CASCADE;\n";
426             } else {
427 20         69 $create_statement .= "DROP TABLE $table_name_qt CASCADE;\n";
428             }
429             }
430 24 50       474 my $temporary = $table->extra->{temporary} ? "TEMPORARY " : "";
431             $create_statement .= "CREATE ${temporary}TABLE $table_name_qt (\n" .
432 24         117 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
  97         325  
433             "\n)"
434             ;
435 24 100       94 $create_statement .= @index_defs ? ';' : q{};
436 24 100       214 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
437             . join(";\n", @index_defs);
438              
439             #
440             # Geometry
441             #
442 24 100       131 if (my @geometry_columns = grep { is_geometry($_) } $table->get_fields) {
  74         145  
443 1 50       4 $create_statement .= join(";\n", '', map{ drop_geometry_column($_, $options) } @geometry_columns) if $options->{add_drop_table};
  0         0  
444 1         3 $create_statement .= join(";\n", '', map{ add_geometry_column($_, $options) } @geometry_columns);
  1         4  
445             }
446              
447 24 100       97 if (@comment_statements) {
448 2         9 $create_statement .= join(";\n", '', @comment_statements);
449             }
450              
451 24         209 return $create_statement, \@fks;
452             }
453              
454             sub create_view {
455 10     10 1 1519 my ($view, $options) = @_;
456 10         31 my $generator = _generator($options);
457 10   100     71 my $postgres_version = $options->{postgres_version} || 0;
458 10         23 my $add_drop_view = $options->{add_drop_view};
459              
460 10         45 my $view_name = $view->name;
461 10         62 debug("PKG: Looking at view '${view_name}'\n");
462              
463 10         23 my $create = '';
464             $create .= "--\n-- View: " . $generator->quote($view_name) . "\n--\n"
465 10 50       35 unless $options->{no_comments};
466 10 100       30 if ($add_drop_view) {
467 7 100       31 if ($postgres_version >= 8.002) {
468 1         4 $create .= "DROP VIEW IF EXISTS " . $generator->quote($view_name) . ";\n";
469             } else {
470 6         28 $create .= "DROP VIEW " . $generator->quote($view_name) . ";\n";
471             }
472             }
473 10         31 $create .= 'CREATE';
474              
475 10         200 my $extra = $view->extra;
476 10 50 66     55 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
477 10 50 66     37 $create .= " MATERIALIZED" if exists($extra->{materialized}) && $extra->{materialized};
478 10         36 $create .= " VIEW " . $generator->quote($view_name);
479              
480 10 100       189 if ( my @fields = $view->fields ) {
481 9         26 my $field_list = join ', ', map { $generator->quote($_) } @fields;
  13         35  
482 9         37 $create .= " ( ${field_list} )";
483             }
484              
485 10 50       52 if ( my $sql = $view->sql ) {
486 10         33 $create .= " AS\n ${sql}\n";
487             }
488              
489 10 100       47 if ( $extra->{check_option} ) {
490 1         5 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
491             }
492              
493 10         41 return $create;
494             }
495              
496             {
497              
498             my %field_name_scope;
499              
500             sub create_field
501             {
502 102     102 1 814 my ($field, $options) = @_;
503              
504 102         265 my $generator = _generator($options);
505 102         1884 my $table_name = $field->table->name;
506 102   100     1935 my $constraint_defs = $options->{constraint_defs} || [];
507 102   100     462 my $postgres_version = $options->{postgres_version} || 0;
508 102   100     347 my $type_defs = $options->{type_defs} || {};
509 102         187 my $attach_comments = $options->{attach_comments};
510              
511 102   100     368 $field_name_scope{$table_name} ||= {};
512 102         1831 my $field_name = $field->name;
513              
514 102         1721 my $field_comments = '';
515 102 100 100     1854 if ( !$attach_comments and my $comments = $field->comments ) {
516 4         65 $comments =~ s/(?
517 4         17 $field_comments = "-- $comments\n ";
518             }
519              
520 102         1203 my $field_def = $field_comments . $generator->quote($field_name);
521              
522             #
523             # Datatype
524             #
525 102         443 my $data_type = lc $field->data_type;
526 102         1804 my %extra = $field->extra;
527 102   100     492 my $list = $extra{'list'} || [];
528 102         276 my $commalist = join( ', ', map { __PACKAGE__->_quote_string($_) } @$list );
  6         17  
529              
530 102 100 100     409 if ($postgres_version >= 8.003 && $data_type eq 'enum') {
531 2   66     25 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
532 2         21 $field_def .= ' '. $type_name;
533 2         12 my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
534             "CREATE TYPE $type_name AS ENUM ($commalist)";
535 2 50       8 if (! exists $type_defs->{$type_name} ) {
    0          
536 2         7 $type_defs->{$type_name} = $new_type_def;
537             } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
538 0         0 die "Attempted to redefine type name '$type_name' as a different type.\n";
539             }
540             } else {
541 100         337 $field_def .= ' '. convert_datatype($field);
542             }
543              
544             #
545             # Default value
546             #
547 102         765 __PACKAGE__->_apply_default_value(
548             $field,
549             \$field_def,
550             [
551             'NULL' => \'NULL',
552             'now()' => 'now()',
553             'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
554             ],
555             );
556              
557             #
558             # Not null constraint
559             #
560 102 100       2004 $field_def .= ' NOT NULL' unless $field->is_nullable;
561              
562             #
563             # Geometry constraints
564             #
565 102 100       4170 if (is_geometry($field)) {
566 3         10 foreach ( create_geometry_constraints($field, $options) ) {
567 9         26 my ($cdefs, $fks) = create_constraint($_, $options);
568 9         22 push @$constraint_defs, @$cdefs;
569 9         22 push @$fks, @$fks;
570             }
571             }
572              
573 102         522 return $field_def;
574             }
575             }
576              
577             sub create_geometry_constraints {
578 7     7 0 17 my ($field, $options) = @_;
579              
580 7         18 my $fname = _generator($options)->quote($field);
581 7         12 my @constraints;
582             push @constraints, SQL::Translator::Schema::Constraint->new(
583             name => "enforce_dims_".$field->name,
584 7         117 expression => "(ST_NDims($fname) = ".$field->extra->{dimensions}.")",
585             table => $field->table,
586             type => CHECK_C,
587             );
588              
589             push @constraints, SQL::Translator::Schema::Constraint->new(
590             name => "enforce_srid_".$field->name,
591 7         264 expression => "(ST_SRID($fname) = ".$field->extra->{srid}.")",
592             table => $field->table,
593             type => CHECK_C,
594             );
595             push @constraints, SQL::Translator::Schema::Constraint->new(
596             name => "enforce_geotype_".$field->name,
597 7         288 expression => "(GeometryType($fname) = ". __PACKAGE__->_quote_string($field->extra->{geometry_type}) ."::text OR $fname IS NULL)",
598             table => $field->table,
599             type => CHECK_C,
600             );
601              
602 7         146 return @constraints;
603             }
604              
605             {
606             my %index_name;
607             sub create_index
608             {
609 16     16 1 4327 my ($index, $options) = @_;
610              
611 16         46 my $generator = _generator($options);
612 16         322 my $table_name = $index->table->name;
613 16   100     330 my $postgres_version = $options->{postgres_version} || 0;
614              
615 16         35 my ($index_def, @constraint_defs);
616              
617             my $name
618             = $index->name
619 16   33     258 || join('_', $table_name, 'idx', ++$index_name{ $table_name });
620              
621 16   50     355 my $type = $index->type || NORMAL;
622 16         591 my @fields = $index->fields;
623 16 50       71 return unless @fields;
624              
625 16         29 my %index_extras;
626 16         266 for my $opt ( $index->options ) {
627 6 50       18 if ( ref $opt eq 'HASH' ) {
628 6         14 foreach my $key (keys %$opt) {
629 6         13 my $value = $opt->{$key};
630 6 50       12 next unless defined $value;
631 6 100       23 if ( uc($key) eq 'USING' ) {
    100          
    50          
632 2         9 $index_extras{using} = "USING $value";
633             }
634             elsif ( uc($key) eq 'WHERE' ) {
635 2         7 $index_extras{where} = "WHERE $value";
636             }
637             elsif ( uc($key) eq 'INCLUDE' ) {
638 2 100       7 next unless $postgres_version >= 11;
639 1 50       4 die 'Include list must be an arrayref' unless ref $value eq 'ARRAY';
640 1         5 my $value_list = join ', ', @$value;
641 1         4 $index_extras{include} = "INCLUDE ($value_list)"
642             }
643             }
644             }
645             }
646              
647 16         69 my $def_start = 'CONSTRAINT ' . $generator->quote($name) . ' ';
648 16 100       61 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')';
  20         112  
649 16 50       89 if ( $type eq PRIMARY_KEY ) {
    100          
    50          
650 0         0 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
651             }
652             elsif ( $type eq UNIQUE ) {
653 1         6 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
654             }
655             elsif ( $type eq NORMAL ) {
656             $index_def =
657             'CREATE INDEX ' . $generator->quote($name) . ' on ' . $generator->quote($table_name) . ' ' .
658 15         44 join ' ', grep { defined } $index_extras{using}, $field_names, @index_extras{'include', 'where'};
  60         122  
659             }
660             else {
661 0 0       0 warn "Unknown index type ($type) on table $table_name.\n"
662             if $WARN;
663             }
664              
665 16         84 return $index_def, \@constraint_defs;
666             }
667             }
668              
669             sub create_constraint
670             {
671 69     69 1 2788 my ($c, $options) = @_;
672              
673 69         170 my $generator = _generator($options);
674 69         1297 my $table_name = $c->table->name;
675 69         1109 my (@constraint_defs, @fks);
676              
677 69   100     1183 my $name = $c->name || '';
678              
679 69         261 my @fields = grep { defined } $c->fields;
  55         168  
680              
681 69         1253 my @rfields = grep { defined } $c->reference_fields;
  8         35  
682              
683 69 50 66     509 next if !@fields && $c->type ne CHECK_C;
684 69 100       603 my $def_start = $name ? 'CONSTRAINT ' . $generator->quote($name) . ' ' : '';
685 69 100       213 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')';
  55         248  
686 69 100       1236 if ( $c->type eq PRIMARY_KEY ) {
    100          
    100          
    100          
687 17         363 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
688             }
689             elsif ( $c->type eq UNIQUE ) {
690 16         302 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
691             }
692             elsif ( $c->type eq CHECK_C ) {
693 18         536 my $expression = $c->expression;
694 18         63 push @constraint_defs, "${def_start}CHECK ($expression)";
695             }
696             elsif ( $c->type eq FOREIGN_KEY ) {
697 8         175 my $def .= "ALTER TABLE " . $generator->quote($table_name) . " ADD ${def_start}FOREIGN KEY $field_names"
698             . "\n REFERENCES " . $generator->quote($c->reference_table);
699              
700 8 50       64 if ( @rfields ) {
701 8         23 $def .= ' (' . join( ', ', map { $generator->quote($_) } @rfields ) . ')';
  8         49  
702             }
703              
704 8 50       157 if ( $c->match_type ) {
705 0 0       0 $def .= ' MATCH ' .
706             ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
707             }
708              
709 8 50       297 if ( $c->on_delete ) {
710 0         0 $def .= ' ON DELETE '. $c->on_delete;
711             }
712              
713 8 50       144 if ( $c->on_update ) {
714 0         0 $def .= ' ON UPDATE '. $c->on_update;
715             }
716              
717 8 50       134 if ( $c->deferrable ) {
718 8         85 $def .= ' DEFERRABLE';
719             }
720              
721 8         31 push @fks, "$def";
722             }
723              
724 69         505 return \@constraint_defs, \@fks;
725             }
726              
727             sub create_trigger {
728 14     14 1 33 my ($trigger,$options) = @_;
729 14         45 my $generator = _generator($options);
730              
731 14         28 my @statements;
732              
733             push @statements, sprintf( 'DROP TRIGGER IF EXISTS %s', $generator->quote($trigger->name) )
734 14 50       82 if $options->{add_drop_trigger};
735              
736 14   100     260 my $scope = $trigger->scope || '';
737 14 100       319 $scope = " FOR EACH $scope" if $scope;
738              
739             push @statements, sprintf(
740             'CREATE TRIGGER %s %s %s ON %s%s %s',
741             $generator->quote($trigger->name),
742             $trigger->perform_action_when,
743 14         61 join( ' OR ', @{ $trigger->database_events } ),
  14         466  
744             $generator->quote($trigger->on_table),
745             $scope,
746             $trigger->action,
747             );
748              
749 14         73 return @statements;
750             }
751              
752             sub convert_datatype
753             {
754 140     140 0 326 my ($field) = @_;
755              
756 140         2396 my @size = $field->size;
757 140         1579 my $data_type = lc $field->data_type;
758 140         366 my $array = $data_type =~ s/\[\]$//;
759              
760 140 50       2377 if ( $data_type eq 'enum' ) {
    50          
    100          
761             # my $len = 0;
762             # $len = ($len < length($_)) ? length($_) : $len for (@$list);
763             # my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
764             # push @$constraint_defs,
765             # 'CONSTRAINT "$chk_name" CHECK (' . $generator->quote(field_name) .
766             # qq[IN ($commalist))];
767 0         0 $data_type = 'character varying';
768             }
769             elsif ( $data_type eq 'set' ) {
770 0         0 $data_type = 'character varying';
771             }
772             elsif ( $field->is_auto_increment ) {
773 19 100 66     335 if ( (defined $size[0] && $size[0] > 11) or $data_type eq 'bigint' ) {
      100        
774 2         5 $data_type = 'bigserial';
775             }
776             else {
777 17         45 $data_type = 'serial';
778             }
779 19         46 undef @size;
780             }
781             else {
782             $data_type = defined $translate{ lc $data_type } ?
783 121 100       1289 $translate{ lc $data_type } :
784             $data_type;
785             }
786              
787 140 100 100     756 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
788 13 100 66     86 if ( defined $size[0] && $size[0] > 6 ) {
789 1         3 $size[0] = 6;
790             }
791             }
792              
793 140 100       454 if ( $data_type eq 'integer' ) {
794 17 100 66     143 if ( defined $size[0] && $size[0] > 0) {
795 15 100       68 if ( $size[0] > 10 ) {
    50          
796 10         18 $data_type = 'bigint';
797             }
798             elsif ( $size[0] < 5 ) {
799 0         0 $data_type = 'smallint';
800             }
801             else {
802 5         11 $data_type = 'integer';
803             }
804             }
805             else {
806 2         5 $data_type = 'integer';
807             }
808             }
809              
810 140         280 my $type_with_size = join('|',
811             'bit', 'varbit', 'character', 'bit varying', 'character varying',
812             'time', 'timestamp', 'interval', 'numeric', 'float'
813             );
814              
815 140 100       1361 if ( $data_type !~ /$type_with_size/ ) {
816 60         139 @size = ();
817             }
818              
819 140 100 100     1093 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
    100 100        
      100        
820 5         45 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
821 5 50       23 $data_type .= $2 if(defined $2);
822             } elsif ( defined $size[0] && $size[0] > 0 ) {
823 65         263 $data_type .= '(' . join( ',', @size ) . ')';
824             }
825 140 100       326 if($array)
826             {
827 1         3 $data_type .= '[]';
828             }
829              
830             #
831             # Geography
832             #
833 140 100       328 if($data_type eq 'geography'){
834 1         16 $data_type .= '('.$field->extra->{geography_type}.','. $field->extra->{srid} .')'
835             }
836              
837 140         428 return $data_type;
838             }
839              
840              
841             sub alter_field
842             {
843 20     20 1 3478 my ($from_field, $to_field, $options) = @_;
844              
845 20 50       367 die "Can't alter field in another table"
846             if($from_field->table->name ne $to_field->table->name);
847              
848 20         386 my $generator = _generator($options);
849 20         37 my @out;
850              
851             # drop geometry column and constraints
852 20 100       48 push @out,
853             drop_geometry_column($from_field, $options),
854             drop_geometry_constraints($from_field, $options),
855             if is_geometry($from_field);
856              
857             # it's necessary to start with rename column cause this would affect
858             # all of the following statements which would be broken if do the
859             # rename later
860             # BUT: drop geometry is done before the rename, cause it work's on the
861             # $from_field directly
862 20 100       361 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
863             map($generator->quote($_),
864             $to_field->table->name,
865             $from_field->name,
866             $to_field->name,
867             ),
868             )
869             if($from_field->name ne $to_field->name);
870              
871 20 100 100     722 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
872             map($generator->quote($_),
873             $to_field->table->name,
874             $to_field->name
875             ),
876             )
877             if(!$to_field->is_nullable and $from_field->is_nullable);
878              
879 20 100 100     667 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
880             map($generator->quote($_),
881             $to_field->table->name,
882             $to_field->name
883             ),
884             )
885             if (!$from_field->is_nullable and $to_field->is_nullable);
886              
887              
888 20         468 my $from_dt = convert_datatype($from_field);
889 20         50 my $to_dt = convert_datatype($to_field);
890 20 100       218 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
891             map($generator->quote($_),
892             $to_field->table->name,
893             $to_field->name
894             ),
895             $to_dt,
896             )
897             if($to_dt ne $from_dt);
898              
899 20         71 my $old_default = $from_field->default_value;
900 20         48 my $new_default = $to_field->default_value;
901 20         43 my $default_value = $to_field->default_value;
902              
903             # fixes bug where output like this was created:
904             # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
905 20 100 100     114 if(ref $default_value eq "SCALAR" ) {
    100          
906 1         3 $default_value = $$default_value;
907             } elsif( defined $default_value && $to_dt =~ /^(character|text|timestamp|date)/xsmi ) {
908 3         19 $default_value = __PACKAGE__->_quote_string($default_value);
909             }
910              
911 20 100 100     157 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
      100        
912             map($generator->quote($_),
913             $to_field->table->name,
914             $to_field->name,
915             ),
916             $default_value,
917             )
918             if ( defined $new_default &&
919             (!defined $old_default || $old_default ne $new_default) );
920              
921             # fixes bug where removing the DEFAULT statement of a column
922             # would result in no change
923              
924 20 100 100     123 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
925             map($generator->quote($_),
926             $to_field->table->name,
927             $to_field->name,
928             ),
929             )
930             if ( !defined $new_default && defined $old_default );
931              
932             # add geometry column and constraints
933 20 100       53 push @out,
934             add_geometry_column($to_field, $options),
935             add_geometry_constraints($to_field, $options),
936             if is_geometry($to_field);
937              
938 20 100       117 return wantarray ? @out : join(";\n", @out);
939             }
940              
941 2     2 0 9 sub rename_field { alter_field(@_) }
942              
943             sub add_field
944             {
945 6     6 1 140 my ($new_field,$options) = @_;
946              
947 6         24 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
948             _generator($options)->quote($new_field->table->name),
949             create_field($new_field, $options));
950 6 100       75 $out .= ";\n".add_geometry_column($new_field, $options)
951             . ";\n".add_geometry_constraints($new_field, $options)
952             if is_geometry($new_field);
953 6         40 return $out;
954              
955             }
956              
957             sub drop_field
958             {
959 4     4 1 1732 my ($old_field, $options) = @_;
960              
961 4         17 my $generator = _generator($options);
962              
963 4         98 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
964             $generator->quote($old_field->table->name),
965             $generator->quote($old_field->name));
966 4 100       20 $out .= ";\n".drop_geometry_column($old_field, $options)
967             if is_geometry($old_field);
968 4         21 return $out;
969             }
970              
971             sub add_geometry_column {
972 5     5 0 975 my ($field, $options) = @_;
973              
974             return sprintf(
975             "INSERT INTO geometry_columns VALUES (%s,%s,%s,%s,%s,%s,%s)",
976             map(__PACKAGE__->_quote_string($_),
977             '',
978             $field->table->schema->name,
979             $options->{table} ? $options->{table} : $field->table->name,
980             $field->name,
981             $field->extra->{dimensions},
982             $field->extra->{srid},
983             $field->extra->{geometry_type},
984 5 100       97 ),
985             );
986             }
987              
988             sub drop_geometry_column {
989 4     4 0 9 my ($field) = @_;
990              
991 4         68 return sprintf(
992             "DELETE FROM geometry_columns WHERE f_table_schema = %s AND f_table_name = %s AND f_geometry_column = %s",
993             map(__PACKAGE__->_quote_string($_),
994             $field->table->schema->name,
995             $field->table->name,
996             $field->name,
997             ),
998             );
999             }
1000              
1001             sub add_geometry_constraints {
1002 3     3 0 604 my ($field, $options) = @_;
1003              
1004 3         24 return join(";\n", map { alter_create_constraint($_, $options) }
  9         27  
1005             create_geometry_constraints($field, $options));
1006             }
1007              
1008             sub drop_geometry_constraints {
1009 1     1 0 3 my ($field, $options) = @_;
1010              
1011 1         5 return join(";\n", map { alter_drop_constraint($_, $options) }
  3         8  
1012             create_geometry_constraints($field, $options));
1013              
1014             }
1015              
1016             sub alter_table {
1017 3     3 0 9 my ($to_table, $options) = @_;
1018 3         8 my $generator = _generator($options);
1019             my $out = sprintf('ALTER TABLE %s %s',
1020             $generator->quote($to_table->name),
1021 3         60 $options->{alter_table_action});
1022 3 100       43 $out .= ";\n".$options->{geometry_changes} if $options->{geometry_changes};
1023 3         15 return $out;
1024             }
1025              
1026             sub rename_table {
1027 3     3 0 846 my ($old_table, $new_table, $options) = @_;
1028 3         11 my $generator = _generator($options);
1029 3         25 $options->{alter_table_action} = "RENAME TO " . $generator->quote($new_table);
1030              
1031             my @geometry_changes = map {
1032             drop_geometry_column($_, $options),
1033 1         4 add_geometry_column($_, { %{$options}, table => $new_table }),
  1         6  
1034 3         34 } grep { is_geometry($_) } $old_table->get_fields;
  4         11  
1035              
1036 3 100       14 $options->{geometry_changes} = join (";\n",@geometry_changes) if @geometry_changes;
1037              
1038 3         17 return alter_table($old_table, $options);
1039             }
1040              
1041             sub alter_create_index {
1042 1     1 0 4 my ($index, $options) = @_;
1043 1         5 my $generator = _generator($options);
1044 1         6 my ($idef, $constraints) = create_index($index, $options);
1045 1 50       18 return $index->type eq NORMAL ? $idef
1046             : sprintf('ALTER TABLE %s ADD %s',
1047             $generator->quote($index->table->name),
1048             join(q{}, @$constraints)
1049             );
1050             }
1051              
1052             sub alter_drop_index {
1053 1     1 0 4 my ($index, $options) = @_;
1054 1         4 return 'DROP INDEX '. _generator($options)->quote($index->name);
1055             }
1056              
1057             sub alter_drop_constraint {
1058 11     11 0 5846 my ($c, $options) = @_;
1059 11         34 my $generator = _generator($options);
1060              
1061             # attention: Postgres has a very special naming structure for naming
1062             # foreign keys and primary keys. It names them using the name of the
1063             # table as prefix and fkey or pkey as suffix, concatenated by an underscore
1064 11         31 my $c_name;
1065 11 100       227 if( $c->name ) {
    100          
    50          
1066             # Already has a name, just use it
1067 9         138 $c_name = $c->name;
1068             } elsif ( $c->type eq FOREIGN_KEY ) {
1069             # Doesn't have a name, and is foreign key, append '_fkey'
1070 1         36 $c_name = $c->table->name . '_' . ($c->fields)[0] . '_fkey';
1071             } elsif ( $c->type eq PRIMARY_KEY ) {
1072             # Doesn't have a name, and is primary key, append '_pkey'
1073 1         34 $c_name = $c->table->name . '_pkey';
1074             }
1075              
1076             return sprintf(
1077             'ALTER TABLE %s DROP CONSTRAINT %s',
1078 11         287 map { $generator->quote($_) } $c->table->name, $c_name,
  22         234  
1079             );
1080             }
1081              
1082             sub alter_create_constraint {
1083 14     14 0 33 my ($index, $options) = @_;
1084 14         35 my $generator = _generator($options);
1085 14         49 my ($defs, $fks) = create_constraint(@_);
1086              
1087             # return if there are no constraint definitions so we don't run
1088             # into output like this:
1089             # ALTER TABLE users ADD ;
1090              
1091 14 50 66     26 return unless(@{$defs} || @{$fks});
  14         47  
  1         4  
1092 1         36 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
1093             : join( ' ', 'ALTER TABLE', $generator->quote($index->table->name),
1094 14 100       220 'ADD', join(q{}, @{$defs}, @{$fks})
  13         29  
  13         124  
1095             );
1096             }
1097              
1098             sub drop_table {
1099 3     3 0 43 my ($table, $options) = @_;
1100 3         12 my $generator = _generator($options);
1101 3         15 my $out = "DROP TABLE " . $generator->quote($table) . " CASCADE";
1102              
1103 3         33 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
  1         5  
  4         62  
1104              
1105 3 100       12 $out .= join(";\n", '', @geometry_drops) if @geometry_drops;
1106 3         13 return $out;
1107             }
1108              
1109             sub batch_alter_table {
1110 12     12 0 335 my ( $table, $diff_hash, $options ) = @_;
1111              
1112             # as long as we're not renaming the table we don't need to be here
1113 12 100       20 if ( @{$diff_hash->{rename_table}} == 0 ) {
  12         38  
1114 10         35 return batch_alter_table_statements($diff_hash, $options);
1115             }
1116              
1117             # first we need to perform drops which are on old table
1118 2         12 my @sql = batch_alter_table_statements($diff_hash, $options, qw(
1119             alter_drop_constraint
1120             alter_drop_index
1121             drop_field
1122             ));
1123              
1124             # next comes the rename_table
1125 2         8 my $old_table = $diff_hash->{rename_table}[0][0];
1126 2         10 push @sql, rename_table( $old_table, $table, $options );
1127              
1128             # for alter_field (and so also rename_field) we need to make sure old
1129             # field has table name set to new table otherwise calling alter_field dies
1130             $diff_hash->{alter_field} =
1131 2 0       5 [map { $_->[0]->table($table) && $_ } @{$diff_hash->{alter_field}}];
  0         0  
  2         9  
1132             $diff_hash->{rename_field} =
1133 2 0       5 [map { $_->[0]->table($table) && $_ } @{$diff_hash->{rename_field}}];
  0         0  
  2         6  
1134              
1135             # now add everything else
1136 2         8 push @sql, batch_alter_table_statements($diff_hash, $options, qw(
1137             add_field
1138             alter_field
1139             rename_field
1140             alter_create_index
1141             alter_create_constraint
1142             alter_table
1143             ));
1144              
1145 2         24 return @sql;
1146             }
1147              
1148             1;
1149              
1150             # -------------------------------------------------------------------
1151             # Life is full of misery, loneliness, and suffering --
1152             # and it's all over much too soon.
1153             # Woody Allen
1154             # -------------------------------------------------------------------
1155              
1156             =pod
1157              
1158             =head1 SEE ALSO
1159              
1160             SQL::Translator, SQL::Translator::Producer::Oracle.
1161              
1162             =head1 AUTHOR
1163              
1164             Ken Youens-Clark Ekclark@cpan.orgE.
1165              
1166             =cut