projects / dbsrgits/SQL-Translator-2.0-ish.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
add PostgreSQL producing
[dbsrgits/SQL-Translator-2.0-ish.git] / lib / SQL / Translator / Producer / SQL / PostgreSQL.pm
CommitLineData
4f4fd192 1use MooseX::Declare;
b819508a 2role SQL::Translator::Producer::SQL::PostgreSQL {
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
299
300 my $temporary = "";
301
302 if(exists $table->{extra}{temporary}) {
303 $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
304 }
305
306 my $create_statement;
307 $create_statement = join("\n", @comments);
308 if ($add_drop_table) {
309 if ($postgres_version >= 8.2) {
310 $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
311 $create_statement .= join (";\n", @type_drops) . ";\n"
312 if $postgres_version >= 8.3 && scalar @type_drops;
313 } else {
314 $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
315 }
316 }
317 $create_statement .= join(";\n", @type_defs) . ";\n"
318 if $postgres_version >= 8.3 && scalar @type_defs;
319 $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
320 join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
321 "\n)"
322 ;
323 $create_statement .= @index_defs ? ';' : q{};
324 $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
325 . join(";\n", @index_defs);
326
327 return $create_statement, \@fks;
328}
329
330method create_view(View $view, $options?) {
331 my $qt = $options->{quote_table_names} || '';
332 my $qf = $options->{quote_field_names} || '';
333 my $add_drop_view = $options->{add_drop_view};
334
335 my $view_name = $view->name;
336# debug("PKG: Looking at view '${view_name}'\n");
337
338 my $create = '';
339 $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
340 unless $options->{no_comments};
341 $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
342 $create .= 'CREATE';
343
344 my $extra = $view->extra;
345 $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
346 $create .= " VIEW ${qt}${view_name}${qt}";
347
348 if ( my @fields = $view->fields ) {
349 my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
350 $create .= " ( ${field_list} )";
351 }
352
353 if ( my $sql = $view->sql ) {
354 $create .= " AS\n ${sql}\n";
355 }
356
357 if ( $extra->{check_option} ) {
358 $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
359 }
360
361 return $create;
362}
363
364{
365
366 my %field_name_scope;
367
368 method create_field(Column $field, $options?) {
369 my $qt = $options->{quote_table_names} || '';
370 my $qf = $options->{quote_field_names} || '';
371 my $table_name = $field->table->name;
372 my $constraint_defs = $options->{constraint_defs} || [];
373 my $postgres_version = $options->{postgres_version} || 0;
374 my $type_defs = $options->{type_defs} || [];
375 my $type_drops = $options->{type_drops} || [];
376
377 $field_name_scope{$table_name} ||= {};
378 my $field_name = $field->name;
379 my $field_name_ur = $qf ? $field_name : $self->unreserve($field_name, $table_name );
380 $field->name($field_name_ur);
381 my $field_comments = $field->comments
382 ? "-- " . $field->comments . "\n "
383 : '';
384
385 my $field_def = $field_comments.qq[$qf$field_name_ur$qf];
386
387 #
388 # Datatype
389 #
390 my @size = $field->size;
391 my $data_type = lc $field->data_type;
392 my %extra = $field->extra;
393 my $list = $extra{'list'} || [];
394 # todo deal with embedded quotes
395 my $commalist = join( ', ', map { qq['$_'] } @$list );
396
397 if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
398 my $type_name = $field->table->name . '_' . $field->name . '_type';
399 $field_def .= ' '. $type_name;
400 push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
401 push @$type_drops, "DROP TYPE IF EXISTS $type_name";
402 } else {
403 $field_def .= ' '. $self->convert_datatype($field);
404 }
405
406 #
407 # Default value
408 #
409 my $default = $field->default_value;
410=cut
411 if ( defined $default ) {
412 SQL::Translator::Producer->_apply_default_value(
413 \$field_def,
414 $default,
415 [
416 'NULL' => \'NULL',
417 'now()' => 'now()',
418 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
419 ],
420 );
421 }
422=cut
423
424 #
425 # Not null constraint
426 #
427 $field_def .= ' NOT NULL' unless $field->is_nullable;
428
429 return $field_def;
430 }
431}
432
433method create_index(Index $index, $options?) {
434 my $qt = $options->{quote_table_names} ||'';
435 my $qf = $options->{quote_field_names} ||'';
436 my $table_name = $index->table->name;
437# my $table_name_ur = $qt ? $self->unreserve($table_name) : $table_name;
438
439 my ($index_def, @constraint_defs);
440
441 my $name = $self->next_unused_name(
442 $index->name
443 || join('_', $table_name, 'idx', ++$index_name{ $table_name })
444 );
445
446 my $type = $index->type || NORMAL;
447 my @fields =
448 map { $_ =~ s/\(.+\)//; $_ }
449 map { $qt ? $_ : $self->unreserve($_, $table_name ) }
450 $index->fields;
451 return ('', []) unless @fields;
452
453 my $def_start = qq[CONSTRAINT "$name" ];
454 if ( $type eq PRIMARY_KEY ) {
455 push @constraint_defs, "${def_start}PRIMARY KEY ".
456 '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
457 }
458 elsif ( $type eq UNIQUE ) {
459 push @constraint_defs, "${def_start}UNIQUE " .
460 '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
461 }
462 elsif ( $type eq NORMAL ) {
463 $index_def =
464 "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
465 join( ', ', map { qq[$qf$_$qf] } @fields ).
466 ')'
467 ;
468 }
469 else {
470# warn "Unknown index type ($type) on table $table_name.\n"
471# if $WARN;
472 }
473
474 return $index_def, \@constraint_defs;
475}
476
477method create_constraint(Constraint $c, $options?) {
478 my $qf = $options->{quote_field_names} ||'';
479 my $qt = $options->{quote_table_names} ||'';
480 my $table_name = $c->table->name;
481 my (@constraint_defs, @fks);
482
483 my $name = $c->name || '';
484 if ( $name ) {
485 $name = $self->next_unused_name($name);
486 }
487
488 my @fields =
489 map { $_ =~ s/\(.+\)//; $_ }
490 map { $qt ? $_ : $self->unreserve( $_, $table_name )}
491 $c->fields;
492
493 my @rfields =
494 map { $_ =~ s/\(.+\)//; $_ }
495 map { $qt ? $_ : $self->unreserve( $_, $table_name )}
496 $c->reference_fields;
497
498 return ([], []) if !@fields && $c->type ne CHECK_C;
499 my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
500 if ( $c->type eq PRIMARY_KEY ) {
501 push @constraint_defs, "${def_start}PRIMARY KEY ".
502 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
503 }
504 elsif ( $c->type eq UNIQUE ) {
505 $name = $self->next_unused_name($name);
506 push @constraint_defs, "${def_start}UNIQUE " .
507 '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
508 }
509 elsif ( $c->type eq CHECK_C ) {
510 my $expression = $c->expression;
511 push @constraint_defs, "${def_start}CHECK ($expression)";
512 }
513 elsif ( $c->type eq FOREIGN_KEY ) {
514 my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
515 join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
516 "\n REFERENCES " . $qt . $c->reference_table . $qt;
517
518 if ( @rfields ) {
519 $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
520 }
521
522 if ( $c->match_type ) {
523 $def .= ' MATCH ' .
524 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
525 }
526
527 if ( $c->on_delete ) {
528 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
529 }
530
531 if ( $c->on_update ) {
532 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
533 }
534
535 if ( $c->deferrable ) {
536 $def .= ' DEFERRABLE';
537 }
538
539 push @fks, "$def";
540 }
541
542 return \@constraint_defs, \@fks;
543}
544
545method convert_datatype(Column $field) {
546 my @size = $field->size;
547 my $data_type = lc $field->data_type;
548
549 if ( $data_type eq 'enum' ) {
550# my $len = 0;
551# $len = ($len < length($_)) ? length($_) : $len for (@$list);
552# my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
553# push @$constraint_defs,
554# qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
555# qq[IN ($commalist))];
556 $data_type = 'character varying';
557 }
558 elsif ( $data_type eq 'set' ) {
559 $data_type = 'character varying';
560 }
561 elsif ( $field->is_auto_increment ) {
562 if ( defined $size[0] && $size[0] > 11 ) {
563 $data_type = 'bigserial';
564 }
565 else {
566 $data_type = 'serial';
567 }
568 undef @size;
569 }
570 else {
571 $data_type = defined $translate{ $data_type } ?
572 $translate{ $data_type } :
573 $data_type;
574 }
575
576 if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
577 if ( defined $size[0] && $size[0] > 6 ) {
578 $size[0] = 6;
579 }
580 }
581
582 if ( $data_type eq 'integer' ) {
583 if ( defined $size[0] && $size[0] > 0) {
584 if ( $size[0] > 10 ) {
585 $data_type = 'bigint';
586 }
587 elsif ( $size[0] < 5 ) {
588 $data_type = 'smallint';
4f4fd192 589 }
b819508a 590 else {
591 $data_type = 'integer';
592 }
593 }
594 else {
595 $data_type = 'integer';
287d4603 596 }
b819508a 597 }
598
599 my $type_with_size = join('|',
600 'bit', 'varbit', 'character', 'bit varying', 'character varying',
601 'time', 'timestamp', 'interval'
602 );
603
604 if ( $data_type !~ /$type_with_size/ ) {
605 @size = ();
606 }
607
608 if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
609 $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
610 $data_type .= $2 if(defined $2);
611 } elsif ( defined $size[0] && $size[0] > 0 ) {
612 $data_type .= '(' . join( ',', @size ) . ')';
613 }
614
615 return $data_type;
616}
617
618
619method alter_field(Column $from_field, Column $to_field) {
620 die "Can't alter field in another table"
621 if($from_field->table->name ne $to_field->table->name);
622
623 my @out;
624 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
625 $to_field->table->name,
626 $to_field->name) if(!$to_field->is_nullable and
627 $from_field->is_nullable);
628
629 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
630 $to_field->table->name,
631 $to_field->name)
632 if ( !$from_field->is_nullable and $to_field->is_nullable );
633
634
635 my $from_dt = $self->convert_datatype($from_field);
636 my $to_dt = $self->convert_datatype($to_field);
637 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
638 $to_field->table->name,
639 $to_field->name,
640 $to_dt) if($to_dt ne $from_dt);
641
642 push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
643 $to_field->table->name,
644 $from_field->name,
645 $to_field->name) if($from_field->name ne $to_field->name);
646
647 my $old_default = $from_field->default_value;
648 my $new_default = $to_field->default_value;
649 my $default_value = $to_field->default_value;
4f4fd192 650
b819508a 651 # fixes bug where output like this was created:
652 # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
653 if(ref $default_value eq "SCALAR" ) {
654 $default_value = $$default_value;
655 } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
656 $default_value =~ s/'/''/xsmg;
657 $default_value = q(') . $default_value . q(');
287d4603 658 }
4f4fd192 659
b819508a 660 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
661 $to_field->table->name,
662 $to_field->name,
663 $default_value)
664 if ( defined $new_default &&
665 (!defined $old_default || $old_default ne $new_default) );
666
667 # fixes bug where removing the DEFAULT statement of a column
668 # would result in no change
4f4fd192 669
b819508a 670 push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
671 $to_field->table->name,
672 $to_field->name)
673 if ( !defined $new_default && defined $old_default );
4f4fd192 674
b819508a 675
676 return wantarray ? @out : join("\n", @out);
677}
678
679method rename_field(@args) { $self->alter_field(@args) }
680
681method add_field(Column $new_field) {
682 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
683 $new_field->table->name,
684 $self->create_field($new_field));
685 return $out;
686
687}
688
689method drop_field(Column $old_field) {
690 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
691 $old_field->table->name,
692 $old_field->name);
693
694 return $out;
695}
696
697method alter_table(Column $to_table, $options?) {
698 my $qt = $options->{quote_table_names} || '';
699 my $out = sprintf('ALTER TABLE %s %s',
700 $qt . $to_table->name . $qt,
701 $options->{alter_table_action});
702 return $out;
703}
704
705method rename_table(Table $old_table, Table $new_table, $options?) {
706 my $qt = $options->{quote_table_names} || '';
707 $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
708 return alter_table($old_table, $options);
709}
710
711method alter_create_index(Index $index, $options?) {
712 my $qt = $options->{quote_table_names} || '';
713 my $qf = $options->{quote_field_names} || '';
714 my ($idef, $constraints) = create_index($index, {
715 quote_field_names => $qf,
716 quote_table_names => $qt,
717 table_name => $index->table->name,
718 });
719 return $index->type eq NORMAL ? $idef
720 : sprintf('ALTER TABLE %s ADD %s',
721 $qt . $index->table->name . $qt,
722 join(q{}, @$constraints)
723 );
724}
725
726method alter_drop_index(Index $index, $options?) {
727 my $index_name = $index->name;
728 return "DROP INDEX $index_name";
729}
730
731method alter_drop_constraint(Constraint $c, $options?) {
732 my $qt = $options->{quote_table_names} || '';
733 my $qc = $options->{quote_field_names} || '';
734 my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
735 $qt . $c->table->name . $qt,
736 $qc . $c->name . $qc );
737 return $out;
738}
739
740method alter_create_constraint(Index $index, $options?) {
741 my $qt = $options->{quote_table_names} || '';
742 my ($defs, $fks) = create_constraint(@_);
4f4fd192 743
b819508a 744 # return if there are no constraint definitions so we don't run
745 # into output like this:
746 # ALTER TABLE users ADD ;
747
748 return unless(@{$defs} || @{$fks});
749 return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
750 : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
751 'ADD', join(q{}, @{$defs}, @{$fks})
752 );
753}
754
755method drop_table(Str $table, $options?) {
756 my $qt = $options->{quote_table_names} || '';
757 return "DROP TABLE $qt$table$qt CASCADE";
758}
759
760 method header_comment($producer?, $comment_char?) {
761 $producer ||= caller;
762 my $now = scalar localtime;
763 my $DEFAULT_COMMENT = '-- ';
764
765 $comment_char = $DEFAULT_COMMENT
766 unless defined $comment_char;
767
768 my $header_comment =<<"HEADER_COMMENT";
769 ${comment_char}
770 ${comment_char}Created by $producer
771 ${comment_char}Created on $now
772 ${comment_char}
773HEADER_COMMENT
774
775 # Any additional stuff passed in
776 for my $additional_comment (@_) {
777 $header_comment .= "${comment_char}${additional_comment}\n";
778 }
779
780 return $header_comment;
287d4603 781 }
287d4603 782}
SQL::Translator (GSOC work)