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 };
171 # Work out which tables need to be InnoDB to support foreign key
172 # constraints. We do this first as we need InnoDB at both ends.
174 foreach my $table ( $schema->get_tables ) {
176 $mysql_table_type_to_options->($table);
178 foreach ( $table->get_constraints ) {
179 next unless $_->type eq FOREIGN_KEY;
180 for my $meth (qw/table reference_table/) {
181 my $table = $schema->get_table($_->$meth) || next;
182 next if $mysql_table_type_to_options->($table);
183 $table->options( { 'ENGINE' => 'InnoDB' } );
190 my $translator = shift;
191 local $DEBUG = $translator->debug;
193 my $no_comments = $translator->no_comments;
194 my $add_drop_table = $translator->add_drop_table;
195 my $schema = $translator->schema;
196 my $show_warnings = $translator->show_warnings || 0;
198 my ($qt, $qf) = ('','');
199 $qt = '`' if $translator->quote_table_names;
200 $qf = '`' if $translator->quote_field_names;
202 debug("PKG: Beginning production\n");
205 $create .= header_comment unless ($no_comments);
206 # \todo Don't set if MySQL 3.x is set on command line
207 $create .= "SET foreign_key_checks=0;\n\n";
209 __PACKAGE__->preprocess_schema($schema);
216 for my $table ( $schema->get_tables ) {
217 # print $table->name, "\n";
218 push @table_defs, create_table($table,
219 { add_drop_table => $add_drop_table,
220 show_warnings => $show_warnings,
221 no_comments => $no_comments,
222 quote_table_names => $qt,
223 quote_field_names => $qf
227 # print "@table_defs\n";
228 push @table_defs, "SET foreign_key_checks=1;\n\n";
230 return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
235 my ($table, $options) = @_;
237 my $qt = $options->{quote_table_names} || '';
238 my $qf = $options->{quote_field_names} || '';
240 my $table_name = $table->name;
241 debug("PKG: Looking at table '$table_name'\n");
244 # Header. Should this look like what mysqldump produces?
248 $create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
249 $drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
250 $create .= "CREATE TABLE $qt$table_name$qt (\n";
256 for my $field ( $table->get_fields ) {
257 push @field_defs, create_field($field, $options);
265 for my $index ( $table->get_indices ) {
266 push @index_defs, create_index($index, $options);
267 $indexed_fields{ $_ } = 1 for $index->fields;
271 # Constraints -- need to handle more than just FK. -ky
274 my @constraints = $table->get_constraints;
275 for my $c ( @constraints ) {
276 my $constr = create_constraint($c, $options);
277 push @constraint_defs, $constr if($constr);
279 unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
280 push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
281 $indexed_fields{ ($c->fields())[0] } = 1;
285 $create .= join(",\n", map { " $_" }
286 @field_defs, @index_defs, @constraint_defs
293 $create .= generate_table_options($table) || '';
296 return $drop ? ($drop,$create) : $create;
299 sub generate_table_options
304 my $table_type_defined = 0;
305 for my $t1_option_ref ( $table->options ) {
306 my($key, $value) = %{$t1_option_ref};
307 $table_type_defined = 1
308 if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
309 $create .= " $key=$value";
312 my $mysql_table_type = $table->extra('mysql_table_type');
313 $create .= " ENGINE=$mysql_table_type"
314 if $mysql_table_type && !$table_type_defined;
315 my $charset = $table->extra('mysql_charset');
316 my $collate = $table->extra('mysql_collate');
317 my $comments = $table->comments;
319 $create .= " DEFAULT CHARACTER SET $charset" if $charset;
320 $create .= " COLLATE $collate" if $collate;
321 $create .= qq[ comment='$comments'] if $comments;
327 my ($field, $options) = @_;
329 my $qf = $options->{quote_field_names} ||= '';
331 my $field_name = $field->name;
332 debug("PKG: Looking at field '$field_name'\n");
333 my $field_def = "$qf$field_name$qf";
336 my $data_type = $field->data_type;
337 my @size = $field->size;
338 my %extra = $field->extra;
339 my $list = $extra{'list'} || [];
340 # \todo deal with embedded quotes
341 my $commalist = join( ', ', map { qq['$_'] } @$list );
342 my $charset = $extra{'mysql_charset'};
343 my $collate = $extra{'mysql_collate'};
346 # Oracle "number" type -- figure best MySQL type
348 if ( lc $data_type eq 'number' ) {
350 if ( scalar @size > 1 ) {
351 $data_type = 'double';
353 elsif ( $size[0] && $size[0] >= 12 ) {
354 $data_type = 'bigint';
356 elsif ( $size[0] && $size[0] <= 1 ) {
357 $data_type = 'tinyint';
364 # Convert a large Oracle varchar to "text"
366 elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
370 elsif ( $data_type =~ /char/i && ! $size[0] ) {
373 elsif ( $data_type =~ /boolean/i ) {
375 $commalist = "'0','1'";
377 elsif ( exists $translate{ lc $data_type } ) {
378 $data_type = $translate{ lc $data_type };
381 @size = () if $data_type =~ /(text|blob)/i;
383 if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
387 $field_def .= " $data_type";
389 if ( lc $data_type eq 'enum' ) {
390 $field_def .= '(' . $commalist . ')';
392 elsif ( defined $size[0] && $size[0] > 0 ) {
393 $field_def .= '(' . join( ', ', @size ) . ')';
397 $field_def .= " CHARACTER SET $charset" if $charset;
398 $field_def .= " COLLATE $collate" if $collate;
401 for my $qual ( qw[ binary unsigned zerofill ] ) {
402 my $val = $extra{ $qual } || $extra{ uc $qual } or next;
403 $field_def .= " $qual";
405 for my $qual ( 'character set', 'collate', 'on update' ) {
406 my $val = $extra{ $qual } || $extra{ uc $qual } or next;
407 $field_def .= " $qual $val";
411 $field_def .= ' NOT NULL' unless $field->is_nullable;
413 # Default? XXX Need better quoting!
414 my $default = $field->default_value;
415 if ( defined $default ) {
416 if ( uc $default eq 'NULL') {
417 $field_def .= ' DEFAULT NULL';
419 $field_def .= " DEFAULT '$default'";
423 if ( my $comments = $field->comments ) {
424 $field_def .= qq[ comment '$comments'];
428 $field_def .= " auto_increment" if $field->is_auto_increment;
433 sub alter_create_index
435 my ($index, $options) = @_;
437 my $qt = $options->{quote_table_names} || '';
438 my $qf = $options->{quote_field_names} || '';
442 $qt.$index->table->name.$qt,
450 my ($index, $options) = @_;
452 my $qf = $options->{quote_field_names} || '';
455 lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
457 '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
464 my ($index, $options) = @_;
466 my $qt = $options->{quote_table_names} || '';
467 my $qf = $options->{quote_field_names} || '';
471 $qt.$index->table->name.$qt,
474 $index->name || $index->fields
479 sub alter_drop_constraint
481 my ($c, $options) = @_;
483 my $qt = $options->{quote_table_names} || '';
484 my $qc = $options->{quote_constraint_names} || '';
486 my $out = sprintf('ALTER TABLE %s DROP %s %s',
489 $qc . $c->name . $qc );
494 sub alter_create_constraint
496 my ($index, $options) = @_;
498 my $qt = $options->{quote_table_names} || '';
501 $qt.$index->table->name.$qt,
503 create_constraint(@_) );
506 sub create_constraint
508 my ($c, $options) = @_;
510 my $qf = $options->{quote_field_names} || '';
511 my $qt = $options->{quote_table_names} || '';
512 my $leave_name = $options->{leave_name} || undef;
513 my $counter = ($options->{fk_name_counter} ||= {});
515 my @fields = $c->fields or next;
517 if ( $c->type eq PRIMARY_KEY ) {
518 return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
520 elsif ( $c->type eq UNIQUE ) {
523 (defined $c->name ? $qf.$c->name.$qf.' ' : '').
524 '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
526 elsif ( $c->type eq FOREIGN_KEY ) {
528 # Make sure FK field is indexed or MySQL complains.
531 my $table = $c->table;
532 my $c_name = $c->name;
534 # Give the constraint a name if it doesn't have one, so it doens't feel
537 $c_name = $table->name . '_fk';
540 $counter->{$table} ||= {};
544 $qt . join('_', next_unused_name($c_name)
550 $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
552 $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
554 my @rfields = map { $_ || () } $c->reference_fields;
555 unless ( @rfields ) {
556 my $rtable_name = $c->reference_table;
557 if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
558 push @rfields, $ref_table->primary_key;
561 warn "Can't find reference table '$rtable_name' " .
562 "in schema\n" if $options->{show_warnings};
567 $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
570 warn "FK constraint on " . $table->name . '.' .
571 join('', @fields) . " has no reference fields\n"
572 if $options->{show_warnings};
575 if ( $c->match_type ) {
577 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
580 if ( $c->on_delete ) {
581 $def .= ' ON DELETE '.join( ' ', $c->on_delete );
584 if ( $c->on_update ) {
585 $def .= ' ON UPDATE '.join( ' ', $c->on_update );
595 my ($to_table, $options) = @_;
597 my $qt = $options->{quote_table_name} || '';
599 my $table_options = generate_table_options($to_table) || '';
600 my $out = sprintf('ALTER TABLE %s%s',
601 $qt . $to_table->name . $qt,
607 sub rename_field { alter_field(@_) }
610 my ($from_field, $to_field, $options) = @_;
612 my $qf = $options->{quote_field_name} || '';
613 my $qt = $options->{quote_table_name} || '';
615 my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
616 $qt . $to_field->table->name . $qt,
617 $qf . $from_field->name . $qf,
618 create_field($to_field, $options));
625 my ($new_field, $options) = @_;
627 my $qt = $options->{quote_table_name} || '';
629 my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
630 $qt . $new_field->table->name . $qt,
631 create_field($new_field, $options));
639 my ($old_field, $options) = @_;
641 my $qf = $options->{quote_field_name} || '';
642 my $qt = $options->{quote_table_name} || '';
644 my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
645 $qt . $old_field->table->name . $qt,
646 $qf . $old_field->name . $qf);
652 sub batch_alter_table {
653 my ($table, $diff_hash, $options) = @_;
656 if (@{ $diff_hash->{$_} || [] }) {
657 my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
658 map { $meth->(ref $_ eq 'ARRAY' ? @$_ : $_) } @{ $diff_hash->{$_} }
660 } qw/alter_drop_constraint
667 alter_create_constraint
670 return unless @stmts;
671 # Just zero or one stmts. return now
672 return "@stmts;" unless @stmts > 1;
674 # Now strip off the 'ALTER TABLE xyz' of all but the first one
676 my $qt = $options->{quote_table_name} || '';
677 my $table_name = $qt . $table->name . $qt;
679 my $first = shift @stmts;
680 my ($alter_table) = $first =~ /^(ALTER TABLE \Q$table_name\E )/;
681 my $re = qr/^$alter_table/;
682 my $padd = " " x length($alter_table);
684 return join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts) . ';';
690 # Drop (foreign key) constraints so table drops cleanly
691 my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] });
693 return join("\n", @sql, "DROP TABLE $table;");
697 sub next_unused_name {
698 my $name = shift || '';
699 if ( !defined($used_names{$name}) ) {
700 $used_names{$name} = $name;
705 while ( defined($used_names{$name . '_' . $i}) ) {
709 $used_names{$name} = $name;
715 # -------------------------------------------------------------------
721 SQL::Translator, http://www.mysql.com/.
725 darren chamberlain E<lt>darren@cpan.orgE<gt>,
726 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.