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 field.binary, field.unsigned, field.zerofill
64 Set the MySQL field options of the same name.
66 =item field.renamed_from
68 Used when producing diffs to say this column is the new name fo the specified
71 =item 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 =item table.mysql_charset, table.mysql_collate
79 Set the tables default charater set and collation order.
81 =item field.mysql_charset, field.mysql_collate
83 Set the fields charater set and collation order.
91 use vars qw[ $VERSION $DEBUG %used_names ];
92 $VERSION = sprintf "%d.%02d", q$Revision: 1.54 $ =~ /(\d+)\.(\d+)/;
93 $DEBUG = 0 unless defined $DEBUG;
96 use SQL::Translator::Schema::Constants;
97 use SQL::Translator::Utils qw(debug header_comment);
100 # Use only lowercase for the keys (e.g. "long" and not "LONG")
106 varchar2 => 'varchar',
122 'long integer' => 'integer',
124 'datetime' => 'datetime',
128 sub preprocess_schema {
129 my ($class, $schema) = @_;
131 # extra->{mysql_table_type} used to be the type. It belongs in options, so
132 # move it if we find it. Return Engine type if found in extra or options
133 my $mysql_table_type_to_options = sub {
136 my $extra = $table->extra;
138 my $extra_type = delete $extra->{mysql_table_type};
140 # Now just to find if there is already an Engine or Type option...
141 # and lets normalize it to ENGINE since:
143 # The ENGINE table option specifies the storage engine for the table.
144 # TYPE is a synonym, but ENGINE is the preferred option name.
147 # We have to use the hash directly here since otherwise there is no way
149 my $options = ( $table->{options} ||= []);
151 # This assumes that there isn't both a Type and an Engine option.
152 for my $idx ( 0..$#{$options} ) {
153 my ($key, $value) = %{ $options->[$idx] };
155 next unless uc $key eq 'ENGINE' || uc $key eq 'TYPE';
157 # if the extra.mysql_table_type is given, use that
158 delete $options->[$idx]{$key};
159 return $options->[$idx]{ENGINE} = $value || $extra_type;
164 push @$options, { ENGINE => $extra_type };
170 # Names are only specific to a given schema
171 local %used_names = ();
174 # Work out which tables need to be InnoDB to support foreign key
175 # constraints. We do this first as we need InnoDB at both ends.
177 foreach my $table ( $schema->get_tables ) {
179 $mysql_table_type_to_options->($table);
181 foreach my $c ( $table->get_constraints ) {
182 next unless $c->type eq FOREIGN_KEY;
184 # Normalize constraint names here.
185 my $c_name = $c->name;
186 # Give the constraint a name if it doesn't have one, so it doens't feel
188 $c_name = $table->name . '_fk' unless length $c_name;
190 $c->name( next_unused_name($c_name) );
192 for my $meth (qw/table reference_table/) {
193 my $table = $schema->get_table($c->$meth) || next;
194 next if $mysql_table_type_to_options->($table);
195 $table->options( { 'ENGINE' => 'InnoDB' } );
197 } # foreach constraints
199 foreach my $f ( $table->get_fields ) {
201 if ( !$size[0] && $f->data_type =~ /char$/ ) {
210 my $translator = shift;
211 local $DEBUG = $translator->debug;
213 my $no_comments = $translator->no_comments;
214 my $add_drop_table = $translator->add_drop_table;
215 my $schema = $translator->schema;
216 my $show_warnings = $translator->show_warnings || 0;
218 my ($qt, $qf) = ('','');
219 $qt = '`' if $translator->quote_table_names;
220 $qf = '`' if $translator->quote_field_names;
222 debug("PKG: Beginning production\n");
225 $create .= header_comment unless ($no_comments);
226 # \todo Don't set if MySQL 3.x is set on command line
227 $create .= "SET foreign_key_checks=0;\n\n";
229 __PACKAGE__->preprocess_schema($schema);
236 for my $table ( $schema->get_tables ) {
237 # print $table->name, "\n";
238 push @table_defs, create_table($table,
239 { add_drop_table => $add_drop_table,
240 show_warnings => $show_warnings,
241 no_comments => $no_comments,
242 quote_table_names => $qt,
243 quote_field_names => $qf
247 # print "@table_defs\n";
248 push @table_defs, "SET foreign_key_checks=1;\n\n";
250 return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
255 my ($table, $options) = @_;
257 my $qt = $options->{quote_table_names} || '';
258 my $qf = $options->{quote_field_names} || '';
260 my $table_name = $table->name;
261 debug("PKG: Looking at table '$table_name'\n");
264 # Header. Should this look like what mysqldump produces?
268 $create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
269 $drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
270 $create .= "CREATE TABLE $qt$table_name$qt (\n";
276 for my $field ( $table->get_fields ) {
277 push @field_defs, create_field($field, $options);
285 for my $index ( $table->get_indices ) {
286 push @index_defs, create_index($index, $options);
287 $indexed_fields{ $_ } = 1 for $index->fields;
291 # Constraints -- need to handle more than just FK. -ky
294 my @constraints = $table->get_constraints;
295 for my $c ( @constraints ) {
296 my $constr = create_constraint($c, $options);
297 push @constraint_defs, $constr if($constr);
299 unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
300 push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
301 $indexed_fields{ ($c->fields())[0] } = 1;
305 $create .= join(",\n", map { " $_" }
306 @field_defs, @index_defs, @constraint_defs
313 $create .= generate_table_options($table) || '';
316 return $drop ? ($drop,$create) : $create;
319 sub generate_table_options
324 my $table_type_defined = 0;
325 for my $t1_option_ref ( $table->options ) {
326 my($key, $value) = %{$t1_option_ref};
327 $table_type_defined = 1
328 if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
329 $create .= " $key=$value";
332 my $mysql_table_type = $table->extra('mysql_table_type');
333 $create .= " ENGINE=$mysql_table_type"
334 if $mysql_table_type && !$table_type_defined;
335 my $charset = $table->extra('mysql_charset');
336 my $collate = $table->extra('mysql_collate');
337 my $comments = $table->comments;
339 $create .= " DEFAULT CHARACTER SET $charset" if $charset;
340 $create .= " COLLATE $collate" if $collate;
341 $create .= qq[ comment='$comments'] if $comments;
347 my ($field, $options) = @_;
349 my $qf = $options->{quote_field_names} ||= '';
351 my $field_name = $field->name;
352 debug("PKG: Looking at field '$field_name'\n");
353 my $field_def = "$qf$field_name$qf";
356 my $data_type = $field->data_type;
357 my @size = $field->size;
358 my %extra = $field->extra;
359 my $list = $extra{'list'} || [];
360 # \todo deal with embedded quotes
361 my $commalist = join( ', ', map { qq['$_'] } @$list );
362 my $charset = $extra{'mysql_charset'};
363 my $collate = $extra{'mysql_collate'};
366 # Oracle "number" type -- figure best MySQL type
368 if ( lc $data_type eq 'number' ) {
370 if ( scalar @size > 1 ) {
371 $data_type = 'double';
373 elsif ( $size[0] && $size[0] >= 12 ) {
374 $data_type = 'bigint';
376 elsif ( $size[0] && $size[0] <= 1 ) {
377 $data_type = 'tinyint';
384 # Convert a large Oracle varchar to "text"
386 elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
390 elsif ( $data_type =~ /boolean/i ) {
392 $commalist = "'0','1'";
394 elsif ( exists $translate{ lc $data_type } ) {
395 $data_type = $translate{ lc $data_type };
398 @size = () if $data_type =~ /(text|blob)/i;
400 if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
404 $field_def .= " $data_type";
406 if ( lc $data_type eq 'enum' ) {
407 $field_def .= '(' . $commalist . ')';
409 elsif ( defined $size[0] && $size[0] > 0 ) {
410 $field_def .= '(' . join( ', ', @size ) . ')';
414 $field_def .= " CHARACTER SET $charset" if $charset;
415 $field_def .= " COLLATE $collate" if $collate;
418 for my $qual ( qw[ binary unsigned zerofill ] ) {
419 my $val = $extra{ $qual } || $extra{ uc $qual } or next;
420 $field_def .= " $qual";
422 for my $qual ( 'character set', 'collate', 'on update' ) {
423 my $val = $extra{ $qual } || $extra{ uc $qual } or next;
424 $field_def .= " $qual $val";
428 $field_def .= ' NOT NULL' unless $field->is_nullable;
430 # Default? XXX Need better quoting!
431 my $default = $field->default_value;
432 if ( defined $default ) {
433 if ( uc $default eq 'NULL') {
434 $field_def .= ' DEFAULT NULL';
436 $field_def .= " DEFAULT '$default'";
440 if ( my $comments = $field->comments ) {
441 $field_def .= qq[ comment '$comments'];
445 $field_def .= " auto_increment" if $field->is_auto_increment;
450 sub alter_create_index
452 my ($index, $options) = @_;
454 my $qt = $options->{quote_table_names} || '';
455 my $qf = $options->{quote_field_names} || '';
459 $qt.$index->table->name.$qt,
467 my ($index, $options) = @_;
469 my $qf = $options->{quote_field_names} || '';
472 lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
474 '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
481 my ($index, $options) = @_;
483 my $qt = $options->{quote_table_names} || '';
484 my $qf = $options->{quote_field_names} || '';
488 $qt.$index->table->name.$qt,
491 $index->name || $index->fields
496 sub alter_drop_constraint
498 my ($c, $options) = @_;
500 my $qt = $options->{quote_table_names} || '';
501 my $qc = $options->{quote_constraint_names} || '';
503 my $out = sprintf('ALTER TABLE %s DROP %s %s',
506 $qc . $c->name . $qc );
511 sub alter_create_constraint
513 my ($index, $options) = @_;
515 my $qt = $options->{quote_table_names} || '';
518 $qt.$index->table->name.$qt,
520 create_constraint(@_) );
523 sub create_constraint
525 my ($c, $options) = @_;
527 my $qf = $options->{quote_field_names} || '';
528 my $qt = $options->{quote_table_names} || '';
529 my $leave_name = $options->{leave_name} || undef;
531 my @fields = $c->fields or next;
533 if ( $c->type eq PRIMARY_KEY ) {
534 return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
536 elsif ( $c->type eq UNIQUE ) {
539 (defined $c->name ? $qf.$c->name.$qf.' ' : '').
540 '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
542 elsif ( $c->type eq FOREIGN_KEY ) {
544 # Make sure FK field is indexed or MySQL complains.
547 my $table = $c->table;
548 my $c_name = $c->name;
558 $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
560 $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
562 my @rfields = map { $_ || () } $c->reference_fields;
563 unless ( @rfields ) {
564 my $rtable_name = $c->reference_table;
565 if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
566 push @rfields, $ref_table->primary_key;
569 warn "Can't find reference table '$rtable_name' " .
570 "in schema\n" if $options->{show_warnings};
575 $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
578 warn "FK constraint on " . $table->name . '.' .
579 join('', @fields) . " has no reference fields\n"
580 if $options->{show_warnings};
583 if ( $c->match_type ) {
585 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
588 if ( $c->on_delete ) {
589 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
592 if ( $c->on_update ) {
593 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
603 my ($to_table, $options) = @_;
605 my $qt = $options->{quote_table_name} || '';
607 my $table_options = generate_table_options($to_table) || '';
608 my $out = sprintf('ALTER TABLE %s%s',
609 $qt . $to_table->name . $qt,
615 sub rename_field { alter_field(@_) }
618 my ($from_field, $to_field, $options) = @_;
620 my $qf = $options->{quote_field_name} || '';
621 my $qt = $options->{quote_table_name} || '';
623 my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
624 $qt . $to_field->table->name . $qt,
625 $qf . $from_field->name . $qf,
626 create_field($to_field, $options));
633 my ($new_field, $options) = @_;
635 my $qt = $options->{quote_table_name} || '';
637 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
638 $qt . $new_field->table->name . $qt,
639 create_field($new_field, $options));
647 my ($old_field, $options) = @_;
649 my $qf = $options->{quote_field_name} || '';
650 my $qt = $options->{quote_table_name} || '';
652 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
653 $qt . $old_field->table->name . $qt,
654 $qf . $old_field->name . $qf);
660 sub batch_alter_table {
661 my ($table, $diff_hash, $options) = @_;
664 if (@{ $diff_hash->{$_} || [] }) {
665 my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
666 map { $meth->(ref $_ eq 'ARRAY' ? @$_ : $_) } @{ $diff_hash->{$_} }
669 alter_drop_constraint
676 alter_create_constraint
679 # rename_table makes things a bit more complex
680 my $renamed_from = "";
681 $renamed_from = $diff_hash->{rename_table}[0][0]->name
682 if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
684 return unless @stmts;
685 # Just zero or one stmts. return now
686 return "@stmts;" unless @stmts > 1;
688 # Now strip off the 'ALTER TABLE xyz' of all but the first one
690 my $qt = $options->{quote_table_name} || '';
691 my $table_name = $qt . $renamed_from || $table->name . $qt;
693 my $first = shift @stmts;
694 my ($alter_table) = $first =~ /^(ALTER TABLE \Q$table_name\E )/;
696 my $re = qr/^$alter_table/;
697 $re = qr/^ALTER TABLE \Q$qt@{[$table->name]}$qt\E / if $renamed_from;
698 my $padd = " " x length($alter_table);
700 return join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts) . ';';
704 my ($table, $options) = @_;
706 my $qt = $options->{quote_table_names} || '';
708 # Drop (foreign key) constraints so table drops cleanly
709 my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
711 return join("\n", @sql, "DROP TABLE $qt$table$qt;");
716 my ($old_table, $new_table, $options) = @_;
718 my $qt = $options->{quote_table_names} || '';
720 return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
723 sub next_unused_name {
724 my $name = shift || '';
725 if ( !defined($used_names{$name}) ) {
726 $used_names{$name} = $name;
731 while ( defined($used_names{$name . '_' . $i}) ) {
735 $used_names{$name} = $name;
741 # -------------------------------------------------------------------
747 SQL::Translator, http://www.mysql.com/.
751 darren chamberlain E<lt>darren@cpan.orgE<gt>,
752 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.