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         lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 629         $index->name
 630         ? (
 631             truncate_id_uniquely(
 632                 $index->name,
 633                 $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH
 634             )
 635           )
 636         : '',
 637         '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 638     );
 639 }
 640
 641 sub alter_drop_index
 642 {
 643     my ($index, $options) = @_;
 644
 645     my $qt = $options->{quote_table_names} || '';
 646     my $qf = $options->{quote_field_names} || '';
 647
 648     return join( ' ',
 649                  'ALTER TABLE',
 650                  $qt.$index->table->name.$qt,
 651                  'DROP',
 652                  'INDEX',
 653                  $index->name || $index->fields
 654                  );
 655
 656 }
 657
 658 sub alter_drop_constraint
 659 {
 660     my ($c, $options) = @_;
 661
 662     my $qt      = $options->{quote_table_names} || '';
 663     my $qc      = $options->{quote_field_names} || '';
 664
 665     my $out = sprintf('ALTER TABLE %s DROP %s %s',
 666                       $qt . $c->table->name . $qt,
 667                       $c->type eq FOREIGN_KEY ? $c->type : "INDEX",
 668                       $qc . $c->name . $qc );
 669
 670     return $out;
 671 }
 672
 673 sub alter_create_constraint
 674 {
 675     my ($index, $options) = @_;
 676
 677     my $qt = $options->{quote_table_names} || '';
 678     return join( ' ',
 679                  'ALTER TABLE',
 680                  $qt.$index->table->name.$qt,
 681                  'ADD',
 682                  create_constraint(@_) );
 683 }
 684
 685 sub create_constraint
 686 {
 687     my ($c, $options) = @_;
 688
 689     my $qf      = $options->{quote_field_names} || '';
 690     my $qt      = $options->{quote_table_names} || '';
 691     my $leave_name      = $options->{leave_name} || undef;
 692
 693     my @fields = $c->fields or next;
 694
 695     if ( $c->type eq PRIMARY_KEY ) {
 696         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 697     }
 698     elsif ( $c->type eq UNIQUE ) {
 699         return
 700         'UNIQUE '.
 701             (defined $c->name ? $qf.truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ).$qf.' ' : '').
 702             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
 703     }
 704     elsif ( $c->type eq FOREIGN_KEY ) {
 705         #
 706         # Make sure FK field is indexed or MySQL complains.
 707         #
 708
 709         my $table = $c->table;
 710         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
 711
 712         my $def = join(' ',
 713                        map { $_ || () }
 714                          'CONSTRAINT',
 715                          $qf . $c_name . $qf,
 716                          'FOREIGN KEY'
 717                       );
 718
 719
 720         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 721
 722         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
 723
 724         my @rfields = map { $_ || () } $c->reference_fields;
 725         unless ( @rfields ) {
 726             my $rtable_name = $c->reference_table;
 727             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 728                 push @rfields, $ref_table->primary_key;
 729             }
 730             else {
 731                 warn "Can't find reference table '$rtable_name' " .
 732                     "in schema\n" if $options->{show_warnings};
 733             }
 734         }
 735
 736         if ( @rfields ) {
 737             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 738         }
 739         else {
 740             warn "FK constraint on " . $table->name . '.' .
 741                 join('', @fields) . " has no reference fields\n"
 742                 if $options->{show_warnings};
 743         }
 744
 745         if ( $c->match_type ) {
 746             $def .= ' MATCH ' .
 747                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 748         }
 749
 750         if ( $c->on_delete ) {
 751             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 752         }
 753
 754         if ( $c->on_update ) {
 755             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 756         }
 757         return $def;
 758     }
 759
 760     return undef;
 761 }
 762
 763 sub alter_table
 764 {
 765     my ($to_table, $options) = @_;
 766
 767     my $qt = $options->{quote_table_names} || '';
 768
 769     my $table_options = generate_table_options($to_table, $options) || '';
 770     my $out = sprintf('ALTER TABLE %s%s',
 771                       $qt . $to_table->name . $qt,
 772                       $table_options);
 773
 774     return $out;
 775 }
 776
 777 sub rename_field { alter_field(@_) }
 778 sub alter_field
 779 {
 780     my ($from_field, $to_field, $options) = @_;
 781
 782     my $qf = $options->{quote_field_names} || '';
 783     my $qt = $options->{quote_table_names} || '';
 784
 785     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 786                       $qt . $to_field->table->name . $qt,
 787                       $qf . $from_field->name . $qf,
 788                       create_field($to_field, $options));
 789
 790     return $out;
 791 }
 792
 793 sub add_field
 794 {
 795     my ($new_field, $options) = @_;
 796
 797     my $qt = $options->{quote_table_names} || '';
 798
 799     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 800                       $qt . $new_field->table->name . $qt,
 801                       create_field($new_field, $options));
 802
 803     return $out;
 804
 805 }
 806
 807 sub drop_field
 808 {
 809     my ($old_field, $options) = @_;
 810
 811     my $qf = $options->{quote_field_names} || '';
 812     my $qt = $options->{quote_table_names} || '';
 813
 814     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 815                       $qt . $old_field->table->name . $qt,
 816                       $qf . $old_field->name . $qf);
 817
 818     return $out;
 819
 820 }
 821
 822 sub batch_alter_table {
 823   my ($table, $diff_hash, $options) = @_;
 824
 825   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 826   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
 827   #
 828   # We have to work round this.
 829
 830   my %fks_to_alter;
 831   my %fks_to_drop = map {
 832     $_->type eq FOREIGN_KEY
 833               ? ( $_->name => $_ )
 834               : ( )
 835   } @{$diff_hash->{alter_drop_constraint} };
 836
 837   my %fks_to_create = map {
 838     if ( $_->type eq FOREIGN_KEY) {
 839       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 840       ( $_->name => $_ );
 841     } else { ( ) }
 842   } @{$diff_hash->{alter_create_constraint} };
 843
 844   my @drop_stmt;
 845   if (scalar keys %fks_to_alter) {
 846     $diff_hash->{alter_drop_constraint} = [
 847       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 848     ];
 849
 850     @drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options);
 851
 852   }
 853
 854   my @stmts = map {
 855     if (@{ $diff_hash->{$_} || [] }) {
 856       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 857       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 858     } else { () }
 859   } qw/rename_table
 860        alter_drop_constraint
 861        alter_drop_index
 862        drop_field
 863        add_field
 864        alter_field
 865        rename_field
 866        alter_create_index
 867        alter_create_constraint
 868        alter_table/;
 869
 870   # rename_table makes things a bit more complex
 871   my $renamed_from = "";
 872   $renamed_from = $diff_hash->{rename_table}[0][0]->name
 873     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 874
 875   return unless @stmts;
 876   # Just zero or one stmts. return now
 877   return (@drop_stmt,@stmts) unless @stmts > 1;
 878
 879   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 880
 881   my $qt = $options->{quote_table_names} || '';
 882   my $table_name = $qt . $table->name . $qt;
 883
 884
 885   my $re = $renamed_from
 886          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$qt$renamed_from$qt\E) /
 887             : qr/^ALTER TABLE \Q$table_name\E /;
 888
 889   my $first = shift  @stmts;
 890   my ($alter_table) = $first =~ /($re)/;
 891
 892   my $padd = " " x length($alter_table);
 893
 894   return @drop_stmt, join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts);
 895
 896 }
 897
 898 sub drop_table {
 899   my ($table, $options) = @_;
 900
 901     my $qt = $options->{quote_table_names} || '';
 902
 903   # Drop (foreign key) constraints so table drops cleanly
 904   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
 905
 906   return (@sql, "DROP TABLE $qt$table$qt");
 907 #  return join("\n", @sql, "DROP TABLE $qt$table$qt");
 908
 909 }
 910
 911 sub rename_table {
 912   my ($old_table, $new_table, $options) = @_;
 913
 914   my $qt = $options->{quote_table_names} || '';
 915
 916   return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
 917 }
 918
 919 sub next_unused_name {
 920   my $name       = shift || '';
 921   if ( !defined($used_names{$name}) ) {
 922     $used_names{$name} = $name;
 923     return $name;
 924   }
 925
 926   my $i = 1;
 927   while ( defined($used_names{$name . '_' . $i}) ) {
 928     ++$i;
 929   }
 930   $name .= '_' . $i;
 931   $used_names{$name} = $name;
 932   return $name;
 933 }
 934
 935 1;
 936
 937 # -------------------------------------------------------------------
 938
 939 =pod
 940
 941 =head1 SEE ALSO
 942
 943 SQL::Translator, http://www.mysql.com/.
 944
 945 =head1 AUTHORS
 946
 947 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 948 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 949
 950 =cut