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