projects / dbsrgits/SQL-Translator-2.0-ish.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
add (and use) _default_value method, relatively similar to old _apply_default_value
[dbsrgits/SQL-Translator-2.0-ish.git] / lib / SQL / Translator / Producer / SQL / PostgreSQL.pm
CommitLineData
4f4fd192 1use MooseX::Declare;
b62122e6 2role SQL::Translator::Producer::SQL::PostgreSQL {
b819508a 3 use SQL::Translator::Constants qw(:sqlt_types :sqlt_constants);
4 use SQL::Translator::Types qw(Column Constraint Index Table View);
5my ( %index_name );
6my $max_id_length;
7
8#BEGIN {
9
10my %translate = (
11 #
12 # MySQL types
13 #
14 bigint => 'bigint',
15 double => 'numeric',
16 decimal => 'numeric',
17 float => 'numeric',
18 int => 'integer',
19 mediumint => 'integer',
20 smallint => 'smallint',
21 tinyint => 'smallint',
22 char => 'character',
23 varchar => 'character varying',
24 longtext => 'text',
25 mediumtext => 'text',
26 text => 'text',
27 tinytext => 'text',
28 tinyblob => 'bytea',
29 blob => 'bytea',
30 mediumblob => 'bytea',
31 longblob => 'bytea',
32 enum => 'character varying',
33 set => 'character varying',
34 date => 'date',
35 datetime => 'timestamp',
36 time => 'time',
37 timestamp => 'timestamp',
38 year => 'date',
39
40 #
41 # Oracle types
42 #
43 number => 'integer',
44 char => 'character',
45 varchar2 => 'character varying',
46 long => 'text',
47 CLOB => 'bytea',
48 date => 'date',
49
50 #
51 # Sybase types
52 #
53 int => 'integer',
54 money => 'money',
55 varchar => 'character varying',
56 datetime => 'timestamp',
57 text => 'text',
58 real => 'numeric',
59 comment => 'text',
60 bit => 'bit',
61 tinyint => 'smallint',
62 float => 'numeric',
63);
64
65 $max_id_length = 62;
66#}
67my %reserved = map { $_, 1 } qw[
68 ALL ANALYSE ANALYZE AND ANY AS ASC
69 BETWEEN BINARY BOTH
70 CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
71 CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
72 DEFAULT DEFERRABLE DESC DISTINCT DO
73 ELSE END EXCEPT
74 FALSE FOR FOREIGN FREEZE FROM FULL
75 GROUP HAVING
76 ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
77 JOIN LEADING LEFT LIKE LIMIT
78 NATURAL NEW NOT NOTNULL NULL
79 OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
80 PRIMARY PUBLIC REFERENCES RIGHT
81 SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
82 UNION UNIQUE USER USING VERBOSE WHEN WHERE
83];
84
85# my $max_id_length = 62;
86my %used_names;
87my %used_identifiers = ();
88my %global_names;
89my %unreserve;
90my %truncated;
91
92# -------------------------------------------------------------------
93method produce {
94 my $translator = $self->translator;
95# local $DEBUG = $translator->debug;
96# local $WARN = $translator->show_warnings;
97 my $no_comments = $translator->no_comments;
98 my $add_drop_table = $translator->add_drop_table;
99 my $schema = $translator->schema;
100 my $pargs = $translator->producer_args;
101 my $postgres_version = $pargs->{postgres_version} || 0;
102
103 my $qt = $translator->quote_table_names ? q{"} : q{};
104 my $qf = $translator->quote_field_names ? q{"} : q{};
4f4fd192 105
b819508a 106 my @output;
107 push @output, $self->header_comment unless ($no_comments);
108
109 my (@table_defs, @fks);
110 for my $table ( $schema->get_tables ) {
111
112 my ($table_def, $fks) = $self->create_table($table, {
113 quote_table_names => $qt,
114 quote_field_names => $qf,
115 no_comments => $no_comments,
116 postgres_version => $postgres_version,
117 add_drop_table => $add_drop_table,
118 });
119
120 push @table_defs, $table_def;
121 push @fks, @$fks;
122 }
123
124 for my $view ( $schema->get_views ) {
125 push @table_defs, $self->create_view($view, {
126 add_drop_view => $add_drop_table,
127 quote_table_names => $qt,
128 quote_field_names => $qf,
129 no_comments => $no_comments,
130 });
131 }
132
133 push @output, map { "$_;\n\n" } @table_defs;
134 if ( @fks ) {
135 push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
136 push @output, map { "$_;\n\n" } @fks;
137 }
138
139# if ( $WARN ) {
140# if ( %truncated ) {
141# warn "Truncated " . keys( %truncated ) . " names:\n";
142# warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
143# }
144
145# if ( %unreserve ) {
146# warn "Encounted " . keys( %unreserve ) .
147# " unsafe names in schema (reserved or invalid):\n";
148# warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
149# }
150# }
151
152 return wantarray
153 ? @output
154 : join ('', @output);
155}
156
157# -------------------------------------------------------------------
158method mk_name($basename = '', $type = '', $scope = '', $critical = '') {
159 my $basename_orig = $basename;
160# my $max_id_length = 62;
161 my $max_name = $type
162 ? $max_id_length - (length($type) + 1)
163 : $max_id_length;
164 $basename = substr( $basename, 0, $max_name )
165 if length( $basename ) > $max_name;
166 my $name = $type ? "${type}_$basename" : $basename;
167
168 if ( $basename ne $basename_orig and $critical ) {
169 my $show_type = $type ? "+'$type'" : "";
170# warn "Truncating '$basename_orig'$show_type to $max_id_length ",
171# "character limit to make '$name'\n" if $WARN;
172 $truncated{ $basename_orig } = $name;
173 }
174
175 $scope ||= \%global_names;
176 if ( my $prev = $scope->{ $name } ) {
177 my $name_orig = $name;
178 $name .= sprintf( "%02d", ++$prev );
179 substr($name, $max_id_length - 3) = "00"
180 if length( $name ) > $max_id_length;
181
182# warn "The name '$name_orig' has been changed to ",
183# "'$name' to make it unique.\n" if $WARN;
184
185 $scope->{ $name_orig }++;
186 }
187
188 $scope->{ $name }++;
189 return $name;
190}
191
192# -------------------------------------------------------------------
193method unreserve($name = '', $schema_obj_name = '') {
194 my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
195
196 # also trap fields that don't begin with a letter
197 return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
198
199 if ( $schema_obj_name ) {
200 ++$unreserve{"$schema_obj_name.$name"};
201 }
202 else {
203 ++$unreserve{"$name (table name)"};
204 }
205
206 my $unreserve = sprintf '%s_', $name;
207 return $unreserve.$suffix;
208}
209
210# -------------------------------------------------------------------
211method next_unused_name($orig_name?) {
212 return unless $orig_name;
213 my $name = $orig_name;
214
215 my $suffix_gen = sub {
216 my $suffix = 0;
217 return ++$suffix ? '' : $suffix;
218 };
219
220 for (;;) {
221 $name = $orig_name . $suffix_gen->();
222 last if $used_names{ $name }++;
223 }
224
225 return $name;
226}
227
228method create_table(Table $table, $options?) {
229 my $qt = $options->{quote_table_names} || '';
230 my $qf = $options->{quote_field_names} || '';
231 my $no_comments = $options->{no_comments} || 0;
232 my $add_drop_table = $options->{add_drop_table} || 0;
233 my $postgres_version = $options->{postgres_version} || 0;
234
235 my $table_name = $table->name or next;
236 my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
237 my $table_name_ur = $qt ? $table_name
238 : $fql_tbl_name ? join('.', $table_name, $self->unreserve($fql_tbl_name))
239 : $self->unreserve($table_name);
240 $table->name($table_name_ur);
241
242# print STDERR "$table_name table_name\n";
243 my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
244
245 push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
246
247 if ( $table->comments and !$no_comments ){
248 my $c = "-- Comments: \n-- ";
249 $c .= join "\n-- ", $table->comments;
250 $c .= "\n--\n";
251 push @comments, $c;
252 }
253
254 #
255 # Fields
256 #
257 my %field_name_scope;
258 for my $field ( $table->get_fields ) {
259 push @field_defs, $self->create_field($field, { quote_table_names => $qt,
260 quote_field_names => $qf,
261 table_name => $table_name_ur,
262 postgres_version => $postgres_version,
263 type_defs => \@type_defs,
264 type_drops => \@type_drops,
265 constraint_defs => \@constraint_defs,});
266 }
267
268 #
269 # Index Declarations
270 #
271 my @index_defs = ();
272 # my $idx_name_default;
273 for my $index ( $table->get_indices ) {
274 my ($idef, $constraints) = $self->create_index($index,
275 {
276 quote_field_names => $qf,
277 quote_table_names => $qt,
278 table_name => $table_name,
279 });
280 $idef and push @index_defs, $idef;
281 push @constraint_defs, @$constraints;
282 }
283
284 #
285 # Table constraints
286 #
287 my $c_name_default;
288 for my $c ( $table->get_constraints ) {
289 my ($cdefs, $fks) = $self->create_constraint($c,
290 {
291 quote_field_names => $qf,
292 quote_table_names => $qt,
293 table_name => $table_name,
294 });
295 push @constraint_defs, @$cdefs;
296 push @fks, @$fks;
297 }
298
b819508a 299 my $temporary = "";
300
301 if(exists $table->{extra}{temporary}) {
302 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
303 }
304
305 my $create_statement;
306 $create_statement = join("\n", @comments);
307 if ($add_drop_table) {
308 if ($postgres_version >= 8.2) {
309 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
310 $create_statement .= join (";\n", @type_drops) . ";\n"
311 if $postgres_version >= 8.3 && scalar @type_drops;
312 } else {
313 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
314 }
315 }
316 $create_statement .= join(";\n", @type_defs) . ";\n"
317 if $postgres_version >= 8.3 && scalar @type_defs;
318 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
d5f4c45f 319 join( ",\n", map { " $_" } @field_defs, @constraint_defs ) .
320 "\n)" ;
321
b819508a 322 $create_statement .= @index_defs ? ';' : q{};
323 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
324 . join(";\n", @index_defs);
325
326 return $create_statement, \@fks;
327}
328
329method create_view(View $view, $options?) {
330 my $qt = $options->{quote_table_names} || '';
331 my $qf = $options->{quote_field_names} || '';
332 my $add_drop_view = $options->{add_drop_view};
333
334 my $view_name = $view->name;
b819508a 335
336 my $create = '';
337 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
338 unless $options->{no_comments};
339 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
340 $create .= 'CREATE';
341
342 my $extra = $view->extra;
343 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
344 $create .= " VIEW ${qt}${view_name}${qt}";
345
346 if ( my @fields = $view->fields ) {
347 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
348 $create .= " ( ${field_list} )";
349 }
350
351 if ( my $sql = $view->sql ) {
352 $create .= " AS\n ${sql}\n";
353 }
354
355 if ( $extra->{check_option} ) {
356 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
357 }
358
359 return $create;
360}
361
362{
363
364 my %field_name_scope;
365
366 method create_field(Column $field, $options?) {
367 my $qt = $options->{quote_table_names} || '';
368 my $qf = $options->{quote_field_names} || '';
369 my $table_name = $field->table->name;
370 my $constraint_defs = $options->{constraint_defs} || [];
371 my $postgres_version = $options->{postgres_version} || 0;
372 my $type_defs = $options->{type_defs} || [];
373 my $type_drops = $options->{type_drops} || [];
374
375 $field_name_scope{$table_name} ||= {};
376 my $field_name = $field->name;
377 my $field_name_ur = $qf ? $field_name : $self->unreserve($field_name, $table_name );
378 $field->name($field_name_ur);
379 my $field_comments = $field->comments
380 ? "-- " . $field->comments . "\n "
381 : '';
382
383 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
384
385 #
386 # Datatype
387 #
388 my @size = $field->size;
389 my $data_type = lc $field->data_type;
390 my %extra = $field->extra;
391 my $list = $extra{'list'} || [];
392 # todo deal with embedded quotes
393 my $commalist = join( ', ', map { qq['$_'] } @$list );
394
395 if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
396 my $type_name = $field->table->name . '_' . $field->name . '_type';
397 $field_def .= ' '. $type_name;
398 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
399 push @$type_drops, "DROP TYPE IF EXISTS $type_name";
400 } else {
401 $field_def .= ' '. $self->convert_datatype($field);
402 }
403
404 #
405 # Default value
406 #
407 my $default = $field->default_value;
b62122e6 408 $field_def .= $self->_default_value($default, [ 'NULL'=> \'NULL', 'now()' => 'now()', 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP', ] ) if defined $default;
b819508a 409
410 #
411 # Not null constraint
412 #
413 $field_def .= ' NOT NULL' unless $field->is_nullable;
414
415 return $field_def;
416 }
417}
418
419method create_index(Index $index, $options?) {
420 my $qt = $options->{quote_table_names} ||'';
421 my $qf = $options->{quote_field_names} ||'';
422 my $table_name = $index->table->name;
423# my $table_name_ur = $qt ? $self->unreserve($table_name) : $table_name;
424
425 my ($index_def, @constraint_defs);
426
427 my $name = $self->next_unused_name(
428 $index->name
429 || join('_', $table_name, 'idx', ++$index_name{ $table_name })
430 );
431
432 my $type = $index->type || NORMAL;
433 my @fields =
434 map { $_ =~ s/\(.+\)//; $_ }
435 map { $qt ? $_ : $self->unreserve($_, $table_name ) }
436 $index->fields;
437 return ('', []) unless @fields;
438
439 my $def_start = qq[CONSTRAINT "$name" ];
440 if ( $type eq PRIMARY_KEY ) {
441 push @constraint_defs, "${def_start}PRIMARY KEY ".
442 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
443 }
444 elsif ( $type eq UNIQUE ) {
445 push @constraint_defs, "${def_start}UNIQUE " .
446 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
447 }
448 elsif ( $type eq NORMAL ) {
449 $index_def =
450 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
451 join( ', ', map { qq[$qf$_$qf] } @fields ).
452 ')'
453 ;
454 }
455 else {
456# warn "Unknown index type ($type) on table $table_name.\n"
457# if $WARN;
458 }
459
460 return $index_def, \@constraint_defs;
461}
462
463method create_constraint(Constraint $c, $options?) {
464 my $qf = $options->{quote_field_names} ||'';
465 my $qt = $options->{quote_table_names} ||'';
466 my $table_name = $c->table->name;
467 my (@constraint_defs, @fks);
468
469 my $name = $c->name || '';
470 if ( $name ) {
471 $name = $self->next_unused_name($name);
472 }
473
474 my @fields =
475 map { $_ =~ s/\(.+\)//; $_ }
476 map { $qt ? $_ : $self->unreserve( $_, $table_name )}
477 $c->fields;
b819508a 478 my @rfields =
479 map { $_ =~ s/\(.+\)//; $_ }
480 map { $qt ? $_ : $self->unreserve( $_, $table_name )}
481 $c->reference_fields;
b819508a 482 return ([], []) if !@fields && $c->type ne CHECK_C;
d5f4c45f 483
b819508a 484 my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
485 if ( $c->type eq PRIMARY_KEY ) {
486 push @constraint_defs, "${def_start}PRIMARY KEY ".
487 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
488 }
489 elsif ( $c->type eq UNIQUE ) {
490 $name = $self->next_unused_name($name);
491 push @constraint_defs, "${def_start}UNIQUE " .
492 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
493 }
494 elsif ( $c->type eq CHECK_C ) {
495 my $expression = $c->expression;
496 push @constraint_defs, "${def_start}CHECK ($expression)";
497 }
498 elsif ( $c->type eq FOREIGN_KEY ) {
499 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
500 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
501 "\n REFERENCES " . $qt . $c->reference_table . $qt;
502
503 if ( @rfields ) {
504 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
505 }
506
507 if ( $c->match_type ) {
d5f4c45f 508 $def .= ' MATCH ' . ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
b819508a 509 }
510
e20b43c1 511# if ( $c->on_delete ) {
512# $def .= ' ON DELETE '.join( ' ', $c->on_delete );
513# }
514
515# if ( $c->on_update ) {
516# $def .= ' ON UPDATE '.join( ' ', $c->on_update );
517# }
b819508a 518
b819508a 519 if ( $c->deferrable ) {
520 $def .= ' DEFERRABLE';
521 }
522
523 push @fks, "$def";
524 }
525
526 return \@constraint_defs, \@fks;
527}
528
529method convert_datatype(Column $field) {
530 my @size = $field->size;
531 my $data_type = lc $field->data_type;
532
533 if ( $data_type eq 'enum' ) {
534# my $len = 0;
535# $len = ($len < length($_)) ? length($_) : $len for (@$list);
536# my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
537# push @$constraint_defs,
538# qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
539# qq[IN ($commalist))];
540 $data_type = 'character varying';
541 }
542 elsif ( $data_type eq 'set' ) {
543 $data_type = 'character varying';
544 }
545 elsif ( $field->is_auto_increment ) {
546 if ( defined $size[0] && $size[0] > 11 ) {
547 $data_type = 'bigserial';
548 }
549 else {
550 $data_type = 'serial';
551 }
552 undef @size;
553 }
554 else {
555 $data_type = defined $translate{ $data_type } ?
556 $translate{ $data_type } :
557 $data_type;
558 }
559
560 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
561 if ( defined $size[0] && $size[0] > 6 ) {
562 $size[0] = 6;
563 }
564 }
565
566 if ( $data_type eq 'integer' ) {
567 if ( defined $size[0] && $size[0] > 0) {
568 if ( $size[0] > 10 ) {
569 $data_type = 'bigint';
570 }
571 elsif ( $size[0] < 5 ) {
572 $data_type = 'smallint';
4f4fd192 573 }
b819508a 574 else {
575 $data_type = 'integer';
576 }
577 }
578 else {
579 $data_type = 'integer';
287d4603 580 }
b819508a 581 }
582
583 my $type_with_size = join('|',
584 'bit', 'varbit', 'character', 'bit varying', 'character varying',
585 'time', 'timestamp', 'interval'
586 );
587
588 if ( $data_type !~ /$type_with_size/ ) {
589 @size = ();
590 }
591
592 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
593 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
594 $data_type .= $2 if(defined $2);
595 } elsif ( defined $size[0] && $size[0] > 0 ) {
596 $data_type .= '(' . join( ',', @size ) . ')';
597 }
598
599 return $data_type;
600}
601
602
603method alter_field(Column $from_field, Column $to_field) {
604 die "Can't alter field in another table"
605 if($from_field->table->name ne $to_field->table->name);
606
607 my @out;
608 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
609 $to_field->table->name,
610 $to_field->name) if(!$to_field->is_nullable and
611 $from_field->is_nullable);
612
613 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
614 $to_field->table->name,
615 $to_field->name)
616 if ( !$from_field->is_nullable and $to_field->is_nullable );
617
618
619 my $from_dt = $self->convert_datatype($from_field);
620 my $to_dt = $self->convert_datatype($to_field);
621 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
622 $to_field->table->name,
623 $to_field->name,
624 $to_dt) if($to_dt ne $from_dt);
625
626 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
627 $to_field->table->name,
628 $from_field->name,
629 $to_field->name) if($from_field->name ne $to_field->name);
630
631 my $old_default = $from_field->default_value;
632 my $new_default = $to_field->default_value;
633 my $default_value = $to_field->default_value;
4f4fd192 634
b819508a 635 # fixes bug where output like this was created:
636 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
637 if(ref $default_value eq "SCALAR" ) {
638 $default_value = $$default_value;
639 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
640 $default_value =~ s/'/''/xsmg;
641 $default_value = q(') . $default_value . q(');
287d4603 642 }
4f4fd192 643
b819508a 644 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
645 $to_field->table->name,
646 $to_field->name,
647 $default_value)
648 if ( defined $new_default &&
649 (!defined $old_default || $old_default ne $new_default) );
650
651 # fixes bug where removing the DEFAULT statement of a column
652 # would result in no change
4f4fd192 653
b819508a 654 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
655 $to_field->table->name,
656 $to_field->name)
657 if ( !defined $new_default && defined $old_default );
4f4fd192 658
b819508a 659
660 return wantarray ? @out : join("\n", @out);
661}
662
663method rename_field(@args) { $self->alter_field(@args) }
664
665method add_field(Column $new_field) {
666 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
667 $new_field->table->name,
668 $self->create_field($new_field));
669 return $out;
670
671}
672
673method drop_field(Column $old_field) {
674 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
675 $old_field->table->name,
676 $old_field->name);
677
678 return $out;
679}
680
681method alter_table(Column $to_table, $options?) {
682 my $qt = $options->{quote_table_names} || '';
683 my $out = sprintf('ALTER TABLE %s %s',
684 $qt . $to_table->name . $qt,
685 $options->{alter_table_action});
686 return $out;
687}
688
689method rename_table(Table $old_table, Table $new_table, $options?) {
690 my $qt = $options->{quote_table_names} || '';
691 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
692 return alter_table($old_table, $options);
693}
694
695method alter_create_index(Index $index, $options?) {
696 my $qt = $options->{quote_table_names} || '';
697 my $qf = $options->{quote_field_names} || '';
698 my ($idef, $constraints) = create_index($index, {
699 quote_field_names => $qf,
700 quote_table_names => $qt,
701 table_name => $index->table->name,
702 });
703 return $index->type eq NORMAL ? $idef
704 : sprintf('ALTER TABLE %s ADD %s',
705 $qt . $index->table->name . $qt,
706 join(q{}, @$constraints)
707 );
708}
709
710method alter_drop_index(Index $index, $options?) {
711 my $index_name = $index->name;
712 return "DROP INDEX $index_name";
713}
714
715method alter_drop_constraint(Constraint $c, $options?) {
716 my $qt = $options->{quote_table_names} || '';
717 my $qc = $options->{quote_field_names} || '';
718 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
719 $qt . $c->table->name . $qt,
720 $qc . $c->name . $qc );
721 return $out;
722}
723
724method alter_create_constraint(Index $index, $options?) {
725 my $qt = $options->{quote_table_names} || '';
726 my ($defs, $fks) = create_constraint(@_);
4f4fd192 727
b819508a 728 # return if there are no constraint definitions so we don't run
729 # into output like this:
730 # ALTER TABLE users ADD ;
731
732 return unless(@{$defs} || @{$fks});
733 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
734 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
735 'ADD', join(q{}, @{$defs}, @{$fks})
736 );
737}
738
739method drop_table(Str $table, $options?) {
740 my $qt = $options->{quote_table_names} || '';
741 return "DROP TABLE $qt$table$qt CASCADE";
742}
743
744 method header_comment($producer?, $comment_char?) {
745 $producer ||= caller;
746 my $now = scalar localtime;
747 my $DEFAULT_COMMENT = '-- ';
748
749 $comment_char = $DEFAULT_COMMENT
750 unless defined $comment_char;
751
752 my $header_comment =<<"HEADER_COMMENT";
753 ${comment_char}
754 ${comment_char}Created by $producer
755 ${comment_char}Created on $now
756 ${comment_char}
757HEADER_COMMENT
758
759 # Any additional stuff passed in
760 for my $additional_comment (@_) {
761 $header_comment .= "${comment_char}${additional_comment}\n";
762 }
763
764 return $header_comment;
287d4603 765 }
287d4603 766}
SQL::Translator (GSOC work)