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 truncate_id_uniquely parse_mysql_version);
 114
 115 #
 116 # Use only lowercase for the keys (e.g. "long" and not "LONG")
 117 #
 118 my %translate  = (
 119     #
 120     # Oracle types
 121     #
 122     varchar2   => 'varchar',
 123     long       => 'text',
 124     clob       => 'longtext',
 125
 126     #
 127     # Sybase types
 128     #
 129     int        => 'integer',
 130     money      => 'float',
 131     real       => 'double',
 132     comment    => 'text',
 133     bit        => 'tinyint',
 134
 135     #
 136     # Access types
 137     #
 138     'long integer' => 'integer',
 139     'text'         => 'text',
 140     'datetime'     => 'datetime',
 141
 142     #
 143     # PostgreSQL types
 144     #
 145     bytea => 'BLOB',
 146 );
 147
 148 #
 149 # Column types that do not support lenth attribute
 150 #
 151 my @no_length_attr = qw/
 152   date time timestamp datetime year
 153   /;
 154
 155
 156 sub preprocess_schema {
 157     my ($schema) = @_;
 158
 159     # extra->{mysql_table_type} used to be the type. It belongs in options, so
 160     # move it if we find it. Return Engine type if found in extra or options
 161     # Similarly for mysql_charset and mysql_collate
 162     my $extra_to_options = sub {
 163       my ($table, $extra_name, $opt_name) = @_;
 164
 165       my $extra = $table->extra;
 166
 167       my $extra_type = delete $extra->{$extra_name};
 168
 169       # Now just to find if there is already an Engine or Type option...
 170       # and lets normalize it to ENGINE since:
 171       #
 172       # The ENGINE table option specifies the storage engine for the table.
 173       # TYPE is a synonym, but ENGINE is the preferred option name.
 174       #
 175
 176       # We have to use the hash directly here since otherwise there is no way
 177       # to remove options.
 178       my $options = ( $table->{options} ||= []);
 179
 180       # If multiple option names, normalize to the first one
 181       if (ref $opt_name) {
 182         OPT_NAME: for ( @$opt_name[1..$#$opt_name] ) {
 183           for my $idx ( 0..$#{$options} ) {
 184             my ($key, $value) = %{ $options->[$idx] };
 185
 186             if (uc $key eq $_) {
 187               $options->[$idx] = { $opt_name->[0] => $value };
 188               last OPT_NAME;
 189             }
 190           }
 191         }
 192         $opt_name = $opt_name->[0];
 193
 194       }
 195
 196
 197       # This assumes that there isn't both a Type and an Engine option.
 198       OPTION:
 199       for my $idx ( 0..$#{$options} ) {
 200         my ($key, $value) = %{ $options->[$idx] };
 201
 202         next unless uc $key eq $opt_name;
 203
 204         # make sure case is right on option name
 205         delete $options->[$idx]{$key};
 206         return $options->[$idx]{$opt_name} = $value || $extra_type;
 207
 208       }
 209
 210       if ($extra_type) {
 211         push @$options, { $opt_name => $extra_type };
 212         return $extra_type;
 213       }
 214
 215     };
 216
 217     # Names are only specific to a given schema
 218     local %used_names = ();
 219
 220     #
 221     # Work out which tables need to be InnoDB to support foreign key
 222     # constraints. We do this first as we need InnoDB at both ends.
 223     #
 224     foreach my $table ( $schema->get_tables ) {
 225
 226         $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE'] );
 227         $extra_to_options->($table, 'mysql_charset', 'CHARACTER SET' );
 228         $extra_to_options->($table, 'mysql_collate', 'COLLATE' );
 229
 230         foreach my $c ( $table->get_constraints ) {
 231             next unless $c->type eq FOREIGN_KEY;
 232
 233             # Normalize constraint names here.
 234             my $c_name = $c->name;
 235             # Give the constraint a name if it doesn't have one, so it doens't feel
 236             # left out
 237             $c_name   = $table->name . '_fk' unless length $c_name;
 238
 239             $c->name( next_unused_name($c_name) );
 240
 241             for my $meth (qw/table reference_table/) {
 242                 my $table = $schema->get_table($c->$meth) || next;
 243                 # This normalizes the types to ENGINE and returns the value if its there
 244                 next if $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE']);
 245                 $table->options( { 'ENGINE' => 'InnoDB' } );
 246             }
 247         } # foreach constraints
 248
 249         my %map = ( mysql_collate => 'collate', mysql_charset => 'character set');
 250         foreach my $f ( $table->get_fields ) {
 251           my $extra = $f->extra;
 252           for (keys %map) {
 253             $extra->{$map{$_}} = delete $extra->{$_} if exists $extra->{$_};
 254           }
 255
 256           my @size = $f->size;
 257           if ( !$size[0] && $f->data_type =~ /char$/ ) {
 258             $f->size( (255) );
 259           }
 260         }
 261
 262     }
 263 }
 264
 265 sub produce {
 266     my $translator     = shift;
 267     local $DEBUG       = $translator->debug;
 268     local %used_names;
 269     my $no_comments    = $translator->no_comments;
 270     my $add_drop_table = $translator->add_drop_table;
 271     my $schema         = $translator->schema;
 272     my $show_warnings  = $translator->show_warnings || 0;
 273     my $producer_args  = $translator->producer_args;
 274     my $mysql_version  = parse_mysql_version ($producer_args->{mysql_version}, 'perl') || 0;
 275     my $max_id_length  = $producer_args->{mysql_max_id_length} || $DEFAULT_MAX_ID_LENGTH;
 276
 277     my ($qt, $qf, $qc) = ('','', '');
 278     $qt = '`' if $translator->quote_table_names;
 279     $qf = '`' if $translator->quote_field_names;
 280
 281     debug("PKG: Beginning production\n");
 282     %used_names = ();
 283     my $create = '';
 284     $create .= header_comment unless ($no_comments);
 285     # \todo Don't set if MySQL 3.x is set on command line
 286     my @create = "SET foreign_key_checks=0";
 287
 288     preprocess_schema($schema);
 289
 290     #
 291     # Generate sql
 292     #
 293     my @table_defs =();
 294
 295     for my $table ( $schema->get_tables ) {
 296 #        print $table->name, "\n";
 297         push @table_defs, create_table($table,
 298                                        { add_drop_table    => $add_drop_table,
 299                                          show_warnings     => $show_warnings,
 300                                          no_comments       => $no_comments,
 301                                          quote_table_names => $qt,
 302                                          quote_field_names => $qf,
 303                                          max_id_length     => $max_id_length,
 304                                          mysql_version     => $mysql_version
 305                                          });
 306     }
 307
 308     if ($mysql_version >= 5.000001) {
 309       for my $view ( $schema->get_views ) {
 310         push @table_defs, create_view($view,
 311                                        { add_replace_view  => $add_drop_table,
 312                                          show_warnings     => $show_warnings,
 313                                          no_comments       => $no_comments,
 314                                          quote_table_names => $qt,
 315                                          quote_field_names => $qf,
 316                                          max_id_length     => $max_id_length,
 317                                          mysql_version     => $mysql_version
 318                                          });
 319       }
 320     }
 321
 322
 323 #    print "@table_defs\n";
 324     push @table_defs, "SET foreign_key_checks=1";
 325
 326     return wantarray ? ($create ? $create : (), @create, @table_defs) : ($create . join('', map { $_ ? "$_;\n\n" : () } (@create, @table_defs)));
 327 }
 328
 329 sub create_view {
 330     my ($view, $options) = @_;
 331     my $qt = $options->{quote_table_names} || '';
 332     my $qf = $options->{quote_field_names} || '';
 333
 334     my $view_name = $view->name;
 335     debug("PKG: Looking at view '${view_name}'\n");
 336
 337     # Header.  Should this look like what mysqldump produces?
 338     my $create = '';
 339     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n" unless $options->{no_comments};
 340     $create .= 'CREATE';
 341     $create .= ' OR REPLACE' if $options->{add_replace_view};
 342     $create .= "\n";
 343
 344     my $extra = $view->extra;
 345     # ALGORITHM
 346     if( exists($extra->{mysql_algorithm}) && defined(my $algorithm = $extra->{mysql_algorithm}) ){
 347       $create .= "   ALGORITHM = ${algorithm}\n" if $algorithm =~ /(?:UNDEFINED|MERGE|TEMPTABLE)/i;
 348     }
 349     # DEFINER
 350     if( exists($extra->{mysql_definer}) && defined(my $user = $extra->{mysql_definer}) ){
 351       $create .= "   DEFINER = ${user}\n";
 352     }
 353     # SECURITY
 354     if( exists($extra->{mysql_security}) && defined(my $security = $extra->{mysql_security}) ){
 355       $create .= "   SQL SECURITY ${security}\n" if $security =~ /(?:DEFINER|INVOKER)/i;
 356     }
 357
 358     #Header, cont.
 359     $create .= "  VIEW ${qt}${view_name}${qt}";
 360
 361     if( my @fields = $view->fields ){
 362       my $list = join ', ', map { "${qf}${_}${qf}"} @fields;
 363       $create .= " ( ${list} )";
 364     }
 365     if( my $sql = $view->sql ){
 366       $create .= " AS (\n    ${sql}\n  )";
 367     }
 368 #    $create .= "";
 369     return $create;
 370 }
 371
 372 sub create_table
 373 {
 374     my ($table, $options) = @_;
 375
 376     my $qt = $options->{quote_table_names} || '';
 377     my $qf = $options->{quote_field_names} || '';
 378
 379     my $table_name = quote_table_name($table->name, $qt);
 380     debug("PKG: Looking at table '$table_name'\n");
 381
 382     #
 383     # Header.  Should this look like what mysqldump produces?
 384     #
 385     my $create = '';
 386     my $drop;
 387     $create .= "--\n-- Table: $table_name\n--\n" unless $options->{no_comments};
 388     $drop = qq[DROP TABLE IF EXISTS $table_name] if $options->{add_drop_table};
 389     $create .= "CREATE TABLE $table_name (\n";
 390
 391     #
 392     # Fields
 393     #
 394     my @field_defs;
 395     for my $field ( $table->get_fields ) {
 396         push @field_defs, create_field($field, $options);
 397     }
 398
 399     #
 400     # Indices
 401     #
 402     my @index_defs;
 403     my %indexed_fields;
 404     for my $index ( $table->get_indices ) {
 405         push @index_defs, create_index($index, $options);
 406         $indexed_fields{ $_ } = 1 for $index->fields;
 407     }
 408
 409     #
 410     # Constraints -- need to handle more than just FK. -ky
 411     #
 412     my @constraint_defs;
 413     my @constraints = $table->get_constraints;
 414     for my $c ( @constraints ) {
 415         my $constr = create_constraint($c, $options);
 416         push @constraint_defs, $constr if($constr);
 417
 418          unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
 419              push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
 420              $indexed_fields{ ($c->fields())[0] } = 1;
 421          }
 422     }
 423
 424     $create .= join(",\n", map { "  $_" }
 425                     @field_defs, @index_defs, @constraint_defs
 426                     );
 427
 428     #
 429     # Footer
 430     #
 431     $create .= "\n)";
 432     $create .= generate_table_options($table, $options) || '';
 433 #    $create .= ";\n\n";
 434
 435     return $drop ? ($drop,$create) : $create;
 436 }
 437
 438 sub quote_table_name {
 439   my ($table_name, $qt) = @_;
 440
 441   $table_name =~ s/\./$qt.$qt/g;
 442
 443   return "$qt$table_name$qt";
 444 }
 445
 446 sub generate_table_options
 447 {
 448   my ($table, $options) = @_;
 449   my $create;
 450
 451   my $table_type_defined = 0;
 452   my $qf               = $options->{quote_field_names} ||= '';
 453   my $charset          = $table->extra('mysql_charset');
 454   my $collate          = $table->extra('mysql_collate');
 455   my $union            = undef;
 456   for my $t1_option_ref ( $table->options ) {
 457     my($key, $value) = %{$t1_option_ref};
 458     $table_type_defined = 1
 459       if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
 460     if (uc $key eq 'CHARACTER SET') {
 461       $charset = $value;
 462       next;
 463     } elsif (uc $key eq 'COLLATE') {
 464       $collate = $value;
 465       next;
 466     } elsif (uc $key eq 'UNION') {
 467       $union = "($qf". join("$qf, $qf", @$value) ."$qf)";
 468       next;
 469     }
 470     $create .= " $key=$value";
 471   }
 472
 473   my $mysql_table_type = $table->extra('mysql_table_type');
 474   $create .= " ENGINE=$mysql_table_type"
 475     if $mysql_table_type && !$table_type_defined;
 476   my $comments         = $table->comments;
 477
 478   $create .= " DEFAULT CHARACTER SET $charset" if $charset;
 479   $create .= " COLLATE $collate" if $collate;
 480   $create .= " UNION=$union" if $union;
 481   $create .= qq[ comment='$comments'] if $comments;
 482   return $create;
 483 }
 484
 485 sub create_field
 486 {
 487     my ($field, $options) = @_;
 488
 489     my $qf = $options->{quote_field_names} ||= '';
 490
 491     my $field_name = $field->name;
 492     debug("PKG: Looking at field '$field_name'\n");
 493     my $field_def = "$qf$field_name$qf";
 494
 495     # data type and size
 496     my $data_type = $field->data_type;
 497     my @size      = $field->size;
 498     my %extra     = $field->extra;
 499     my $list      = $extra{'list'} || [];
 500     # \todo deal with embedded quotes
 501     my $commalist = join( ', ', map { qq['$_'] } @$list );
 502     my $charset = $extra{'mysql_charset'};
 503     my $collate = $extra{'mysql_collate'};
 504
 505     my $mysql_version = $options->{mysql_version} || 0;
 506     #
 507     # Oracle "number" type -- figure best MySQL type
 508     #
 509     if ( lc $data_type eq 'number' ) {
 510         # not an integer
 511         if ( scalar @size > 1 ) {
 512             $data_type = 'double';
 513         }
 514         elsif ( $size[0] && $size[0] >= 12 ) {
 515             $data_type = 'bigint';
 516         }
 517         elsif ( $size[0] && $size[0] <= 1 ) {
 518             $data_type = 'tinyint';
 519         }
 520         else {
 521             $data_type = 'int';
 522         }
 523     }
 524     #
 525     # Convert a large Oracle varchar to "text"
 526     # (not necessary as of 5.0.3 http://dev.mysql.com/doc/refman/5.0/en/char.html)
 527     #
 528     elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
 529         unless ($size[0] <= 65535 && $mysql_version >= 5.000003 ) {
 530             $data_type = 'text';
 531             @size      = ();
 532         }
 533     }
 534     elsif ( $data_type =~ /boolean/i ) {
 535         if ($mysql_version >= 4) {
 536             $data_type = 'boolean';
 537         } else {
 538             $data_type = 'enum';
 539             $commalist = "'0','1'";
 540         }
 541     }
 542     elsif ( exists $translate{ lc $data_type } ) {
 543         $data_type = $translate{ lc $data_type };
 544     }
 545
 546     @size = () if $data_type =~ /(text|blob)/i;
 547
 548     if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
 549         push @size, '0';
 550     }
 551
 552     $field_def .= " $data_type";
 553
 554     if ( lc($data_type) eq 'enum' || lc($data_type) eq 'set') {
 555         $field_def .= '(' . $commalist . ')';
 556     }
 557     elsif (
 558         defined $size[0] && $size[0] > 0
 559         &&
 560         ! grep lc($data_type) eq $_, @no_length_attr
 561     ) {
 562         $field_def .= '(' . join( ', ', @size ) . ')';
 563     }
 564
 565     # char sets
 566     $field_def .= " CHARACTER SET $charset" if $charset;
 567     $field_def .= " COLLATE $collate" if $collate;
 568
 569     # MySQL qualifiers
 570     for my $qual ( qw[ binary unsigned zerofill ] ) {
 571         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 572         $field_def .= " $qual";
 573     }
 574     for my $qual ( 'character set', 'collate', 'on update' ) {
 575         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 576         $field_def .= " $qual $val";
 577     }
 578
 579     # Null?
 580     $field_def .= ' NOT NULL' unless $field->is_nullable;
 581
 582     # Default?  XXX Need better quoting!
 583     my $default = $field->default_value;
 584     if ( defined $default ) {
 585         SQL::Translator::Producer->_apply_default_value(
 586           \$field_def,
 587           $default,
 588           [
 589             'NULL'       => \'NULL',
 590           ],
 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                   lc $index->type eq 'normal'
 627                     ? 'INDEX'
 628                     : $index->type . ' INDEX'
 629                   ,
 630                   $index->name
 631                     ? (truncate_id_uniquely( $index->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ) )
 632                     : ()
 633                   ,
 634                   '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 635                  );
 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