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