1 package SQL::Translator::Producer::MySQL;
3 # -------------------------------------------------------------------
4 # $Id: MySQL.pm,v 1.54 2007-11-10 03:36:43 mwz444 Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2002-4 SQLFairy Authors
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # -------------------------------------------------------------------
25 SQL::Translator::Producer::MySQL - MySQL-specific producer for SQL::Translator
29 Use via SQL::Translator:
33 my $t = SQL::Translator->new( parser => '...', producer => 'MySQL', '...' );
38 This module will produce text output of the schema suitable for MySQL.
39 There are still some issues to be worked out with syntax differences
40 between MySQL versions 3 and 4 ("SET foreign_key_checks," character sets
45 Normally the tables will be created without any explicit table type given and
46 so will use the MySQL default.
48 Any tables involved in foreign key constraints automatically get a table type
49 of InnoDB, unless this is overridden by setting the C<mysql_table_type> extra
50 attribute explicitly on the table.
52 =head2 Extra attributes.
54 The producer recognises the following extra attributes on the Schema objects.
60 Set the list of allowed values for Enum fields.
62 =item B<field.binary>, B<field.unsigned>, B<field.zerofill>
64 Set the MySQL field options of the same name.
66 =item B<field.renamed_from>, B<table.renamed_from>
68 Use when producing diffs to indicate that the current table/field has been
69 renamed from the old name as given in the attribute value.
71 =item B<table.mysql_table_type>
73 Set the type of the table e.g. 'InnoDB', 'MyISAM'. This will be
74 automatically set for tables involved in foreign key constraints if it is
75 not already set explicitly. See L<"Table Types">.
77 Please note that the C<ENGINE> option is the prefered method of specifying
78 the MySQL storage engine to use, but this method still works for backwards
81 =item B<table.mysql_charset>, B<table.mysql_collate>
83 Set the tables default charater set and collation order.
85 =item B<field.mysql_charset>, B<field.mysql_collate>
87 Set the fields charater set and collation order.
95 use vars qw[ $VERSION $DEBUG %used_names ];
96 $VERSION = sprintf "%d.%02d", q$Revision: 1.54 $ =~ /(\d+)\.(\d+)/;
97 $DEBUG = 0 unless defined $DEBUG;
100 use SQL::Translator::Schema::Constants;
101 use SQL::Translator::Utils qw(debug header_comment);
104 # Use only lowercase for the keys (e.g. "long" and not "LONG")
110 varchar2 => 'varchar',
126 'long integer' => 'integer',
128 'datetime' => 'datetime',
132 sub preprocess_schema {
135 # extra->{mysql_table_type} used to be the type. It belongs in options, so
136 # move it if we find it. Return Engine type if found in extra or options
137 my $mysql_table_type_to_options = sub {
140 my $extra = $table->extra;
142 my $extra_type = delete $extra->{mysql_table_type};
144 # Now just to find if there is already an Engine or Type option...
145 # and lets normalize it to ENGINE since:
147 # The ENGINE table option specifies the storage engine for the table.
148 # TYPE is a synonym, but ENGINE is the preferred option name.
151 # We have to use the hash directly here since otherwise there is no way
153 my $options = ( $table->{options} ||= []);
155 # This assumes that there isn't both a Type and an Engine option.
156 for my $idx ( 0..$#{$options} ) {
157 my ($key, $value) = %{ $options->[$idx] };
159 next unless uc $key eq 'ENGINE' || uc $key eq 'TYPE';
161 # if the extra.mysql_table_type is given, use that
162 delete $options->[$idx]{$key};
163 return $options->[$idx]{ENGINE} = $value || $extra_type;
168 push @$options, { ENGINE => $extra_type };
174 # Names are only specific to a given schema
175 local %used_names = ();
178 # Work out which tables need to be InnoDB to support foreign key
179 # constraints. We do this first as we need InnoDB at both ends.
181 foreach my $table ( $schema->get_tables ) {
183 $mysql_table_type_to_options->($table);
185 foreach my $c ( $table->get_constraints ) {
186 next unless $c->type eq FOREIGN_KEY;
188 # Normalize constraint names here.
189 my $c_name = $c->name;
190 # Give the constraint a name if it doesn't have one, so it doens't feel
192 $c_name = $table->name . '_fk' unless length $c_name;
194 $c->name( next_unused_name($c_name) );
196 for my $meth (qw/table reference_table/) {
197 my $table = $schema->get_table($c->$meth) || next;
198 next if $mysql_table_type_to_options->($table);
199 $table->options( { 'ENGINE' => 'InnoDB' } );
201 } # foreach constraints
203 foreach my $f ( $table->get_fields ) {
205 if ( !$size[0] && $f->data_type =~ /char$/ ) {
214 my $translator = shift;
215 local $DEBUG = $translator->debug;
217 my $no_comments = $translator->no_comments;
218 my $add_drop_table = $translator->add_drop_table;
219 my $schema = $translator->schema;
220 my $show_warnings = $translator->show_warnings || 0;
222 my ($qt, $qf) = ('','');
223 $qt = '`' if $translator->quote_table_names;
224 $qf = '`' if $translator->quote_field_names;
226 debug("PKG: Beginning production\n");
229 $create .= header_comment unless ($no_comments);
230 # \todo Don't set if MySQL 3.x is set on command line
231 $create .= "SET foreign_key_checks=0;\n\n";
233 preprocess_schema($schema);
240 for my $table ( $schema->get_tables ) {
241 # print $table->name, "\n";
242 push @table_defs, create_table($table,
243 { add_drop_table => $add_drop_table,
244 show_warnings => $show_warnings,
245 no_comments => $no_comments,
246 quote_table_names => $qt,
247 quote_field_names => $qf
251 # print "@table_defs\n";
252 push @table_defs, "SET foreign_key_checks=1;\n\n";
254 return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
259 my ($table, $options) = @_;
261 my $qt = $options->{quote_table_names} || '';
262 my $qf = $options->{quote_field_names} || '';
264 my $table_name = $table->name;
265 debug("PKG: Looking at table '$table_name'\n");
268 # Header. Should this look like what mysqldump produces?
272 $create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
273 $drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
274 $create .= "CREATE TABLE $qt$table_name$qt (\n";
280 for my $field ( $table->get_fields ) {
281 push @field_defs, create_field($field, $options);
289 for my $index ( $table->get_indices ) {
290 push @index_defs, create_index($index, $options);
291 $indexed_fields{ $_ } = 1 for $index->fields;
295 # Constraints -- need to handle more than just FK. -ky
298 my @constraints = $table->get_constraints;
299 for my $c ( @constraints ) {
300 my $constr = create_constraint($c, $options);
301 push @constraint_defs, $constr if($constr);
303 unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
304 push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
305 $indexed_fields{ ($c->fields())[0] } = 1;
309 $create .= join(",\n", map { " $_" }
310 @field_defs, @index_defs, @constraint_defs
317 $create .= generate_table_options($table) || '';
320 return $drop ? ($drop,$create) : $create;
323 sub generate_table_options
328 my $table_type_defined = 0;
329 for my $t1_option_ref ( $table->options ) {
330 my($key, $value) = %{$t1_option_ref};
331 $table_type_defined = 1
332 if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
333 $create .= " $key=$value";
336 my $mysql_table_type = $table->extra('mysql_table_type');
337 $create .= " ENGINE=$mysql_table_type"
338 if $mysql_table_type && !$table_type_defined;
339 my $charset = $table->extra('mysql_charset');
340 my $collate = $table->extra('mysql_collate');
341 my $comments = $table->comments;
343 $create .= " DEFAULT CHARACTER SET $charset" if $charset;
344 $create .= " COLLATE $collate" if $collate;
345 $create .= qq[ comment='$comments'] if $comments;
351 my ($field, $options) = @_;
353 my $qf = $options->{quote_field_names} ||= '';
355 my $field_name = $field->name;
356 debug("PKG: Looking at field '$field_name'\n");
357 my $field_def = "$qf$field_name$qf";
360 my $data_type = $field->data_type;
361 my @size = $field->size;
362 my %extra = $field->extra;
363 my $list = $extra{'list'} || [];
364 # \todo deal with embedded quotes
365 my $commalist = join( ', ', map { qq['$_'] } @$list );
366 my $charset = $extra{'mysql_charset'};
367 my $collate = $extra{'mysql_collate'};
370 # Oracle "number" type -- figure best MySQL type
372 if ( lc $data_type eq 'number' ) {
374 if ( scalar @size > 1 ) {
375 $data_type = 'double';
377 elsif ( $size[0] && $size[0] >= 12 ) {
378 $data_type = 'bigint';
380 elsif ( $size[0] && $size[0] <= 1 ) {
381 $data_type = 'tinyint';
388 # Convert a large Oracle varchar to "text"
390 elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
394 elsif ( $data_type =~ /boolean/i ) {
396 $commalist = "'0','1'";
398 elsif ( exists $translate{ lc $data_type } ) {
399 $data_type = $translate{ lc $data_type };
402 @size = () if $data_type =~ /(text|blob)/i;
404 if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
408 $field_def .= " $data_type";
410 if ( lc $data_type eq 'enum' ) {
411 $field_def .= '(' . $commalist . ')';
413 elsif ( defined $size[0] && $size[0] > 0 ) {
414 $field_def .= '(' . join( ', ', @size ) . ')';
418 $field_def .= " CHARACTER SET $charset" if $charset;
419 $field_def .= " COLLATE $collate" if $collate;
422 for my $qual ( qw[ binary unsigned zerofill ] ) {
423 my $val = $extra{ $qual } || $extra{ uc $qual } or next;
424 $field_def .= " $qual";
426 for my $qual ( 'character set', 'collate', 'on update' ) {
427 my $val = $extra{ $qual } || $extra{ uc $qual } or next;
428 $field_def .= " $qual $val";
432 $field_def .= ' NOT NULL' unless $field->is_nullable;
434 # Default? XXX Need better quoting!
435 my $default = $field->default_value;
436 if ( defined $default ) {
437 if ( uc $default eq 'NULL') {
438 $field_def .= ' DEFAULT NULL';
440 $field_def .= " DEFAULT '$default'";
444 if ( my $comments = $field->comments ) {
445 $field_def .= qq[ comment '$comments'];
449 $field_def .= " auto_increment" if $field->is_auto_increment;
454 sub alter_create_index
456 my ($index, $options) = @_;
458 my $qt = $options->{quote_table_names} || '';
459 my $qf = $options->{quote_field_names} || '';
463 $qt.$index->table->name.$qt,
471 my ($index, $options) = @_;
473 my $qf = $options->{quote_field_names} || '';
476 lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
478 '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
485 my ($index, $options) = @_;
487 my $qt = $options->{quote_table_names} || '';
488 my $qf = $options->{quote_field_names} || '';
492 $qt.$index->table->name.$qt,
495 $index->name || $index->fields
500 sub alter_drop_constraint
502 my ($c, $options) = @_;
504 my $qt = $options->{quote_table_names} || '';
505 my $qc = $options->{quote_constraint_names} || '';
507 my $out = sprintf('ALTER TABLE %s DROP %s %s',
508 $qt . $c->table->name . $qt,
509 $c->type eq FOREIGN_KEY ? $c->type : "INDEX",
510 $qc . $c->name . $qc );
515 sub alter_create_constraint
517 my ($index, $options) = @_;
519 my $qt = $options->{quote_table_names} || '';
522 $qt.$index->table->name.$qt,
524 create_constraint(@_) );
527 sub create_constraint
529 my ($c, $options) = @_;
531 my $qf = $options->{quote_field_names} || '';
532 my $qt = $options->{quote_table_names} || '';
533 my $qc = $options->{quote_constraint_names} || '';
534 my $leave_name = $options->{leave_name} || undef;
536 my @fields = $c->fields or next;
538 if ( $c->type eq PRIMARY_KEY ) {
539 return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
541 elsif ( $c->type eq UNIQUE ) {
544 (defined $c->name ? $qf.$c->name.$qf.' ' : '').
545 '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
547 elsif ( $c->type eq FOREIGN_KEY ) {
549 # Make sure FK field is indexed or MySQL complains.
552 my $table = $c->table;
553 my $c_name = $c->name;
563 $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
565 $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
567 my @rfields = map { $_ || () } $c->reference_fields;
568 unless ( @rfields ) {
569 my $rtable_name = $c->reference_table;
570 if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
571 push @rfields, $ref_table->primary_key;
574 warn "Can't find reference table '$rtable_name' " .
575 "in schema\n" if $options->{show_warnings};
580 $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
583 warn "FK constraint on " . $table->name . '.' .
584 join('', @fields) . " has no reference fields\n"
585 if $options->{show_warnings};
588 if ( $c->match_type ) {
590 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
593 if ( $c->on_delete ) {
594 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
597 if ( $c->on_update ) {
598 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
608 my ($to_table, $options) = @_;
610 my $qt = $options->{quote_table_names} || '';
612 my $table_options = generate_table_options($to_table) || '';
613 my $out = sprintf('ALTER TABLE %s%s',
614 $qt . $to_table->name . $qt,
620 sub rename_field { alter_field(@_) }
623 my ($from_field, $to_field, $options) = @_;
625 my $qf = $options->{quote_field_names} || '';
626 my $qt = $options->{quote_table_names} || '';
628 my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
629 $qt . $to_field->table->name . $qt,
630 $qf . $from_field->name . $qf,
631 create_field($to_field, $options));
638 my ($new_field, $options) = @_;
640 my $qt = $options->{quote_table_names} || '';
642 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
643 $qt . $new_field->table->name . $qt,
644 create_field($new_field, $options));
652 my ($old_field, $options) = @_;
654 my $qf = $options->{quote_field_names} || '';
655 my $qt = $options->{quote_table_names} || '';
657 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
658 $qt . $old_field->table->name . $qt,
659 $qf . $old_field->name . $qf);
665 sub batch_alter_table {
666 my ($table, $diff_hash, $options) = @_;
668 # InnoDB has an issue with dropping and re-adding a FK constraint under the
669 # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
671 # We have to work round this.
674 my %fks_to_drop = map {
675 $_->type eq FOREIGN_KEY
678 } @{$diff_hash->{alter_drop_constraint} };
680 my %fks_to_create = map {
681 if ( $_->type eq FOREIGN_KEY) {
682 $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
685 } @{$diff_hash->{alter_create_constraint} };
688 if (scalar keys %fks_to_alter) {
689 $diff_hash->{alter_drop_constraint} = [
690 grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
693 $drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options)
699 if (@{ $diff_hash->{$_} || [] }) {
700 my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
701 map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
704 alter_drop_constraint
711 alter_create_constraint
714 # rename_table makes things a bit more complex
715 my $renamed_from = "";
716 $renamed_from = $diff_hash->{rename_table}[0][0]->name
717 if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
719 return unless @stmts;
720 # Just zero or one stmts. return now
721 return "$drop_stmt@stmts;" unless @stmts > 1;
723 # Now strip off the 'ALTER TABLE xyz' of all but the first one
725 my $qt = $options->{quote_table_names} || '';
726 my $table_name = $qt . $table->name . $qt;
729 my $re = $renamed_from
730 ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$qt$renamed_from$qt\E) /
731 : qr/^ALTER TABLE \Q$table_name\E /;
733 my $first = shift @stmts;
734 my ($alter_table) = $first =~ /($re)/;
736 my $padd = " " x length($alter_table);
738 return $drop_stmt . join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts) . ';';
743 my ($table, $options) = @_;
745 my $qt = $options->{quote_table_names} || '';
747 # Drop (foreign key) constraints so table drops cleanly
748 my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
750 return join("\n", @sql, "DROP TABLE $qt$table$qt;");
755 my ($old_table, $new_table, $options) = @_;
757 my $qt = $options->{quote_table_names} || '';
759 return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
762 sub next_unused_name {
763 my $name = shift || '';
764 if ( !defined($used_names{$name}) ) {
765 $used_names{$name} = $name;
770 while ( defined($used_names{$name . '_' . $i}) ) {
774 $used_names{$name} = $name;
780 # -------------------------------------------------------------------
786 SQL::Translator, http://www.mysql.com/.
790 darren chamberlain E<lt>darren@cpan.orgE<gt>,
791 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.