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 prefered method of specifying
  85 the MySQL storage engine to use, but this method still works for backwards
  86 compatability.
  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       $create .= " AS (\n    ${sql}\n  )";
 368     }
 369 #    $create .= "";
 370     return $create;
 371 }
 372
 373 sub create_table
 374 {
 375     my ($table, $options) = @_;
 376
 377     my $qt = $options->{quote_table_names} || '';
 378     my $qf = $options->{quote_field_names} || '';
 379
 380     my $table_name = quote_table_name($table->name, $qt);
 381     debug("PKG: Looking at table '$table_name'\n");
 382
 383     #
 384     # Header.  Should this look like what mysqldump produces?
 385     #
 386     my $create = '';
 387     my $drop;
 388     $create .= "--\n-- Table: $table_name\n--\n" unless $options->{no_comments};
 389     $drop = qq[DROP TABLE IF EXISTS $table_name] if $options->{add_drop_table};
 390     $create .= "CREATE TABLE $table_name (\n";
 391
 392     #
 393     # Fields
 394     #
 395     my @field_defs;
 396     for my $field ( $table->get_fields ) {
 397         push @field_defs, create_field($field, $options);
 398     }
 399
 400     #
 401     # Indices
 402     #
 403     my @index_defs;
 404     my %indexed_fields;
 405     for my $index ( $table->get_indices ) {
 406         push @index_defs, create_index($index, $options);
 407         $indexed_fields{ $_ } = 1 for $index->fields;
 408     }
 409
 410     #
 411     # Constraints -- need to handle more than just FK. -ky
 412     #
 413     my @constraint_defs;
 414     my @constraints = $table->get_constraints;
 415     for my $c ( @constraints ) {
 416         my $constr = create_constraint($c, $options);
 417         push @constraint_defs, $constr if($constr);
 418
 419          unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
 420              push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
 421              $indexed_fields{ ($c->fields())[0] } = 1;
 422          }
 423     }
 424
 425     $create .= join(",\n", map { "  $_" }
 426                     @field_defs, @index_defs, @constraint_defs
 427                     );
 428
 429     #
 430     # Footer
 431     #
 432     $create .= "\n)";
 433     $create .= generate_table_options($table, $options) || '';
 434 #    $create .= ";\n\n";
 435
 436     return $drop ? ($drop,$create) : $create;
 437 }
 438
 439 sub quote_table_name {
 440   my ($table_name, $qt) = @_;
 441
 442   $table_name =~ s/\./$qt.$qt/g;
 443
 444   return "$qt$table_name$qt";
 445 }
 446
 447 sub generate_table_options
 448 {
 449   my ($table, $options) = @_;
 450   my $create;
 451
 452   my $table_type_defined = 0;
 453   my $qf               = $options->{quote_field_names} ||= '';
 454   my $charset          = $table->extra('mysql_charset');
 455   my $collate          = $table->extra('mysql_collate');
 456   my $union            = undef;
 457   for my $t1_option_ref ( $table->options ) {
 458     my($key, $value) = %{$t1_option_ref};
 459     $table_type_defined = 1
 460       if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
 461     if (uc $key eq 'CHARACTER SET') {
 462       $charset = $value;
 463       next;
 464     } elsif (uc $key eq 'COLLATE') {
 465       $collate = $value;
 466       next;
 467     } elsif (uc $key eq 'UNION') {
 468       $union = "($qf". join("$qf, $qf", @$value) ."$qf)";
 469       next;
 470     }
 471     $create .= " $key=$value";
 472   }
 473
 474   my $mysql_table_type = $table->extra('mysql_table_type');
 475   $create .= " ENGINE=$mysql_table_type"
 476     if $mysql_table_type && !$table_type_defined;
 477   my $comments         = $table->comments;
 478
 479   $create .= " DEFAULT CHARACTER SET $charset" if $charset;
 480   $create .= " COLLATE $collate" if $collate;
 481   $create .= " UNION=$union" if $union;
 482   $create .= qq[ comment='$comments'] if $comments;
 483   return $create;
 484 }
 485
 486 sub create_field
 487 {
 488     my ($field, $options) = @_;
 489
 490     my $qf = $options->{quote_field_names} ||= '';
 491
 492     my $field_name = $field->name;
 493     debug("PKG: Looking at field '$field_name'\n");
 494     my $field_def = "$qf$field_name$qf";
 495
 496     # data type and size
 497     my $data_type = $field->data_type;
 498     my @size      = $field->size;
 499     my %extra     = $field->extra;
 500     my $list      = $extra{'list'} || [];
 501     # \todo deal with embedded quotes
 502     my $commalist = join( ', ', map { qq['$_'] } @$list );
 503     my $charset = $extra{'mysql_charset'};
 504     my $collate = $extra{'mysql_collate'};
 505
 506     my $mysql_version = $options->{mysql_version} || 0;
 507     #
 508     # Oracle "number" type -- figure best MySQL type
 509     #
 510     if ( lc $data_type eq 'number' ) {
 511         # not an integer
 512         if ( scalar @size > 1 ) {
 513             $data_type = 'double';
 514         }
 515         elsif ( $size[0] && $size[0] >= 12 ) {
 516             $data_type = 'bigint';
 517         }
 518         elsif ( $size[0] && $size[0] <= 1 ) {
 519             $data_type = 'tinyint';
 520         }
 521         else {
 522             $data_type = 'int';
 523         }
 524     }
 525     #
 526     # Convert a large Oracle varchar to "text"
 527     # (not necessary as of 5.0.3 http://dev.mysql.com/doc/refman/5.0/en/char.html)
 528     #
 529     elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
 530         unless ($size[0] <= 65535 && $mysql_version >= 5.000003 ) {
 531             $data_type = 'text';
 532             @size      = ();
 533         }
 534     }
 535     elsif ( $data_type =~ /boolean/i ) {
 536         if ($mysql_version >= 4) {
 537             $data_type = 'boolean';
 538         } else {
 539             $data_type = 'enum';
 540             $commalist = "'0','1'";
 541         }
 542     }
 543     elsif ( exists $translate{ lc $data_type } ) {
 544         $data_type = $translate{ lc $data_type };
 545     }
 546
 547     @size = () if $data_type =~ /(text|blob)/i;
 548
 549     if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
 550         push @size, '0';
 551     }
 552
 553     $field_def .= " $data_type";
 554
 555     if ( lc($data_type) eq 'enum' || lc($data_type) eq 'set') {
 556         $field_def .= '(' . $commalist . ')';
 557     }
 558     elsif (
 559         defined $size[0] && $size[0] > 0
 560         &&
 561         ! grep lc($data_type) eq $_, @no_length_attr
 562     ) {
 563         $field_def .= '(' . join( ', ', @size ) . ')';
 564     }
 565
 566     # char sets
 567     $field_def .= " CHARACTER SET $charset" if $charset;
 568     $field_def .= " COLLATE $collate" if $collate;
 569
 570     # MySQL qualifiers
 571     for my $qual ( qw[ binary unsigned zerofill ] ) {
 572         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 573         $field_def .= " $qual";
 574     }
 575     for my $qual ( 'character set', 'collate', 'on update' ) {
 576         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 577         $field_def .= " $qual $val";
 578     }
 579
 580     # Null?
 581     $field_def .= ' NOT NULL' unless $field->is_nullable;
 582
 583     # Default?  XXX Need better quoting!
 584     my $default = $field->default_value;
 585     if ( defined $default ) {
 586         SQL::Translator::Producer->_apply_default_value(
 587           \$field_def,
 588           $default,
 589           [
 590             'NULL'       => \'NULL',
 591           ],
 592         );
 593     }
 594
 595     if ( my $comments = $field->comments ) {
 596         $field_def .= qq[ comment '$comments'];
 597     }
 598
 599     # auto_increment?
 600     $field_def .= " auto_increment" if $field->is_auto_increment;
 601
 602     return $field_def;
 603 }
 604
 605 sub alter_create_index
 606 {
 607     my ($index, $options) = @_;
 608
 609     my $qt = $options->{quote_table_names} || '';
 610     my $qf = $options->{quote_field_names} || '';
 611
 612     return join( ' ',
 613                  'ALTER TABLE',
 614                  $qt.$index->table->name.$qt,
 615                  'ADD',
 616                  create_index(@_)
 617                  );
 618 }
 619
 620 sub create_index
 621 {
 622     my ( $index, $options ) = @_;
 623
 624     my $qf = $options->{quote_field_names} || '';
 625
 626     return join(
 627         ' ',
 628         map { $_ || () }
 629         lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 630         $index->name
 631         ? (
 632             truncate_id_uniquely(
 633                 $index->name,
 634                 $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH
 635             )
 636           )
 637         : '',
 638         '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 639     );
 640 }
 641
 642 sub alter_drop_index
 643 {
 644     my ($index, $options) = @_;
 645
 646     my $qt = $options->{quote_table_names} || '';
 647     my $qf = $options->{quote_field_names} || '';
 648
 649     return join( ' ',
 650                  'ALTER TABLE',
 651                  $qt.$index->table->name.$qt,
 652                  'DROP',
 653                  'INDEX',
 654                  $index->name || $index->fields
 655                  );
 656
 657 }
 658
 659 sub alter_drop_constraint
 660 {
 661     my ($c, $options) = @_;
 662
 663     my $qt      = $options->{quote_table_names} || '';
 664     my $qc      = $options->{quote_field_names} || '';
 665
 666     my $out = sprintf('ALTER TABLE %s DROP %s %s',
 667                       $qt . $c->table->name . $qt,
 668                       $c->type eq FOREIGN_KEY ? $c->type : "INDEX",
 669                       $qc . $c->name . $qc );
 670
 671     return $out;
 672 }
 673
 674 sub alter_create_constraint
 675 {
 676     my ($index, $options) = @_;
 677
 678     my $qt = $options->{quote_table_names} || '';
 679     return join( ' ',
 680                  'ALTER TABLE',
 681                  $qt.$index->table->name.$qt,
 682                  'ADD',
 683                  create_constraint(@_) );
 684 }
 685
 686 sub create_constraint
 687 {
 688     my ($c, $options) = @_;
 689
 690     my $qf      = $options->{quote_field_names} || '';
 691     my $qt      = $options->{quote_table_names} || '';
 692     my $leave_name      = $options->{leave_name} || undef;
 693
 694     my @fields = $c->fields or next;
 695
 696     if ( $c->type eq PRIMARY_KEY ) {
 697         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 698     }
 699     elsif ( $c->type eq UNIQUE ) {
 700         return
 701         'UNIQUE '.
 702             (defined $c->name ? $qf.truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ).$qf.' ' : '').
 703             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
 704     }
 705     elsif ( $c->type eq FOREIGN_KEY ) {
 706         #
 707         # Make sure FK field is indexed or MySQL complains.
 708         #
 709
 710         my $table = $c->table;
 711         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
 712
 713         my $def = join(' ',
 714                        map { $_ || () }
 715                          'CONSTRAINT',
 716                          $qf . $c_name . $qf,
 717                          'FOREIGN KEY'
 718                       );
 719
 720
 721         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 722
 723         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
 724
 725         my @rfields = map { $_ || () } $c->reference_fields;
 726         unless ( @rfields ) {
 727             my $rtable_name = $c->reference_table;
 728             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 729                 push @rfields, $ref_table->primary_key;
 730             }
 731             else {
 732                 warn "Can't find reference table '$rtable_name' " .
 733                     "in schema\n" if $options->{show_warnings};
 734             }
 735         }
 736
 737         if ( @rfields ) {
 738             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 739         }
 740         else {
 741             warn "FK constraint on " . $table->name . '.' .
 742                 join('', @fields) . " has no reference fields\n"
 743                 if $options->{show_warnings};
 744         }
 745
 746         if ( $c->match_type ) {
 747             $def .= ' MATCH ' .
 748                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 749         }
 750
 751         if ( $c->on_delete ) {
 752             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 753         }
 754
 755         if ( $c->on_update ) {
 756             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 757         }
 758         return $def;
 759     }
 760
 761     return undef;
 762 }
 763
 764 sub alter_table
 765 {
 766     my ($to_table, $options) = @_;
 767
 768     my $qt = $options->{quote_table_names} || '';
 769
 770     my $table_options = generate_table_options($to_table, $options) || '';
 771     my $out = sprintf('ALTER TABLE %s%s',
 772                       $qt . $to_table->name . $qt,
 773                       $table_options);
 774
 775     return $out;
 776 }
 777
 778 sub rename_field { alter_field(@_) }
 779 sub alter_field
 780 {
 781     my ($from_field, $to_field, $options) = @_;
 782
 783     my $qf = $options->{quote_field_names} || '';
 784     my $qt = $options->{quote_table_names} || '';
 785
 786     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 787                       $qt . $to_field->table->name . $qt,
 788                       $qf . $from_field->name . $qf,
 789                       create_field($to_field, $options));
 790
 791     return $out;
 792 }
 793
 794 sub add_field
 795 {
 796     my ($new_field, $options) = @_;
 797
 798     my $qt = $options->{quote_table_names} || '';
 799
 800     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 801                       $qt . $new_field->table->name . $qt,
 802                       create_field($new_field, $options));
 803
 804     return $out;
 805
 806 }
 807
 808 sub drop_field
 809 {
 810     my ($old_field, $options) = @_;
 811
 812     my $qf = $options->{quote_field_names} || '';
 813     my $qt = $options->{quote_table_names} || '';
 814
 815     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 816                       $qt . $old_field->table->name . $qt,
 817                       $qf . $old_field->name . $qf);
 818
 819     return $out;
 820
 821 }
 822
 823 sub batch_alter_table {
 824   my ($table, $diff_hash, $options) = @_;
 825
 826   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 827   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
 828   #
 829   # We have to work round this.
 830
 831   my %fks_to_alter;
 832   my %fks_to_drop = map {
 833     $_->type eq FOREIGN_KEY
 834               ? ( $_->name => $_ )
 835               : ( )
 836   } @{$diff_hash->{alter_drop_constraint} };
 837
 838   my %fks_to_create = map {
 839     if ( $_->type eq FOREIGN_KEY) {
 840       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 841       ( $_->name => $_ );
 842     } else { ( ) }
 843   } @{$diff_hash->{alter_create_constraint} };
 844
 845   my @drop_stmt;
 846   if (scalar keys %fks_to_alter) {
 847     $diff_hash->{alter_drop_constraint} = [
 848       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 849     ];
 850
 851     @drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options);
 852
 853   }
 854
 855   my @stmts = map {
 856     if (@{ $diff_hash->{$_} || [] }) {
 857       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 858       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 859     } else { () }
 860   } qw/rename_table
 861        alter_drop_constraint
 862        alter_drop_index
 863        drop_field
 864        add_field
 865        alter_field
 866        rename_field
 867        alter_create_index
 868        alter_create_constraint
 869        alter_table/;
 870
 871   # rename_table makes things a bit more complex
 872   my $renamed_from = "";
 873   $renamed_from = $diff_hash->{rename_table}[0][0]->name
 874     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 875
 876   return unless @stmts;
 877   # Just zero or one stmts. return now
 878   return (@drop_stmt,@stmts) unless @stmts > 1;
 879
 880   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 881
 882   my $qt = $options->{quote_table_names} || '';
 883   my $table_name = $qt . $table->name . $qt;
 884
 885
 886   my $re = $renamed_from
 887          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$qt$renamed_from$qt\E) /
 888             : qr/^ALTER TABLE \Q$table_name\E /;
 889
 890   my $first = shift  @stmts;
 891   my ($alter_table) = $first =~ /($re)/;
 892
 893   my $padd = " " x length($alter_table);
 894
 895   return @drop_stmt, join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts);
 896
 897 }
 898
 899 sub drop_table {
 900   my ($table, $options) = @_;
 901
 902     my $qt = $options->{quote_table_names} || '';
 903
 904   # Drop (foreign key) constraints so table drops cleanly
 905   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
 906
 907   return (@sql, "DROP TABLE $qt$table$qt");
 908 #  return join("\n", @sql, "DROP TABLE $qt$table$qt");
 909
 910 }
 911
 912 sub rename_table {
 913   my ($old_table, $new_table, $options) = @_;
 914
 915   my $qt = $options->{quote_table_names} || '';
 916
 917   return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
 918 }
 919
 920 sub next_unused_name {
 921   my $name       = shift || '';
 922   if ( !defined($used_names{$name}) ) {
 923     $used_names{$name} = $name;
 924     return $name;
 925   }
 926
 927   my $i = 1;
 928   while ( defined($used_names{$name . '_' . $i}) ) {
 929     ++$i;
 930   }
 931   $name .= '_' . $i;
 932   $used_names{$name} = $name;
 933   return $name;
 934 }
 935
 936 1;
 937
 938 # -------------------------------------------------------------------
 939
 940 =pod
 941
 942 =head1 SEE ALSO
 943
 944 SQL::Translator, http://www.mysql.com/.
 945
 946 =head1 AUTHORS
 947
 948 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 949 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 950
 951 =cut