Allow passing an arrayref to SQLT->filename
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / MySQL.pm
1 package SQL::Translator::Producer::MySQL;
2
3 =head1 NAME
4
5 SQL::Translator::Producer::MySQL - MySQL-specific producer for SQL::Translator
6
7 =head1 SYNOPSIS
8
9 Use via SQL::Translator:
10
11   use SQL::Translator;
12
13   my $t = SQL::Translator->new( parser => '...', producer => 'MySQL', '...' );
14   $t->translate;
15
16 =head1 DESCRIPTION
17
18 This module will produce text output of the schema suitable for MySQL.
19 There are still some issues to be worked out with syntax differences
20 between MySQL versions 3 and 4 ("SET foreign_key_checks," character sets
21 for fields, etc.).
22
23 =head1 ARGUMENTS
24
25 This producer takes a single optional producer_arg C<mysql_version>, which
26 provides the desired version for the target database. By default MySQL v3 is
27 assumed, and statements pertaining to any features introduced in later versions
28 (e.g. CREATE VIEW) are not produced.
29
30 Valid version specifiers for C<mysql_version> are listed L<here|SQL::Translator::Utils/parse_mysql_version>
31
32 =head2 Table Types
33
34 Normally the tables will be created without any explicit table type given and
35 so will use the MySQL default.
36
37 Any tables involved in foreign key constraints automatically get a table type
38 of InnoDB, unless this is overridden by setting the C<mysql_table_type> extra
39 attribute explicitly on the table.
40
41 =head2 Extra attributes.
42
43 The producer recognises the following extra attributes on the Schema objects.
44
45 =over 4
46
47 =item B<field.list>
48
49 Set the list of allowed values for Enum fields.
50
51 =item B<field.binary>, B<field.unsigned>, B<field.zerofill>
52
53 Set the MySQL field options of the same name.
54
55 =item B<field.renamed_from>, B<table.renamed_from>
56
57 Use when producing diffs to indicate that the current table/field has been
58 renamed from the old name as given in the attribute value.
59
60 =item B<table.mysql_table_type>
61
62 Set the type of the table e.g. 'InnoDB', 'MyISAM'. This will be
63 automatically set for tables involved in foreign key constraints if it is
64 not already set explicitly. See L<"Table Types">.
65
66 Please note that the C<ENGINE> option is the preferred method of specifying
67 the MySQL storage engine to use, but this method still works for backwards
68 compatibility.
69
70 =item B<table.mysql_charset>, B<table.mysql_collate>
71
72 Set the tables default charater set and collation order.
73
74 =item B<field.mysql_charset>, B<field.mysql_collate>
75
76 Set the fields charater set and collation order.
77
78 =back
79
80 =cut
81
82 use strict;
83 use warnings;
84 our ( $DEBUG, %used_names );
85 our $VERSION = '1.59';
86 $DEBUG   = 0 unless defined $DEBUG;
87
88 # Maximum length for most identifiers is 64, according to:
89 #   http://dev.mysql.com/doc/refman/4.1/en/identifiers.html
90 #   http://dev.mysql.com/doc/refman/5.0/en/identifiers.html
91 my $DEFAULT_MAX_ID_LENGTH = 64;
92
93 use Data::Dumper;
94 use SQL::Translator::Schema::Constants;
95 use SQL::Translator::Utils qw(debug header_comment
96     truncate_id_uniquely parse_mysql_version);
97
98 #
99 # Use only lowercase for the keys (e.g. "long" and not "LONG")
100 #
101 my %translate  = (
102     #
103     # Oracle types
104     #
105     varchar2   => 'varchar',
106     long       => 'text',
107     clob       => 'longtext',
108
109     #
110     # Sybase types
111     #
112     int        => 'integer',
113     money      => 'float',
114     real       => 'double',
115     comment    => 'text',
116     bit        => 'tinyint',
117
118     #
119     # Access types
120     #
121     'long integer' => 'integer',
122     'text'         => 'text',
123     'datetime'     => 'datetime',
124
125     #
126     # PostgreSQL types
127     #
128     bytea => 'BLOB',
129 );
130
131 #
132 # Column types that do not support lenth attribute
133 #
134 my @no_length_attr = qw/
135   date time timestamp datetime year
136   /;
137
138
139 sub preprocess_schema {
140     my ($schema) = @_;
141
142     # extra->{mysql_table_type} used to be the type. It belongs in options, so
143     # move it if we find it. Return Engine type if found in extra or options
144     # Similarly for mysql_charset and mysql_collate
145     my $extra_to_options = sub {
146       my ($table, $extra_name, $opt_name) = @_;
147
148       my $extra = $table->extra;
149
150       my $extra_type = delete $extra->{$extra_name};
151
152       # Now just to find if there is already an Engine or Type option...
153       # and lets normalize it to ENGINE since:
154       #
155       # The ENGINE table option specifies the storage engine for the table.
156       # TYPE is a synonym, but ENGINE is the preferred option name.
157       #
158
159       # We have to use the hash directly here since otherwise there is no way
160       # to remove options.
161       my $options = ( $table->{options} ||= []);
162
163       # If multiple option names, normalize to the first one
164       if (ref $opt_name) {
165         OPT_NAME: for ( @$opt_name[1..$#$opt_name] ) {
166           for my $idx ( 0..$#{$options} ) {
167             my ($key, $value) = %{ $options->[$idx] };
168
169             if (uc $key eq $_) {
170               $options->[$idx] = { $opt_name->[0] => $value };
171               last OPT_NAME;
172             }
173           }
174         }
175         $opt_name = $opt_name->[0];
176
177       }
178
179
180       # This assumes that there isn't both a Type and an Engine option.
181       OPTION:
182       for my $idx ( 0..$#{$options} ) {
183         my ($key, $value) = %{ $options->[$idx] };
184
185         next unless uc $key eq $opt_name;
186
187         # make sure case is right on option name
188         delete $options->[$idx]{$key};
189         return $options->[$idx]{$opt_name} = $value || $extra_type;
190
191       }
192
193       if ($extra_type) {
194         push @$options, { $opt_name => $extra_type };
195         return $extra_type;
196       }
197
198     };
199
200     # Names are only specific to a given schema
201     local %used_names = ();
202
203     #
204     # Work out which tables need to be InnoDB to support foreign key
205     # constraints. We do this first as we need InnoDB at both ends.
206     #
207     foreach my $table ( $schema->get_tables ) {
208
209         $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE'] );
210         $extra_to_options->($table, 'mysql_charset', 'CHARACTER SET' );
211         $extra_to_options->($table, 'mysql_collate', 'COLLATE' );
212
213         foreach my $c ( $table->get_constraints ) {
214             next unless $c->type eq FOREIGN_KEY;
215
216             # Normalize constraint names here.
217             my $c_name = $c->name;
218             # Give the constraint a name if it doesn't have one, so it doens't feel
219             # left out
220             $c_name   = $table->name . '_fk' unless length $c_name;
221
222             $c->name( next_unused_name($c_name) );
223
224             for my $meth (qw/table reference_table/) {
225                 my $table = $schema->get_table($c->$meth) || next;
226                 # This normalizes the types to ENGINE and returns the value if its there
227                 next if $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE']);
228                 $table->options( { 'ENGINE' => 'InnoDB' } );
229             }
230         } # foreach constraints
231
232         my %map = ( mysql_collate => 'collate', mysql_charset => 'character set');
233         foreach my $f ( $table->get_fields ) {
234           my $extra = $f->extra;
235           for (keys %map) {
236             $extra->{$map{$_}} = delete $extra->{$_} if exists $extra->{$_};
237           }
238
239           my @size = $f->size;
240           if ( !$size[0] && $f->data_type =~ /char$/ ) {
241             $f->size( (255) );
242           }
243         }
244
245     }
246 }
247
248 sub produce {
249     my $translator     = shift;
250     local $DEBUG       = $translator->debug;
251     local %used_names;
252     my $no_comments    = $translator->no_comments;
253     my $add_drop_table = $translator->add_drop_table;
254     my $schema         = $translator->schema;
255     my $show_warnings  = $translator->show_warnings || 0;
256     my $producer_args  = $translator->producer_args;
257     my $mysql_version  = parse_mysql_version ($producer_args->{mysql_version}, 'perl') || 0;
258     my $max_id_length  = $producer_args->{mysql_max_id_length} || $DEFAULT_MAX_ID_LENGTH;
259
260     my ($qt, $qf, $qc) = ('','', '');
261     $qt = '`' if $translator->quote_table_names;
262     $qf = '`' if $translator->quote_field_names;
263
264     debug("PKG: Beginning production\n");
265     %used_names = ();
266     my $create = '';
267     $create .= header_comment unless ($no_comments);
268     # \todo Don't set if MySQL 3.x is set on command line
269     my @create = "SET foreign_key_checks=0";
270
271     preprocess_schema($schema);
272
273     #
274     # Generate sql
275     #
276     my @table_defs =();
277
278     for my $table ( $schema->get_tables ) {
279 #        print $table->name, "\n";
280         push @table_defs, create_table($table,
281                                        { add_drop_table    => $add_drop_table,
282                                          show_warnings     => $show_warnings,
283                                          no_comments       => $no_comments,
284                                          quote_table_names => $qt,
285                                          quote_field_names => $qf,
286                                          max_id_length     => $max_id_length,
287                                          mysql_version     => $mysql_version
288                                          });
289     }
290
291     if ($mysql_version >= 5.000001) {
292       for my $view ( $schema->get_views ) {
293         push @table_defs, create_view($view,
294                                        { add_replace_view  => $add_drop_table,
295                                          show_warnings     => $show_warnings,
296                                          no_comments       => $no_comments,
297                                          quote_table_names => $qt,
298                                          quote_field_names => $qf,
299                                          max_id_length     => $max_id_length,
300                                          mysql_version     => $mysql_version
301                                          });
302       }
303     }
304
305     if ($mysql_version >= 5.000002) {
306       for my $trigger ( $schema->get_triggers ) {
307         push @table_defs, create_trigger($trigger,
308                                          { add_drop_trigger  => $add_drop_table,
309                                            show_warnings        => $show_warnings,
310                                            no_comments          => $no_comments,
311                                            quote_table_names    => $qt,
312                                            quote_field_names    => $qf,
313                                            max_id_length        => $max_id_length,
314                                            mysql_version        => $mysql_version
315                                            });
316       }
317     }
318
319
320 #    print "@table_defs\n";
321     push @table_defs, "SET foreign_key_checks=1";
322
323     return wantarray ? ($create ? $create : (), @create, @table_defs) : ($create . join('', map { $_ ? "$_;\n\n" : () } (@create, @table_defs)));
324 }
325
326 sub create_trigger {
327     my ($trigger, $options) = @_;
328     my $qt = $options->{quote_table_names} || '';
329     my $qf = $options->{quote_field_names} || '';
330
331     my $trigger_name = $trigger->name;
332     debug("PKG: Looking at trigger '${trigger_name}'\n");
333
334     my @statements;
335
336     my $events = $trigger->database_events;
337     for my $event ( @$events ) {
338         my $name = $trigger_name;
339         if (@$events > 1) {
340             $name .= "_$event";
341
342             warn "Multiple database events supplied for trigger '${trigger_name}', ",
343                 "creating trigger '${name}'  for the '${event}' event\n"
344                     if $options->{show_warnings};
345         }
346
347         my $action = $trigger->action;
348         $action .= ";" unless $action =~ /;\s*\z/;
349
350         push @statements, "DROP TRIGGER IF EXISTS ${qt}${name}${qt}" if $options->{add_drop_trigger};
351         push @statements, sprintf(
352             "CREATE TRIGGER ${qt}%s${qt} %s %s ON ${qt}%s${qt}\n  FOR EACH ROW BEGIN %s END",
353             $name, $trigger->perform_action_when, $event, $trigger->on_table, $action,
354         );
355
356     }
357     # Tack the comment onto the first statement
358     $statements[0] = "--\n-- Trigger ${qt}${trigger_name}${qt}\n--\n" . $statements[0] unless $options->{no_comments};
359     return @statements;
360 }
361
362 sub create_view {
363     my ($view, $options) = @_;
364     my $qt = $options->{quote_table_names} || '';
365     my $qf = $options->{quote_field_names} || '';
366
367     my $view_name = $view->name;
368     debug("PKG: Looking at view '${view_name}'\n");
369
370     # Header.  Should this look like what mysqldump produces?
371     my $create = '';
372     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n" unless $options->{no_comments};
373     $create .= 'CREATE';
374     $create .= ' OR REPLACE' if $options->{add_replace_view};
375     $create .= "\n";
376
377     my $extra = $view->extra;
378     # ALGORITHM
379     if( exists($extra->{mysql_algorithm}) && defined(my $algorithm = $extra->{mysql_algorithm}) ){
380       $create .= "   ALGORITHM = ${algorithm}\n" if $algorithm =~ /(?:UNDEFINED|MERGE|TEMPTABLE)/i;
381     }
382     # DEFINER
383     if( exists($extra->{mysql_definer}) && defined(my $user = $extra->{mysql_definer}) ){
384       $create .= "   DEFINER = ${user}\n";
385     }
386     # SECURITY
387     if( exists($extra->{mysql_security}) && defined(my $security = $extra->{mysql_security}) ){
388       $create .= "   SQL SECURITY ${security}\n" if $security =~ /(?:DEFINER|INVOKER)/i;
389     }
390
391     #Header, cont.
392     $create .= "  VIEW ${qt}${view_name}${qt}";
393
394     if( my @fields = $view->fields ){
395       my $list = join ', ', map { "${qf}${_}${qf}"} @fields;
396       $create .= " ( ${list} )";
397     }
398     if( my $sql = $view->sql ){
399       # do not wrap parenthesis around the selector, mysql doesn't like this
400       # http://bugs.mysql.com/bug.php?id=9198
401       $create .= " AS\n    ${sql}\n";
402     }
403 #    $create .= "";
404     return $create;
405 }
406
407 sub create_table
408 {
409     my ($table, $options) = @_;
410
411     my $qt = $options->{quote_table_names} || '';
412     my $qf = $options->{quote_field_names} || '';
413
414     my $table_name = quote_table_name($table->name, $qt);
415     debug("PKG: Looking at table '$table_name'\n");
416
417     #
418     # Header.  Should this look like what mysqldump produces?
419     #
420     my $create = '';
421     my $drop;
422     $create .= "--\n-- Table: $table_name\n--\n" unless $options->{no_comments};
423     $drop = qq[DROP TABLE IF EXISTS $table_name] if $options->{add_drop_table};
424     $create .= "CREATE TABLE $table_name (\n";
425
426     #
427     # Fields
428     #
429     my @field_defs;
430     for my $field ( $table->get_fields ) {
431         push @field_defs, create_field($field, $options);
432     }
433
434     #
435     # Indices
436     #
437     my @index_defs;
438     my %indexed_fields;
439     for my $index ( $table->get_indices ) {
440         push @index_defs, create_index($index, $options);
441         $indexed_fields{ $_ } = 1 for $index->fields;
442     }
443
444     #
445     # Constraints -- need to handle more than just FK. -ky
446     #
447     my @constraint_defs;
448     my @constraints = $table->get_constraints;
449     for my $c ( @constraints ) {
450         my $constr = create_constraint($c, $options);
451         push @constraint_defs, $constr if($constr);
452
453          unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
454              push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
455              $indexed_fields{ ($c->fields())[0] } = 1;
456          }
457     }
458
459     $create .= join(",\n", map { "  $_" }
460                     @field_defs, @index_defs, @constraint_defs
461                     );
462
463     #
464     # Footer
465     #
466     $create .= "\n)";
467     $create .= generate_table_options($table, $options) || '';
468 #    $create .= ";\n\n";
469
470     return $drop ? ($drop,$create) : $create;
471 }
472
473 sub quote_table_name {
474   my ($table_name, $qt) = @_;
475
476   $table_name =~ s/\./$qt.$qt/g;
477
478   return "$qt$table_name$qt";
479 }
480
481 sub generate_table_options
482 {
483   my ($table, $options) = @_;
484   my $create;
485
486   my $table_type_defined = 0;
487   my $qf               = $options->{quote_field_names} ||= '';
488   my $charset          = $table->extra('mysql_charset');
489   my $collate          = $table->extra('mysql_collate');
490   my $union            = undef;
491   for my $t1_option_ref ( $table->options ) {
492     my($key, $value) = %{$t1_option_ref};
493     $table_type_defined = 1
494       if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
495     if (uc $key eq 'CHARACTER SET') {
496       $charset = $value;
497       next;
498     } elsif (uc $key eq 'COLLATE') {
499       $collate = $value;
500       next;
501     } elsif (uc $key eq 'UNION') {
502       $union = "($qf". join("$qf, $qf", @$value) ."$qf)";
503       next;
504     }
505     $create .= " $key=$value";
506   }
507
508   my $mysql_table_type = $table->extra('mysql_table_type');
509   $create .= " ENGINE=$mysql_table_type"
510     if $mysql_table_type && !$table_type_defined;
511   my $comments         = $table->comments;
512
513   $create .= " DEFAULT CHARACTER SET $charset" if $charset;
514   $create .= " COLLATE $collate" if $collate;
515   $create .= " UNION=$union" if $union;
516   $create .= qq[ comment='$comments'] if $comments;
517   return $create;
518 }
519
520 sub create_field
521 {
522     my ($field, $options) = @_;
523
524     my $qf = $options->{quote_field_names} ||= '';
525
526     my $field_name = $field->name;
527     debug("PKG: Looking at field '$field_name'\n");
528     my $field_def = "$qf$field_name$qf";
529
530     # data type and size
531     my $data_type = $field->data_type;
532     my @size      = $field->size;
533     my %extra     = $field->extra;
534     my $list      = $extra{'list'} || [];
535     # \todo deal with embedded quotes
536     my $commalist = join( ', ', map { qq['$_'] } @$list );
537     my $charset = $extra{'mysql_charset'};
538     my $collate = $extra{'mysql_collate'};
539
540     my $mysql_version = $options->{mysql_version} || 0;
541     #
542     # Oracle "number" type -- figure best MySQL type
543     #
544     if ( lc $data_type eq 'number' ) {
545         # not an integer
546         if ( scalar @size > 1 ) {
547             $data_type = 'double';
548         }
549         elsif ( $size[0] && $size[0] >= 12 ) {
550             $data_type = 'bigint';
551         }
552         elsif ( $size[0] && $size[0] <= 1 ) {
553             $data_type = 'tinyint';
554         }
555         else {
556             $data_type = 'int';
557         }
558     }
559     #
560     # Convert a large Oracle varchar to "text"
561     # (not necessary as of 5.0.3 http://dev.mysql.com/doc/refman/5.0/en/char.html)
562     #
563     elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
564         unless ($size[0] <= 65535 && $mysql_version >= 5.000003 ) {
565             $data_type = 'text';
566             @size      = ();
567         }
568     }
569     elsif ( $data_type =~ /boolean/i ) {
570         if ($mysql_version >= 4) {
571             $data_type = 'boolean';
572         } else {
573             $data_type = 'enum';
574             $commalist = "'0','1'";
575         }
576     }
577     elsif ( exists $translate{ lc $data_type } ) {
578         $data_type = $translate{ lc $data_type };
579     }
580
581     @size = () if $data_type =~ /(text|blob)/i;
582
583     if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
584         push @size, '0';
585     }
586
587     $field_def .= " $data_type";
588
589     if ( lc($data_type) eq 'enum' || lc($data_type) eq 'set') {
590         $field_def .= '(' . $commalist . ')';
591     }
592     elsif (
593         defined $size[0] && $size[0] > 0
594         &&
595         ! grep lc($data_type) eq $_, @no_length_attr
596     ) {
597         $field_def .= '(' . join( ', ', @size ) . ')';
598     }
599
600     # char sets
601     $field_def .= " CHARACTER SET $charset" if $charset;
602     $field_def .= " COLLATE $collate" if $collate;
603
604     # MySQL qualifiers
605     for my $qual ( qw[ binary unsigned zerofill ] ) {
606         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
607         $field_def .= " $qual";
608     }
609     for my $qual ( 'character set', 'collate', 'on update' ) {
610         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
611         $field_def .= " $qual $val";
612     }
613
614     # Null?
615     if ( $field->is_nullable ) {
616         $field_def .= ' NULL';
617     }
618     else {
619         $field_def .= ' NOT NULL';
620     }
621
622     # Default?
623     SQL::Translator::Producer->_apply_default_value(
624       $field,
625       \$field_def,
626       [
627         'NULL'       => \'NULL',
628       ],
629     );
630
631     if ( my $comments = $field->comments ) {
632         $field_def .= qq[ comment '$comments'];
633     }
634
635     # auto_increment?
636     $field_def .= " auto_increment" if $field->is_auto_increment;
637
638     return $field_def;
639 }
640
641 sub alter_create_index
642 {
643     my ($index, $options) = @_;
644
645     my $qt = $options->{quote_table_names} || '';
646     my $qf = $options->{quote_field_names} || '';
647     my $table_name = quote_table_name($index->table->name, $qt);
648     return join( ' ',
649                  'ALTER TABLE',
650                  $table_name,
651                  'ADD',
652                  create_index(@_)
653                  );
654 }
655
656 sub create_index
657 {
658     my ( $index, $options ) = @_;
659
660     my $qf = $options->{quote_field_names} || '';
661
662     return join(
663         ' ',
664         map { $_ || () }
665         lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
666         $index->name
667         ? $qf . truncate_id_uniquely(
668                 $index->name,
669                 $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH
670           ) . $qf
671         : '',
672         '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
673     );
674 }
675
676 sub alter_drop_index
677 {
678     my ($index, $options) = @_;
679
680     my $qt = $options->{quote_table_names} || '';
681     my $qf = $options->{quote_field_names} || '';
682     my $table_name = quote_table_name($index->table->name, $qt);
683
684     return join( ' ',
685                  'ALTER TABLE',
686                  $table_name,
687                  'DROP',
688                  'INDEX',
689                  $index->name || $index->fields
690                  );
691
692 }
693
694 sub alter_drop_constraint
695 {
696     my ($c, $options) = @_;
697
698     my $qt      = $options->{quote_table_names} || '';
699     my $qc      = $options->{quote_field_names} || '';
700     my $table_name = quote_table_name($c->table->name, $qt);
701
702     my @out = ('ALTER','TABLE',$table_name,'DROP');
703     if($c->type eq PRIMARY_KEY) {
704         push @out, $c->type;
705     }
706     else {
707         push @out, ($c->type eq FOREIGN_KEY ? $c->type : "INDEX"),
708             $qc . $c->name . $qc;
709     }
710     return join(' ',@out);
711 }
712
713 sub alter_create_constraint
714 {
715     my ($index, $options) = @_;
716
717     my $qt = $options->{quote_table_names} || '';
718     my $table_name = quote_table_name($index->table->name, $qt);
719     return join( ' ',
720                  'ALTER TABLE',
721                  $table_name,
722                  'ADD',
723                  create_constraint(@_) );
724 }
725
726 sub create_constraint
727 {
728     my ($c, $options) = @_;
729
730     my $qf      = $options->{quote_field_names} || '';
731     my $qt      = $options->{quote_table_names} || '';
732     my $leave_name      = $options->{leave_name} || undef;
733
734     my $reference_table_name = quote_table_name($c->reference_table, $qt);
735
736     my @fields = $c->fields or next;
737
738     if ( $c->type eq PRIMARY_KEY ) {
739         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
740     }
741     elsif ( $c->type eq UNIQUE ) {
742         return sprintf 'UNIQUE %s(%s)',
743           ((defined $c->name && $c->name)
744             ? join ('',
745                 $qf,
746                 truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ),
747                 $qf,
748                 ' '
749               )
750             : ''
751           ),
752           ( join ', ', map { "${qf}${_}${qf}" } @fields ),
753         ;
754     }
755     elsif ( $c->type eq FOREIGN_KEY ) {
756         #
757         # Make sure FK field is indexed or MySQL complains.
758         #
759
760         my $table = $c->table;
761         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
762
763         my $def = join(' ',
764                        map { $_ || () }
765                          'CONSTRAINT',
766                          $qf . $c_name . $qf,
767                          'FOREIGN KEY'
768                       );
769
770
771         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
772
773         $def .= ' REFERENCES ' . $reference_table_name;
774
775         my @rfields = map { $_ || () } $c->reference_fields;
776         unless ( @rfields ) {
777             my $rtable_name = $c->reference_table;
778             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
779                 push @rfields, $ref_table->primary_key;
780             }
781             else {
782                 warn "Can't find reference table '$rtable_name' " .
783                     "in schema\n" if $options->{show_warnings};
784             }
785         }
786
787         if ( @rfields ) {
788             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
789         }
790         else {
791             warn "FK constraint on " . $table->name . '.' .
792                 join('', @fields) . " has no reference fields\n"
793                 if $options->{show_warnings};
794         }
795
796         if ( $c->match_type ) {
797             $def .= ' MATCH ' .
798                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
799         }
800
801         if ( $c->on_delete ) {
802             $def .= ' ON DELETE '. $c->on_delete;
803         }
804
805         if ( $c->on_update ) {
806             $def .= ' ON UPDATE '. $c->on_update;
807         }
808         return $def;
809     }
810
811     return undef;
812 }
813
814 sub alter_table
815 {
816     my ($to_table, $options) = @_;
817
818     my $qt = $options->{quote_table_names} || '';
819
820     my $table_options = generate_table_options($to_table, $options) || '';
821     my $table_name = quote_table_name($to_table->name, $qt);
822     my $out = sprintf('ALTER TABLE %s%s',
823                       $table_name,
824                       $table_options);
825
826     return $out;
827 }
828
829 sub rename_field { alter_field(@_) }
830 sub alter_field
831 {
832     my ($from_field, $to_field, $options) = @_;
833
834     my $qf = $options->{quote_field_names} || '';
835     my $qt = $options->{quote_table_names} || '';
836     my $table_name = quote_table_name($to_field->table->name, $qt);
837
838     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
839                       $table_name,
840                       $qf . $from_field->name . $qf,
841                       create_field($to_field, $options));
842
843     return $out;
844 }
845
846 sub add_field
847 {
848     my ($new_field, $options) = @_;
849
850     my $qt = $options->{quote_table_names} || '';
851     my $table_name = quote_table_name($new_field->table->name, $qt);
852
853     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
854                       $table_name,
855                       create_field($new_field, $options));
856
857     return $out;
858
859 }
860
861 sub drop_field
862 {
863     my ($old_field, $options) = @_;
864
865     my $qf = $options->{quote_field_names} || '';
866     my $qt = $options->{quote_table_names} || '';
867     my $table_name = quote_table_name($old_field->table->name, $qt);
868
869     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
870                       $table_name,
871                       $qf . $old_field->name . $qf);
872
873     return $out;
874
875 }
876
877 sub batch_alter_table {
878   my ($table, $diff_hash, $options) = @_;
879
880   # InnoDB has an issue with dropping and re-adding a FK constraint under the
881   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
882   #
883   # We have to work round this.
884
885   my %fks_to_alter;
886   my %fks_to_drop = map {
887     $_->type eq FOREIGN_KEY
888               ? ( $_->name => $_ )
889               : ( )
890   } @{$diff_hash->{alter_drop_constraint} };
891
892   my %fks_to_create = map {
893     if ( $_->type eq FOREIGN_KEY) {
894       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
895       ( $_->name => $_ );
896     } else { ( ) }
897   } @{$diff_hash->{alter_create_constraint} };
898
899   my @drop_stmt;
900   if (scalar keys %fks_to_alter) {
901     $diff_hash->{alter_drop_constraint} = [
902       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
903     ];
904
905     @drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options);
906
907   }
908
909   my @stmts = map {
910     if (@{ $diff_hash->{$_} || [] }) {
911       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
912       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
913     } else { () }
914   } qw/rename_table
915        alter_drop_constraint
916        alter_drop_index
917        drop_field
918        add_field
919        alter_field
920        rename_field
921        alter_create_index
922        alter_create_constraint
923        alter_table/;
924
925   #quote
926   my $qt = $options->{quote_table_names} || '';
927
928   # rename_table makes things a bit more complex
929   my $renamed_from = "";
930   $renamed_from = quote_table_name($diff_hash->{rename_table}[0][0]->name, $qt)
931     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
932
933   return unless @stmts;
934   # Just zero or one stmts. return now
935   return (@drop_stmt,@stmts) unless @stmts > 1;
936
937   # Now strip off the 'ALTER TABLE xyz' of all but the first one
938
939   my $table_name = quote_table_name($table->name, $qt);
940
941   my $re = $renamed_from
942          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$renamed_from\E) /
943             : qr/^ALTER TABLE \Q$table_name\E /;
944
945   my $first = shift  @stmts;
946   my ($alter_table) = $first =~ /($re)/;
947
948   my $padd = " " x length($alter_table);
949
950   return @drop_stmt, join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts);
951
952 }
953
954 sub drop_table {
955   my ($table, $options) = @_;
956
957     my $qt = $options->{quote_table_names} || '';
958
959   # Drop (foreign key) constraints so table drops cleanly
960   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
961
962   my $table_name = quote_table_name($table, $qt);
963   return (@sql, "DROP TABLE $table");
964
965 }
966
967 sub rename_table {
968   my ($old_table, $new_table, $options) = @_;
969
970   my $qt = $options->{quote_table_names} || '';
971   my $old_table_name = quote_table_name($old_table, $qt);
972   my $new_table_name = quote_table_name($new_table, $qt);
973
974   return "ALTER TABLE $old_table_name RENAME TO $new_table_name";
975 }
976
977 sub next_unused_name {
978   my $name       = shift || '';
979   if ( !defined($used_names{$name}) ) {
980     $used_names{$name} = $name;
981     return $name;
982   }
983
984   my $i = 1;
985   while ( defined($used_names{$name . '_' . $i}) ) {
986     ++$i;
987   }
988   $name .= '_' . $i;
989   $used_names{$name} = $name;
990   return $name;
991 }
992
993 1;
994
995 =pod
996
997 =head1 SEE ALSO
998
999 SQL::Translator, http://www.mysql.com/.
1000
1001 =head1 AUTHORS
1002
1003 darren chamberlain E<lt>darren@cpan.orgE<gt>,
1004 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
1005
1006 =cut