File Coverage

blib/lib/SQL/Translator/Producer/PostgreSQL.pm
Criterion Covered Total %
statement 380 422 90.0
branch 172 244 70.4
condition 85 113 75.2
subroutine 36 38 94.7
pod 10 28 35.7
total 683 845 80.8


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   3631 use strict;
  6         12  
  6         217  
106 6     6   38 use warnings;
  6         23  
  6         471  
107             our ( $DEBUG, $WARN );
108             our $VERSION = '1.63';
109             $DEBUG = 0 unless defined $DEBUG;
110              
111 6     6   49 use base qw(SQL::Translator::Producer);
  6         14  
  6         1529  
112 6     6   51 use SQL::Translator::Schema::Constants;
  6         16  
  6         520  
113 6     6   983 use SQL::Translator::Utils qw(debug header_comment parse_dbms_version batch_alter_table_statements normalize_quote_options);
  6         15  
  6         500  
114 6     6   2876 use SQL::Translator::Generator::DDL::PostgreSQL;
  6         22  
  6         204  
115 6     6   43 use Data::Dumper;
  6         15  
  6         367  
116              
117 6     6   38 use constant MAX_ID_LENGTH => 62;
  6         26  
  6         1466  
118              
119             {
120             my ($quoting_generator, $nonquoting_generator);
121             sub _generator {
122 293     293   658 my $options = shift;
123 293 100       944 return $options->{generator} if exists $options->{generator};
124              
125 160 100 66     417 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   37887 %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 6     6 1 19 my $translator = shift;
225 6         23 local $DEBUG = $translator->debug;
226 6         186 local $WARN = $translator->show_warnings;
227 6         168 my $no_comments = $translator->no_comments;
228 6         201 my $add_drop_table = $translator->add_drop_table;
229 6         165 my $schema = $translator->schema;
230 6         198 my $pargs = $translator->producer_args;
231             my $postgres_version = parse_dbms_version(
232 6         57 $pargs->{postgres_version}, 'perl'
233             );
234              
235 6         147 my $generator = _generator({ quote_identifiers => $translator->quote_identifiers });
236              
237 6         33 my @output;
238 6 50       26 push @output, header_comment unless ($no_comments);
239              
240 6         33 my (@table_defs, @fks);
241 6         0 my %type_defs;
242 6         41 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 18         203 });
252              
253 18         78 push @table_defs, $table_def;
254 18         55 push @fks, @$fks;
255             }
256              
257 6         52 for my $view ( $schema->get_views ) {
258 4         39 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 6         59 for my $trigger ( $schema->get_triggers ) {
267 12         77 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 6         46 push @output, map { "$_;\n\n" } values %type_defs;
  0         0  
275 6         22 push @output, map { "$_;\n\n" } @table_defs;
  46         187  
276 6 100       79 if ( @fks ) {
277 4 50       19 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
278 4         13 push @output, map { "$_;\n\n" } @fks;
  4         21  
279             }
280              
281 6 50       26 if ( $WARN ) {
282 0 0       0 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 6 100       2708 : 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 212     212 0 383 my $field = shift;
336 212 100       1024 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 20     20 1 84 my ($table, $options) = @_;
347              
348 20         58 my $generator = _generator($options);
349 20   100     103 my $no_comments = $options->{no_comments} || 0;
350 20   100     98 my $add_drop_table = $options->{add_drop_table} || 0;
351 20   50     104 my $postgres_version = $options->{postgres_version} || 0;
352 20   100     80 my $type_defs = $options->{type_defs} || {};
353 20         48 my $attach_comments = $options->{attach_comments};
354              
355 20 50       506 my $table_name = $table->name or next;
356 20         608 my $table_name_qt = $generator->quote($table_name);
357              
358 20         73 my ( @comments, @field_defs, @index_defs, @constraint_defs, @fks );
359              
360 20 100       71 push @comments, "--\n-- Table: $table_name\n--\n" unless $no_comments;
361              
362 20         45 my @comment_statements;
363 20 100       453 if ( my $comments = $table->comments ) {
364 1 50       4 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         6 my $comment_ddl = "COMMENT on TABLE $table_name_qt IS \$comment\$$comments\$comment\$";
369 1         3 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 20         116 for my $field ( $table->get_fields ) {
380 61         413 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 61 100       294 if ( $attach_comments ) {
388 1         24 my $field_comments = $field->comments;
389 1 50       33 next unless $field_comments;
390 1         25 my $field_name_qt = $generator->quote($field->name);
391 1         7 my $comment_ddl =
392             "COMMENT on COLUMN $table_name_qt.$field_name_qt IS \$comment\$$field_comments\$comment\$";
393 1         5 push @comment_statements, $comment_ddl;
394             }
395              
396             }
397              
398             #
399             # Index Declarations
400             #
401 20         122 for my $index ( $table->get_indices ) {
402 4         90 my ($idef, $constraints) = create_index($index, {
403             generator => $generator,
404             postgres_version => $postgres_version,
405             });
406 4 50       33 $idef and push @index_defs, $idef;
407 4         20 push @constraint_defs, @$constraints;
408             }
409              
410             #
411             # Table constraints
412             #
413 20         96 for my $c ( $table->get_constraints ) {
414 30         264 my ($cdefs, $fks) = create_constraint($c, {
415             generator => $generator,
416             });
417 30         95 push @constraint_defs, @$cdefs;
418 30         103 push @fks, @$fks;
419             }
420              
421              
422 20         81 my $create_statement = join("\n", @comments);
423 20 100       58 if ($add_drop_table) {
424 16 50       50 if ($postgres_version >= 8.002) {
425 0         0 $create_statement .= "DROP TABLE IF EXISTS $table_name_qt CASCADE;\n";
426             } else {
427 16         58 $create_statement .= "DROP TABLE $table_name_qt CASCADE;\n";
428             }
429             }
430 20 50       447 my $temporary = $table->extra->{temporary} ? "TEMPORARY " : "";
431             $create_statement .= "CREATE ${temporary}TABLE $table_name_qt (\n" .
432 20         106 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
  80         258  
433             "\n)"
434             ;
435 20 100       93 $create_statement .= @index_defs ? ';' : q{};
436 20 100       172 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
437             . join(";\n", @index_defs);
438              
439             #
440             # Geometry
441             #
442 20 100       133 if (my @geometry_columns = grep { is_geometry($_) } $table->get_fields) {
  61         158  
443 1 50       4 $create_statement .= join(";\n", '', map{ drop_geometry_column($_, $options) } @geometry_columns) if $options->{add_drop_table};
  0         0  
444 1         4 $create_statement .= join(";\n", '', map{ add_geometry_column($_, $options) } @geometry_columns);
  1         3  
445             }
446              
447 20 100       84 if (@comment_statements) {
448 1         6 $create_statement .= join(";\n", '', @comment_statements);
449             }
450              
451 20         146 return $create_statement, \@fks;
452             }
453              
454             sub create_view {
455 9     9 1 1747 my ($view, $options) = @_;
456 9         30 my $generator = _generator($options);
457 9   100     65 my $postgres_version = $options->{postgres_version} || 0;
458 9         29 my $add_drop_view = $options->{add_drop_view};
459              
460 9         38 my $view_name = $view->name;
461 9         56 debug("PKG: Looking at view '${view_name}'\n");
462              
463 9         24 my $create = '';
464             $create .= "--\n-- View: " . $generator->quote($view_name) . "\n--\n"
465 9 50       34 unless $options->{no_comments};
466 9 100       29 if ($add_drop_view) {
467 6 100       29 if ($postgres_version >= 8.002) {
468 1         5 $create .= "DROP VIEW IF EXISTS " . $generator->quote($view_name) . ";\n";
469             } else {
470 5         27 $create .= "DROP VIEW " . $generator->quote($view_name) . ";\n";
471             }
472             }
473 9         25 $create .= 'CREATE';
474              
475 9         204 my $extra = $view->extra;
476 9 50 66     60 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
477 9 50 66     44 $create .= " MATERIALIZED" if exists($extra->{materialized}) && $extra->{materialized};
478 9         34 $create .= " VIEW " . $generator->quote($view_name);
479              
480 9 100       198 if ( my @fields = $view->fields ) {
481 8         28 my $field_list = join ', ', map { $generator->quote($_) } @fields;
  12         50  
482 8         48 $create .= " ( ${field_list} )";
483             }
484              
485 9 50       57 if ( my $sql = $view->sql ) {
486 9         37 $create .= " AS\n ${sql}\n";
487             }
488              
489 9 100       39 if ( $extra->{check_option} ) {
490 1         10 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
491             }
492              
493 9         51 return $create;
494             }
495              
496             {
497              
498             my %field_name_scope;
499              
500             sub create_field
501             {
502 89     89 1 874 my ($field, $options) = @_;
503              
504 89         243 my $generator = _generator($options);
505 89         1893 my $table_name = $field->table->name;
506 89   100     2056 my $constraint_defs = $options->{constraint_defs} || [];
507 89   100     411 my $postgres_version = $options->{postgres_version} || 0;
508 89   100     279 my $type_defs = $options->{type_defs} || {};
509 89         195 my $attach_comments = $options->{attach_comments};
510              
511 89   100     303 $field_name_scope{$table_name} ||= {};
512 89         1884 my $field_name = $field->name;
513              
514 89         1798 my $field_comments = '';
515 89 100 100     1957 if ( !$attach_comments and my $comments = $field->comments ) {
516 4         75 $comments =~ s/(?
517 4         26 $field_comments = "-- $comments\n ";
518             }
519              
520 89         1160 my $field_def = $field_comments . $generator->quote($field_name);
521              
522             #
523             # Datatype
524             #
525 89         433 my $data_type = lc $field->data_type;
526 89         1781 my %extra = $field->extra;
527 89   100     494 my $list = $extra{'list'} || [];
528 89         297 my $commalist = join( ', ', map { __PACKAGE__->_quote_string($_) } @$list );
  6         18  
529              
530 89 100 100     409 if ($postgres_version >= 8.003 && $data_type eq 'enum') {
531 2   66     29 my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
532 2         25 $field_def .= ' '. $type_name;
533 2         10 my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
534             "CREATE TYPE $type_name AS ENUM ($commalist)";
535 2 50       7 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 87         412 $field_def .= ' '. convert_datatype($field);
542             }
543              
544             #
545             # Default value
546             #
547 89         708 __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 89 100       2035 $field_def .= ' NOT NULL' unless $field->is_nullable;
561              
562             #
563             # Geometry constraints
564             #
565 89 100       4052 if (is_geometry($field)) {
566 3         8 foreach ( create_geometry_constraints($field, $options) ) {
567 9         25 my ($cdefs, $fks) = create_constraint($_, $options);
568 9         18 push @$constraint_defs, @$cdefs;
569 9         24 push @$fks, @$fks;
570             }
571             }
572              
573 89         453 return $field_def;
574             }
575             }
576              
577             sub create_geometry_constraints {
578 7     7 0 15 my ($field, $options) = @_;
579              
580 7         16 my $fname = _generator($options)->quote($field);
581 7         19 my @constraints;
582             push @constraints, SQL::Translator::Schema::Constraint->new(
583             name => "enforce_dims_".$field->name,
584 7         139 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         296 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         171 return @constraints;
603             }
604              
605             {
606             my %index_name;
607             sub create_index
608             {
609 15     15 1 4114 my ($index, $options) = @_;
610              
611 15         49 my $generator = _generator($options);
612 15         365 my $table_name = $index->table->name;
613 15   100     378 my $postgres_version = $options->{postgres_version} || 0;
614              
615 15         32 my ($index_def, @constraint_defs);
616              
617             my $name
618             = $index->name
619 15   33     282 || join('_', $table_name, 'idx', ++$index_name{ $table_name });
620              
621 15   50     424 my $type = $index->type || NORMAL;
622 15         601 my @fields = $index->fields;
623 15 50       50 return unless @fields;
624              
625 15         32 my %index_extras;
626 15         290 for my $opt ( $index->options ) {
627 6 50       30 if ( ref $opt eq 'HASH' ) {
628 6         20 foreach my $key (keys %$opt) {
629 6         12 my $value = $opt->{$key};
630 6 50       12 next unless defined $value;
631 6 100       21 if ( uc($key) eq 'USING' ) {
    100          
    50          
632 2         9 $index_extras{using} = "USING $value";
633             }
634             elsif ( uc($key) eq 'WHERE' ) {
635 2         12 $index_extras{where} = "WHERE $value";
636             }
637             elsif ( uc($key) eq 'INCLUDE' ) {
638 2 100       8 next unless $postgres_version >= 11;
639 1 50       7 die 'Include list must be an arrayref' unless ref $value eq 'ARRAY';
640 1         4 my $value_list = join ', ', @$value;
641 1         8 $index_extras{include} = "INCLUDE ($value_list)"
642             }
643             }
644             }
645             }
646              
647 15         65 my $def_start = 'CONSTRAINT ' . $generator->quote($name) . ' ';
648 15 100       60 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')';
  19         178  
649 15 50       99 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         5 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 14         46 join ' ', grep { defined } $index_extras{using}, $field_names, @index_extras{'include', 'where'};
  56         133  
659             }
660             else {
661 0 0       0 warn "Unknown index type ($type) on table $table_name.\n"
662             if $WARN;
663             }
664              
665 15         122 return $index_def, \@constraint_defs;
666             }
667             }
668              
669             sub create_constraint
670             {
671 64     64 1 2764 my ($c, $options) = @_;
672              
673 64         170 my $generator = _generator($options);
674 64         1370 my $table_name = $c->table->name;
675 64         1229 my (@constraint_defs, @fks);
676              
677 64   100     1273 my $name = $c->name || '';
678              
679 64         230 my @fields = grep { defined } $c->fields;
  50         187  
680              
681 64         1327 my @rfields = grep { defined } $c->reference_fields;
  7         49  
682              
683 64 50 66     539 next if !@fields && $c->type ne CHECK_C;
684 64 100       651 my $def_start = $name ? 'CONSTRAINT ' . $generator->quote($name) . ' ' : '';
685 64 100       213 my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')';
  50         235  
686 64 100       1405 if ( $c->type eq PRIMARY_KEY ) {
    100          
    100          
    100          
687 15         362 push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
688             }
689             elsif ( $c->type eq UNIQUE ) {
690 14         320 push @constraint_defs, "${def_start}UNIQUE " .$field_names;
691             }
692             elsif ( $c->type eq CHECK_C ) {
693 18         640 my $expression = $c->expression;
694 18         73 push @constraint_defs, "${def_start}CHECK ($expression)";
695             }
696             elsif ( $c->type eq FOREIGN_KEY ) {
697 7         189 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 7 50       82 if ( @rfields ) {
701 7         33 $def .= ' (' . join( ', ', map { $generator->quote($_) } @rfields ) . ')';
  7         23  
702             }
703              
704 7 50       160 if ( $c->match_type ) {
705 0 0       0 $def .= ' MATCH ' .
706             ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
707             }
708              
709 7 50       367 if ( $c->on_delete ) {
710 0         0 $def .= ' ON DELETE '. $c->on_delete;
711             }
712              
713 7 50       149 if ( $c->on_update ) {
714 0         0 $def .= ' ON UPDATE '. $c->on_update;
715             }
716              
717 7 50       139 if ( $c->deferrable ) {
718 7         85 $def .= ' DEFERRABLE';
719             }
720              
721 7         27 push @fks, "$def";
722             }
723              
724 64         517 return \@constraint_defs, \@fks;
725             }
726              
727             sub create_trigger {
728 12     12 1 35 my ($trigger,$options) = @_;
729 12         38 my $generator = _generator($options);
730              
731 12         33 my @statements;
732              
733             push @statements, sprintf( 'DROP TRIGGER IF EXISTS %s', $generator->quote($trigger->name) )
734 12 50       81 if $options->{add_drop_trigger};
735              
736 12   50     282 my $scope = $trigger->scope || '';
737 12 50       347 $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 12         69 join( ' OR ', @{ $trigger->database_events } ),
  12         547  
744             $generator->quote($trigger->on_table),
745             $scope,
746             $trigger->action,
747             );
748              
749 12         82 return @statements;
750             }
751              
752             sub convert_datatype
753             {
754 131     131 0 289 my ($field) = @_;
755              
756 131         2653 my @size = $field->size;
757 131         1481 my $data_type = lc $field->data_type;
758 131         338 my $array = $data_type =~ s/\[\]$//;
759              
760 131 50       2381 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 17 100 66     314 if ( (defined $size[0] && $size[0] > 11) or $data_type eq 'bigint' ) {
      100        
774 2         5 $data_type = 'bigserial';
775             }
776             else {
777 15         42 $data_type = 'serial';
778             }
779 17         47 undef @size;
780             }
781             else {
782             $data_type = defined $translate{ lc $data_type } ?
783 114 100       1355 $translate{ lc $data_type } :
784             $data_type;
785             }
786              
787 131 100 100     763 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
788 12 100 66     91 if ( defined $size[0] && $size[0] > 6 ) {
789 1         4 $size[0] = 6;
790             }
791             }
792              
793 131 100       383 if ( $data_type eq 'integer' ) {
794 16 100 66     106 if ( defined $size[0] && $size[0] > 0) {
795 14 100       54 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 4         14 $data_type = 'integer';
803             }
804             }
805             else {
806 2         6 $data_type = 'integer';
807             }
808             }
809              
810 131         255 my $type_with_size = join('|',
811             'bit', 'varbit', 'character', 'bit varying', 'character varying',
812             'time', 'timestamp', 'interval', 'numeric', 'float'
813             );
814              
815 131 100       1174 if ( $data_type !~ /$type_with_size/ ) {
816 56         148 @size = ();
817             }
818              
819 131 100 100     961 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
    100 100        
      100        
820 5         42 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
821 5 50       21 $data_type .= $2 if(defined $2);
822             } elsif ( defined $size[0] && $size[0] > 0 ) {
823 64         276 $data_type .= '(' . join( ',', @size ) . ')';
824             }
825 131 100       305 if($array)
826             {
827 1         9 $data_type .= '[]';
828             }
829              
830             #
831             # Geography
832             #
833 131 100       301 if($data_type eq 'geography'){
834 1         20 $data_type .= '('.$field->extra->{geography_type}.','. $field->extra->{srid} .')'
835             }
836              
837 131         480 return $data_type;
838             }
839              
840              
841             sub alter_field
842             {
843 22     22 1 3490 my ($from_field, $to_field, $options) = @_;
844              
845 22 50       464 die "Can't alter field in another table"
846             if($from_field->table->name ne $to_field->table->name);
847              
848 22         448 my $generator = _generator($options);
849 22         48 my @out;
850              
851             # drop geometry column and constraints
852 22 100       46 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 22 100       505 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 22 100 100     756 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 22 100 100     814 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 22         507 my $from_dt = convert_datatype($from_field);
889 22         55 my $to_dt = convert_datatype($to_field);
890 22 100       262 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 22         77 my $old_default = $from_field->default_value;
900 22         53 my $new_default = $to_field->default_value;
901 22         46 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 22 100 100     120 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         15 $default_value = __PACKAGE__->_quote_string($default_value);
909             }
910              
911 22 100 100     185 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 22 100 100     114 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 22 100       62 push @out,
934             add_geometry_column($to_field, $options),
935             add_geometry_constraints($to_field, $options),
936             if is_geometry($to_field);
937              
938 22 100       134 return wantarray ? @out : join(";\n", @out);
939             }
940              
941 2     2 0 8 sub rename_field { alter_field(@_) }
942              
943             sub add_field
944             {
945 6     6 1 70 my ($new_field,$options) = @_;
946              
947 6         26 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       24 $out .= ";\n".add_geometry_column($new_field, $options)
951             . ";\n".add_geometry_constraints($new_field, $options)
952             if is_geometry($new_field);
953 6         34 return $out;
954              
955             }
956              
957             sub drop_field
958             {
959 4     4 1 1651 my ($old_field, $options) = @_;
960              
961 4         19 my $generator = _generator($options);
962              
963 4         124 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       40 $out .= ";\n".drop_geometry_column($old_field, $options)
967             if is_geometry($old_field);
968 4         25 return $out;
969             }
970              
971             sub add_geometry_column {
972 5     5 0 1286 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       126 ),
985             );
986             }
987              
988             sub drop_geometry_column {
989 4     4 0 7 my ($field) = @_;
990              
991 4         93 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 828 my ($field, $options) = @_;
1003              
1004 3         8 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 4 my ($field, $options) = @_;
1010              
1011 1         5 return join(";\n", map { alter_drop_constraint($_, $options) }
  3         10  
1012             create_geometry_constraints($field, $options));
1013              
1014             }
1015              
1016             sub alter_table {
1017 3     3 0 9 my ($to_table, $options) = @_;
1018 3         9 my $generator = _generator($options);
1019             my $out = sprintf('ALTER TABLE %s %s',
1020             $generator->quote($to_table->name),
1021 3         79 $options->{alter_table_action});
1022 3 100       18 $out .= ";\n".$options->{geometry_changes} if $options->{geometry_changes};
1023 3         15 return $out;
1024             }
1025              
1026             sub rename_table {
1027 3     3 0 847 my ($old_table, $new_table, $options) = @_;
1028 3         9 my $generator = _generator($options);
1029 3         17 $options->{alter_table_action} = "RENAME TO " . $generator->quote($new_table);
1030              
1031             my @geometry_changes = map {
1032             drop_geometry_column($_, $options),
1033 1         5 add_geometry_column($_, { %{$options}, table => $new_table }),
  1         7  
1034 3         60 } grep { is_geometry($_) } $old_table->get_fields;
  4         16  
1035              
1036 3 100       26 $options->{geometry_changes} = join (";\n",@geometry_changes) if @geometry_changes;
1037              
1038 3         15 return alter_table($old_table, $options);
1039             }
1040              
1041             sub alter_create_index {
1042 1     1 0 4 my ($index, $options) = @_;
1043 1         4 my $generator = _generator($options);
1044 1         6 my ($idef, $constraints) = create_index($index, $options);
1045 1 50       23 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 5 my ($index, $options) = @_;
1054 1         3 return 'DROP INDEX '. _generator($options)->quote($index->name);
1055             }
1056              
1057             sub alter_drop_constraint {
1058 14     14 0 5583 my ($c, $options) = @_;
1059 14         36 my $generator = _generator($options);
1060              
1061             # NOT NULL constraint does not require a DROP CONSTRAINT statement
1062 14 100       331 if ( $c->type eq NOT_NULL) {
1063 2         48 return;
1064             }
1065              
1066             # attention: Postgres has a very special naming structure for naming
1067             # foreign keys and primary keys. It names them using the name of the
1068             # table as prefix and fkey or pkey as suffix, concatenated by an underscore
1069 12         274 my $c_name;
1070 12 100       242 if( $c->name ) {
1071             # Already has a name, just use it
1072 9         158 $c_name = $c->name;
1073             } else {
1074             # if the name is dotted we need the table, not schema nor database
1075 3         55 my ($tablename) = reverse split /[.]/, $c->table->name;
1076 3 100       118 if ( $c->type eq FOREIGN_KEY ) {
    50          
1077             # Doesn't have a name, and is foreign key, append '_fkey'
1078 1         34 $c_name = $tablename . '_' . ($c->fields)[0] . '_fkey';
1079             } elsif ( $c->type eq PRIMARY_KEY ) {
1080             # Doesn't have a name, and is primary key, append '_pkey'
1081 2         40 $c_name = $tablename . '_pkey';
1082             }
1083             }
1084              
1085             return sprintf(
1086             'ALTER TABLE %s DROP CONSTRAINT %s',
1087 12         230 map { $generator->quote($_) } $c->table->name, $c_name,
  24         308  
1088             );
1089             }
1090              
1091             sub alter_create_constraint {
1092 14     14 0 35 my ($index, $options) = @_;
1093 14         33 my $generator = _generator($options);
1094 14         60 my ($defs, $fks) = create_constraint(@_);
1095              
1096             # return if there are no constraint definitions so we don't run
1097             # into output like this:
1098             # ALTER TABLE users ADD ;
1099              
1100 14 50 66     25 return unless(@{$defs} || @{$fks});
  14         59  
  1         5  
1101 1         32 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
1102             : join( ' ', 'ALTER TABLE', $generator->quote($index->table->name),
1103 14 100       260 'ADD', join(q{}, @{$defs}, @{$fks})
  13         29  
  13         126  
1104             );
1105             }
1106              
1107             sub drop_table {
1108 3     3 0 49 my ($table, $options) = @_;
1109 3         8 my $generator = _generator($options);
1110 3         31 my $out = "DROP TABLE " . $generator->quote($table) . " CASCADE";
1111              
1112 3         37 my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
  1         4  
  4         9  
1113              
1114 3 100       15 $out .= join(";\n", '', @geometry_drops) if @geometry_drops;
1115 3         14 return $out;
1116             }
1117              
1118             sub batch_alter_table {
1119 12     12 0 457 my ( $table, $diff_hash, $options ) = @_;
1120              
1121             # as long as we're not renaming the table we don't need to be here
1122 12 100       21 if ( @{$diff_hash->{rename_table}} == 0 ) {
  12         38  
1123 10         33 return batch_alter_table_statements($diff_hash, $options);
1124             }
1125              
1126             # first we need to perform drops which are on old table
1127 2         16 my @sql = batch_alter_table_statements($diff_hash, $options, qw(
1128             alter_drop_constraint
1129             alter_drop_index
1130             drop_field
1131             ));
1132              
1133             # next comes the rename_table
1134 2         13 my $old_table = $diff_hash->{rename_table}[0][0];
1135 2         13 push @sql, rename_table( $old_table, $table, $options );
1136              
1137             # for alter_field (and so also rename_field) we need to make sure old
1138             # field has table name set to new table otherwise calling alter_field dies
1139             $diff_hash->{alter_field} =
1140 2 0       7 [map { $_->[0]->table($table) && $_ } @{$diff_hash->{alter_field}}];
  0         0  
  2         9  
1141             $diff_hash->{rename_field} =
1142 2 0       7 [map { $_->[0]->table($table) && $_ } @{$diff_hash->{rename_field}}];
  0         0  
  2         6  
1143              
1144             # now add everything else
1145 2         10 push @sql, batch_alter_table_statements($diff_hash, $options, qw(
1146             add_field
1147             alter_field
1148             rename_field
1149             alter_create_index
1150             alter_create_constraint
1151             alter_table
1152             ));
1153              
1154 2         16 return @sql;
1155             }
1156              
1157             1;
1158              
1159             # -------------------------------------------------------------------
1160             # Life is full of misery, loneliness, and suffering --
1161             # and it's all over much too soon.
1162             # Woody Allen
1163             # -------------------------------------------------------------------
1164              
1165             =pod
1166              
1167             =head1 SEE ALSO
1168              
1169             SQL::Translator, SQL::Translator::Producer::Oracle.
1170              
1171             =head1 AUTHOR
1172              
1173             Ken Youens-Clark Ekclark@cpan.orgE.
1174              
1175             =cut