lib/SQL/Translator/Producer/MySQL.pm

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