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 # Similarly for mysql_charset and mysql_collate
138 my $extra_to_options = sub {
139 my ($table, $extra_name, $opt_name) = @_;
141 my $extra = $table->extra;
143 my $extra_type = delete $extra->{$extra_name};
145 # Now just to find if there is already an Engine or Type option...
146 # and lets normalize it to ENGINE since:
148 # The ENGINE table option specifies the storage engine for the table.
149 # TYPE is a synonym, but ENGINE is the preferred option name.
152 # We have to use the hash directly here since otherwise there is no way
154 my $options = ( $table->{options} ||= []);
156 # If multiple option names, normalize to the first one
158 OPT_NAME: for ( @$opt_name[1..$#$opt_name] ) {
159 for my $idx ( 0..$#{$options} ) {
160 my ($key, $value) = %{ $options->[$idx] };
163 $options->[$idx] = { $opt_name->[0] => $value };
168 $opt_name = $opt_name->[0];
173 # This assumes that there isn't both a Type and an Engine option.
175 for my $idx ( 0..$#{$options} ) {
176 my ($key, $value) = %{ $options->[$idx] };
178 next unless uc $key eq $opt_name;
180 # make sure case is right on option name
181 delete $options->[$idx]{$key};
182 return $options->[$idx]{$opt_name} = $value || $extra_type;
187 push @$options, { $opt_name => $extra_type };
193 # Names are only specific to a given schema
194 local %used_names = ();
197 # Work out which tables need to be InnoDB to support foreign key
198 # constraints. We do this first as we need InnoDB at both ends.
200 foreach my $table ( $schema->get_tables ) {
202 $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE'] );
203 $extra_to_options->($table, 'mysql_charset', 'CHARACTER SET' );
204 $extra_to_options->($table, 'mysql_collate', 'COLLATE' );
206 foreach my $c ( $table->get_constraints ) {
207 next unless $c->type eq FOREIGN_KEY;
209 # Normalize constraint names here.
210 my $c_name = $c->name;
211 # Give the constraint a name if it doesn't have one, so it doens't feel
213 $c_name = $table->name . '_fk' unless length $c_name;
215 $c->name( next_unused_name($c_name) );
217 for my $meth (qw/table reference_table/) {
218 my $table = $schema->get_table($c->$meth) || next;
219 # This normalizes the types to ENGINE and returns the value if its there
220 next if $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE']);
221 $table->options( { 'ENGINE' => 'InnoDB' } );
223 } # foreach constraints
225 foreach my $f ( $table->get_fields ) {
227 if ( !$size[0] && $f->data_type =~ /char$/ ) {
236 my $translator = shift;
237 local $DEBUG = $translator->debug;
239 my $no_comments = $translator->no_comments;
240 my $add_drop_table = $translator->add_drop_table;
241 my $schema = $translator->schema;
242 my $show_warnings = $translator->show_warnings || 0;
244 my ($qt, $qf, $qc) = ('','', '');
245 $qt = '`' if $translator->quote_table_names;
246 $qf = '`' if $translator->quote_field_names;
248 debug("PKG: Beginning production\n");
251 $create .= header_comment unless ($no_comments);
252 # \todo Don't set if MySQL 3.x is set on command line
253 $create .= "SET foreign_key_checks=0;\n\n";
255 preprocess_schema($schema);
262 for my $table ( $schema->get_tables ) {
263 # print $table->name, "\n";
264 push @table_defs, create_table($table,
265 { add_drop_table => $add_drop_table,
266 show_warnings => $show_warnings,
267 no_comments => $no_comments,
268 quote_table_names => $qt,
269 quote_field_names => $qf
273 # print "@table_defs\n";
274 push @table_defs, "SET foreign_key_checks=1;\n\n";
276 return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
281 my ($table, $options) = @_;
283 my $qt = $options->{quote_table_names} || '';
284 my $qf = $options->{quote_field_names} || '';
286 my $table_name = $table->name;
287 debug("PKG: Looking at table '$table_name'\n");
290 # Header. Should this look like what mysqldump produces?
294 $create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
295 $drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
296 $create .= "CREATE TABLE $qt$table_name$qt (\n";
302 for my $field ( $table->get_fields ) {
303 push @field_defs, create_field($field, $options);
311 for my $index ( $table->get_indices ) {
312 push @index_defs, create_index($index, $options);
313 $indexed_fields{ $_ } = 1 for $index->fields;
317 # Constraints -- need to handle more than just FK. -ky
320 my @constraints = $table->get_constraints;
321 for my $c ( @constraints ) {
322 my $constr = create_constraint($c, $options);
323 push @constraint_defs, $constr if($constr);
325 unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
326 push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
327 $indexed_fields{ ($c->fields())[0] } = 1;
331 $create .= join(",\n", map { " $_" }
332 @field_defs, @index_defs, @constraint_defs
339 $create .= generate_table_options($table) || '';
342 return $drop ? ($drop,$create) : $create;
345 sub generate_table_options
350 my $table_type_defined = 0;
351 my $charset = $table->extra('mysql_charset');
352 my $collate = $table->extra('mysql_collate');
353 for my $t1_option_ref ( $table->options ) {
354 my($key, $value) = %{$t1_option_ref};
355 $table_type_defined = 1
356 if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
357 if (uc $key eq 'CHARACTER SET') {
360 } elsif (uc $key eq 'COLLATE') {
364 $create .= " $key=$value";
367 my $mysql_table_type = $table->extra('mysql_table_type');
368 $create .= " ENGINE=$mysql_table_type"
369 if $mysql_table_type && !$table_type_defined;
370 my $comments = $table->comments;
372 $create .= " DEFAULT CHARACTER SET $charset" if $charset;
373 $create .= " COLLATE $collate" if $collate;
374 $create .= qq[ comment='$comments'] if $comments;
380 my ($field, $options) = @_;
382 my $qf = $options->{quote_field_names} ||= '';
384 my $field_name = $field->name;
385 debug("PKG: Looking at field '$field_name'\n");
386 my $field_def = "$qf$field_name$qf";
389 my $data_type = $field->data_type;
390 my @size = $field->size;
391 my %extra = $field->extra;
392 my $list = $extra{'list'} || [];
393 # \todo deal with embedded quotes
394 my $commalist = join( ', ', map { qq['$_'] } @$list );
395 my $charset = $extra{'mysql_charset'};
396 my $collate = $extra{'mysql_collate'};
399 # Oracle "number" type -- figure best MySQL type
401 if ( lc $data_type eq 'number' ) {
403 if ( scalar @size > 1 ) {
404 $data_type = 'double';
406 elsif ( $size[0] && $size[0] >= 12 ) {
407 $data_type = 'bigint';
409 elsif ( $size[0] && $size[0] <= 1 ) {
410 $data_type = 'tinyint';
417 # Convert a large Oracle varchar to "text"
419 elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
423 elsif ( $data_type =~ /boolean/i ) {
425 $commalist = "'0','1'";
427 elsif ( exists $translate{ lc $data_type } ) {
428 $data_type = $translate{ lc $data_type };
431 @size = () if $data_type =~ /(text|blob)/i;
433 if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
437 $field_def .= " $data_type";
439 if ( lc $data_type eq 'enum' ) {
440 $field_def .= '(' . $commalist . ')';
442 elsif ( defined $size[0] && $size[0] > 0 ) {
443 $field_def .= '(' . join( ', ', @size ) . ')';
447 $field_def .= " CHARACTER SET $charset" if $charset;
448 $field_def .= " COLLATE $collate" if $collate;
451 for my $qual ( qw[ binary unsigned zerofill ] ) {
452 my $val = $extra{ $qual } || $extra{ uc $qual } or next;
453 $field_def .= " $qual";
455 for my $qual ( 'character set', 'collate', 'on update' ) {
456 my $val = $extra{ $qual } || $extra{ uc $qual } or next;
457 $field_def .= " $qual $val";
461 $field_def .= ' NOT NULL' unless $field->is_nullable;
463 # Default? XXX Need better quoting!
464 my $default = $field->default_value;
465 if ( defined $default ) {
466 if ( uc $default eq 'NULL') {
467 $field_def .= ' DEFAULT NULL';
469 $field_def .= " DEFAULT '$default'";
473 if ( my $comments = $field->comments ) {
474 $field_def .= qq[ comment '$comments'];
478 $field_def .= " auto_increment" if $field->is_auto_increment;
483 sub alter_create_index
485 my ($index, $options) = @_;
487 my $qt = $options->{quote_table_names} || '';
488 my $qf = $options->{quote_field_names} || '';
492 $qt.$index->table->name.$qt,
500 my ($index, $options) = @_;
502 my $qf = $options->{quote_field_names} || '';
505 lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
507 '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
514 my ($index, $options) = @_;
516 my $qt = $options->{quote_table_names} || '';
517 my $qf = $options->{quote_field_names} || '';
521 $qt.$index->table->name.$qt,
524 $index->name || $index->fields
529 sub alter_drop_constraint
531 my ($c, $options) = @_;
533 my $qt = $options->{quote_table_names} || '';
534 my $qc = $options->{quote_field_names} || '';
536 my $out = sprintf('ALTER TABLE %s DROP %s %s',
537 $qt . $c->table->name . $qt,
538 $c->type eq FOREIGN_KEY ? $c->type : "INDEX",
539 $qc . $c->name . $qc );
544 sub alter_create_constraint
546 my ($index, $options) = @_;
548 my $qt = $options->{quote_table_names} || '';
551 $qt.$index->table->name.$qt,
553 create_constraint(@_) );
556 sub create_constraint
558 my ($c, $options) = @_;
560 my $qf = $options->{quote_field_names} || '';
561 my $qt = $options->{quote_table_names} || '';
562 my $leave_name = $options->{leave_name} || undef;
564 my @fields = $c->fields or next;
566 if ( $c->type eq PRIMARY_KEY ) {
567 return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
569 elsif ( $c->type eq UNIQUE ) {
572 (defined $c->name ? $qf.$c->name.$qf.' ' : '').
573 '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
575 elsif ( $c->type eq FOREIGN_KEY ) {
577 # Make sure FK field is indexed or MySQL complains.
580 my $table = $c->table;
581 my $c_name = $c->name;
591 $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
593 $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
595 my @rfields = map { $_ || () } $c->reference_fields;
596 unless ( @rfields ) {
597 my $rtable_name = $c->reference_table;
598 if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
599 push @rfields, $ref_table->primary_key;
602 warn "Can't find reference table '$rtable_name' " .
603 "in schema\n" if $options->{show_warnings};
608 $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
611 warn "FK constraint on " . $table->name . '.' .
612 join('', @fields) . " has no reference fields\n"
613 if $options->{show_warnings};
616 if ( $c->match_type ) {
618 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
621 if ( $c->on_delete ) {
622 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
625 if ( $c->on_update ) {
626 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
636 my ($to_table, $options) = @_;
638 my $qt = $options->{quote_table_names} || '';
640 my $table_options = generate_table_options($to_table) || '';
641 my $out = sprintf('ALTER TABLE %s%s',
642 $qt . $to_table->name . $qt,
648 sub rename_field { alter_field(@_) }
651 my ($from_field, $to_field, $options) = @_;
653 my $qf = $options->{quote_field_names} || '';
654 my $qt = $options->{quote_table_names} || '';
656 my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
657 $qt . $to_field->table->name . $qt,
658 $qf . $from_field->name . $qf,
659 create_field($to_field, $options));
666 my ($new_field, $options) = @_;
668 my $qt = $options->{quote_table_names} || '';
670 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
671 $qt . $new_field->table->name . $qt,
672 create_field($new_field, $options));
680 my ($old_field, $options) = @_;
682 my $qf = $options->{quote_field_names} || '';
683 my $qt = $options->{quote_table_names} || '';
685 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
686 $qt . $old_field->table->name . $qt,
687 $qf . $old_field->name . $qf);
693 sub batch_alter_table {
694 my ($table, $diff_hash, $options) = @_;
696 # InnoDB has an issue with dropping and re-adding a FK constraint under the
697 # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
699 # We have to work round this.
702 my %fks_to_drop = map {
703 $_->type eq FOREIGN_KEY
706 } @{$diff_hash->{alter_drop_constraint} };
708 my %fks_to_create = map {
709 if ( $_->type eq FOREIGN_KEY) {
710 $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
713 } @{$diff_hash->{alter_create_constraint} };
716 if (scalar keys %fks_to_alter) {
717 $diff_hash->{alter_drop_constraint} = [
718 grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
721 $drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options)
727 if (@{ $diff_hash->{$_} || [] }) {
728 my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
729 map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
732 alter_drop_constraint
739 alter_create_constraint
742 # rename_table makes things a bit more complex
743 my $renamed_from = "";
744 $renamed_from = $diff_hash->{rename_table}[0][0]->name
745 if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
747 return unless @stmts;
748 # Just zero or one stmts. return now
749 return "$drop_stmt@stmts;" unless @stmts > 1;
751 # Now strip off the 'ALTER TABLE xyz' of all but the first one
753 my $qt = $options->{quote_table_names} || '';
754 my $table_name = $qt . $table->name . $qt;
757 my $re = $renamed_from
758 ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$qt$renamed_from$qt\E) /
759 : qr/^ALTER TABLE \Q$table_name\E /;
761 my $first = shift @stmts;
762 my ($alter_table) = $first =~ /($re)/;
764 my $padd = " " x length($alter_table);
766 return $drop_stmt . join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts) . ';';
771 my ($table, $options) = @_;
773 my $qt = $options->{quote_table_names} || '';
775 # Drop (foreign key) constraints so table drops cleanly
776 my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
778 return join("\n", @sql, "DROP TABLE $qt$table$qt;");
783 my ($old_table, $new_table, $options) = @_;
785 my $qt = $options->{quote_table_names} || '';
787 return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
790 sub next_unused_name {
791 my $name = shift || '';
792 if ( !defined($used_names{$name}) ) {
793 $used_names{$name} = $name;
798 while ( defined($used_names{$name . '_' . $i}) ) {
802 $used_names{$name} = $name;
808 # -------------------------------------------------------------------
814 SQL::Translator, http://www.mysql.com/.
818 darren chamberlain E<lt>darren@cpan.orgE<gt>,
819 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.