lib/SQL/Translator/Producer/MySQL.pm

   1 package SQL::Translator::Producer::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # Copyright (C) 2002-2009 SQLFairy Authors
   5 #
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License as
   8 # published by the Free Software Foundation; version 2.
   9 #
  10 # This program is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  18 # 02111-1307  USA
  19 # -------------------------------------------------------------------
  20
  21 =head1 NAME
  22
  23 SQL::Translator::Producer::MySQL - MySQL-specific producer for SQL::Translator
  24
  25 =head1 SYNOPSIS
  26
  27 Use via SQL::Translator:
  28
  29   use SQL::Translator;
  30
  31   my $t = SQL::Translator->new( parser => '...', producer => 'MySQL', '...' );
  32   $t->translate;
  33
  34 =head1 DESCRIPTION
  35
  36 This module will produce text output of the schema suitable for MySQL.
  37 There are still some issues to be worked out with syntax differences
  38 between MySQL versions 3 and 4 ("SET foreign_key_checks," character sets
  39 for fields, etc.).
  40
  41 =head1 ARGUMENTS
  42
  43 This producer takes a single optional producer_arg C<mysql_version>, which
  44 provides the desired version for the target database. By default MySQL v3 is
  45 assumed, and statements pertaining to any features introduced in later versions
  46 (e.g. CREATE VIEW) are not produced.
  47
  48 Valid version specifiers for C<mysql_version> are listed L<here|SQL::Translator::Utils/parse_mysql_version>
  49
  50 =head2 Table Types
  51
  52 Normally the tables will be created without any explicit table type given and
  53 so will use the MySQL default.
  54
  55 Any tables involved in foreign key constraints automatically get a table type
  56 of InnoDB, unless this is overridden by setting the C<mysql_table_type> extra
  57 attribute explicitly on the table.
  58
  59 =head2 Extra attributes.
  60
  61 The producer recognises the following extra attributes on the Schema objects.
  62
  63 =over 4
  64
  65 =item B<field.list>
  66
  67 Set the list of allowed values for Enum fields.
  68
  69 =item B<field.binary>, B<field.unsigned>, B<field.zerofill>
  70
  71 Set the MySQL field options of the same name.
  72
  73 =item B<field.renamed_from>, B<table.renamed_from>
  74
  75 Use when producing diffs to indicate that the current table/field has been
  76 renamed from the old name as given in the attribute value.
  77
  78 =item B<table.mysql_table_type>
  79
  80 Set the type of the table e.g. 'InnoDB', 'MyISAM'. This will be
  81 automatically set for tables involved in foreign key constraints if it is
  82 not already set explicitly. See L<"Table Types">.
  83
  84 Please note that the C<ENGINE> option is the preferred method of specifying
  85 the MySQL storage engine to use, but this method still works for backwards
  86 compatibility.
  87
  88 =item B<table.mysql_charset>, B<table.mysql_collate>
  89
  90 Set the tables default charater set and collation order.
  91
  92 =item B<field.mysql_charset>, B<field.mysql_collate>
  93
  94 Set the fields charater set and collation order.
  95
  96 =back
  97
  98 =cut
  99
 100 use strict;
 101 use warnings;
 102 use vars qw[ $VERSION $DEBUG %used_names ];
 103 $VERSION = '1.59';
 104 $DEBUG   = 0 unless defined $DEBUG;
 105
 106 # Maximum length for most identifiers is 64, according to:
 107 #   http://dev.mysql.com/doc/refman/4.1/en/identifiers.html
 108 #   http://dev.mysql.com/doc/refman/5.0/en/identifiers.html
 109 my $DEFAULT_MAX_ID_LENGTH = 64;
 110
 111 use Data::Dumper;
 112 use SQL::Translator::Schema::Constants;
 113 use SQL::Translator::Utils qw(debug header_comment
 114     truncate_id_uniquely parse_mysql_version);
 115
 116 #
 117 # Use only lowercase for the keys (e.g. "long" and not "LONG")
 118 #
 119 my %translate  = (
 120     #
 121     # Oracle types
 122     #
 123     varchar2   => 'varchar',
 124     long       => 'text',
 125     clob       => 'longtext',
 126
 127     #
 128     # Sybase types
 129     #
 130     int        => 'integer',
 131     money      => 'float',
 132     real       => 'double',
 133     comment    => 'text',
 134     bit        => 'tinyint',
 135
 136     #
 137     # Access types
 138     #
 139     'long integer' => 'integer',
 140     'text'         => 'text',
 141     'datetime'     => 'datetime',
 142
 143     #
 144     # PostgreSQL types
 145     #
 146     bytea => 'BLOB',
 147 );
 148
 149 #
 150 # Column types that do not support lenth attribute
 151 #
 152 my @no_length_attr = qw/
 153   date time timestamp datetime year
 154   /;
 155
 156
 157 sub preprocess_schema {
 158     my ($schema) = @_;
 159
 160     # extra->{mysql_table_type} used to be the type. It belongs in options, so
 161     # move it if we find it. Return Engine type if found in extra or options
 162     # Similarly for mysql_charset and mysql_collate
 163     my $extra_to_options = sub {
 164       my ($table, $extra_name, $opt_name) = @_;
 165
 166       my $extra = $table->extra;
 167
 168       my $extra_type = delete $extra->{$extra_name};
 169
 170       # Now just to find if there is already an Engine or Type option...
 171       # and lets normalize it to ENGINE since:
 172       #
 173       # The ENGINE table option specifies the storage engine for the table.
 174       # TYPE is a synonym, but ENGINE is the preferred option name.
 175       #
 176
 177       # We have to use the hash directly here since otherwise there is no way
 178       # to remove options.
 179       my $options = ( $table->{options} ||= []);
 180
 181       # If multiple option names, normalize to the first one
 182       if (ref $opt_name) {
 183         OPT_NAME: for ( @$opt_name[1..$#$opt_name] ) {
 184           for my $idx ( 0..$#{$options} ) {
 185             my ($key, $value) = %{ $options->[$idx] };
 186
 187             if (uc $key eq $_) {
 188               $options->[$idx] = { $opt_name->[0] => $value };
 189               last OPT_NAME;
 190             }
 191           }
 192         }
 193         $opt_name = $opt_name->[0];
 194
 195       }
 196
 197
 198       # This assumes that there isn't both a Type and an Engine option.
 199       OPTION:
 200       for my $idx ( 0..$#{$options} ) {
 201         my ($key, $value) = %{ $options->[$idx] };
 202
 203         next unless uc $key eq $opt_name;
 204
 205         # make sure case is right on option name
 206         delete $options->[$idx]{$key};
 207         return $options->[$idx]{$opt_name} = $value || $extra_type;
 208
 209       }
 210
 211       if ($extra_type) {
 212         push @$options, { $opt_name => $extra_type };
 213         return $extra_type;
 214       }
 215
 216     };
 217
 218     # Names are only specific to a given schema
 219     local %used_names = ();
 220
 221     #
 222     # Work out which tables need to be InnoDB to support foreign key
 223     # constraints. We do this first as we need InnoDB at both ends.
 224     #
 225     foreach my $table ( $schema->get_tables ) {
 226
 227         $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE'] );
 228         $extra_to_options->($table, 'mysql_charset', 'CHARACTER SET' );
 229         $extra_to_options->($table, 'mysql_collate', 'COLLATE' );
 230
 231         foreach my $c ( $table->get_constraints ) {
 232             next unless $c->type eq FOREIGN_KEY;
 233
 234             # Normalize constraint names here.
 235             my $c_name = $c->name;
 236             # Give the constraint a name if it doesn't have one, so it doens't feel
 237             # left out
 238             $c_name   = $table->name . '_fk' unless length $c_name;
 239
 240             $c->name( next_unused_name($c_name) );
 241
 242             for my $meth (qw/table reference_table/) {
 243                 my $table = $schema->get_table($c->$meth) || next;
 244                 # This normalizes the types to ENGINE and returns the value if its there
 245                 next if $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE']);
 246                 $table->options( { 'ENGINE' => 'InnoDB' } );
 247             }
 248         } # foreach constraints
 249
 250         my %map = ( mysql_collate => 'collate', mysql_charset => 'character set');
 251         foreach my $f ( $table->get_fields ) {
 252           my $extra = $f->extra;
 253           for (keys %map) {
 254             $extra->{$map{$_}} = delete $extra->{$_} if exists $extra->{$_};
 255           }
 256
 257           my @size = $f->size;
 258           if ( !$size[0] && $f->data_type =~ /char$/ ) {
 259             $f->size( (255) );
 260           }
 261         }
 262
 263     }
 264 }
 265
 266 sub produce {
 267     my $translator     = shift;
 268     local $DEBUG       = $translator->debug;
 269     local %used_names;
 270     my $no_comments    = $translator->no_comments;
 271     my $add_drop_table = $translator->add_drop_table;
 272     my $schema         = $translator->schema;
 273     my $show_warnings  = $translator->show_warnings || 0;
 274     my $producer_args  = $translator->producer_args;
 275     my $mysql_version  = parse_mysql_version ($producer_args->{mysql_version}, 'perl') || 0;
 276     my $max_id_length  = $producer_args->{mysql_max_id_length} || $DEFAULT_MAX_ID_LENGTH;
 277
 278     my ($qt, $qf, $qc) = ('','', '');
 279     $qt = '`' if $translator->quote_table_names;
 280     $qf = '`' if $translator->quote_field_names;
 281
 282     debug("PKG: Beginning production\n");
 283     %used_names = ();
 284     my $create = '';
 285     $create .= header_comment unless ($no_comments);
 286     # \todo Don't set if MySQL 3.x is set on command line
 287     my @create = "SET foreign_key_checks=0";
 288
 289     preprocess_schema($schema);
 290
 291     #
 292     # Generate sql
 293     #
 294     my @table_defs =();
 295
 296     for my $table ( $schema->get_tables ) {
 297 #        print $table->name, "\n";
 298         push @table_defs, create_table($table,
 299                                        { add_drop_table    => $add_drop_table,
 300                                          show_warnings     => $show_warnings,
 301                                          no_comments       => $no_comments,
 302                                          quote_table_names => $qt,
 303                                          quote_field_names => $qf,
 304                                          max_id_length     => $max_id_length,
 305                                          mysql_version     => $mysql_version
 306                                          });
 307     }
 308
 309     if ($mysql_version >= 5.000001) {
 310       for my $view ( $schema->get_views ) {
 311         push @table_defs, create_view($view,
 312                                        { add_replace_view  => $add_drop_table,
 313                                          show_warnings     => $show_warnings,
 314                                          no_comments       => $no_comments,
 315                                          quote_table_names => $qt,
 316                                          quote_field_names => $qf,
 317                                          max_id_length     => $max_id_length,
 318                                          mysql_version     => $mysql_version
 319                                          });
 320       }
 321     }
 322
 323
 324 #    print "@table_defs\n";
 325     push @table_defs, "SET foreign_key_checks=1";
 326
 327     return wantarray ? ($create ? $create : (), @create, @table_defs) : ($create . join('', map { $_ ? "$_;\n\n" : () } (@create, @table_defs)));
 328 }
 329
 330 sub create_view {
 331     my ($view, $options) = @_;
 332     my $qt = $options->{quote_table_names} || '';
 333     my $qf = $options->{quote_field_names} || '';
 334
 335     my $view_name = $view->name;
 336     debug("PKG: Looking at view '${view_name}'\n");
 337
 338     # Header.  Should this look like what mysqldump produces?
 339     my $create = '';
 340     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n" unless $options->{no_comments};
 341     $create .= 'CREATE';
 342     $create .= ' OR REPLACE' if $options->{add_replace_view};
 343     $create .= "\n";
 344
 345     my $extra = $view->extra;
 346     # ALGORITHM
 347     if( exists($extra->{mysql_algorithm}) && defined(my $algorithm = $extra->{mysql_algorithm}) ){
 348       $create .= "   ALGORITHM = ${algorithm}\n" if $algorithm =~ /(?:UNDEFINED|MERGE|TEMPTABLE)/i;
 349     }
 350     # DEFINER
 351     if( exists($extra->{mysql_definer}) && defined(my $user = $extra->{mysql_definer}) ){
 352       $create .= "   DEFINER = ${user}\n";
 353     }
 354     # SECURITY
 355     if( exists($extra->{mysql_security}) && defined(my $security = $extra->{mysql_security}) ){
 356       $create .= "   SQL SECURITY ${security}\n" if $security =~ /(?:DEFINER|INVOKER)/i;
 357     }
 358
 359     #Header, cont.
 360     $create .= "  VIEW ${qt}${view_name}${qt}";
 361
 362     if( my @fields = $view->fields ){
 363       my $list = join ', ', map { "${qf}${_}${qf}"} @fields;
 364       $create .= " ( ${list} )";
 365     }
 366     if( my $sql = $view->sql ){
 367       $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         ? $qf . truncate_id_uniquely(
 632                 $index->name,
 633                 $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH
 634           ) . $qf
 635         : '',
 636         '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 637     );
 638 }
 639
 640 sub alter_drop_index
 641 {
 642     my ($index, $options) = @_;
 643
 644     my $qt = $options->{quote_table_names} || '';
 645     my $qf = $options->{quote_field_names} || '';
 646
 647     return join( ' ',
 648                  'ALTER TABLE',
 649                  $qt.$index->table->name.$qt,
 650                  'DROP',
 651                  'INDEX',
 652                  $index->name || $index->fields
 653                  );
 654
 655 }
 656
 657 sub alter_drop_constraint
 658 {
 659     my ($c, $options) = @_;
 660
 661     my $qt      = $options->{quote_table_names} || '';
 662     my $qc      = $options->{quote_field_names} || '';
 663
 664     my $out = sprintf('ALTER TABLE %s DROP %s %s',
 665                       $qt . $c->table->name . $qt,
 666                       $c->type eq FOREIGN_KEY ? $c->type : "INDEX",
 667                       $qc . $c->name . $qc );
 668
 669     return $out;
 670 }
 671
 672 sub alter_create_constraint
 673 {
 674     my ($index, $options) = @_;
 675
 676     my $qt = $options->{quote_table_names} || '';
 677     return join( ' ',
 678                  'ALTER TABLE',
 679                  $qt.$index->table->name.$qt,
 680                  'ADD',
 681                  create_constraint(@_) );
 682 }
 683
 684 sub create_constraint
 685 {
 686     my ($c, $options) = @_;
 687
 688     my $qf      = $options->{quote_field_names} || '';
 689     my $qt      = $options->{quote_table_names} || '';
 690     my $leave_name      = $options->{leave_name} || undef;
 691
 692     my @fields = $c->fields or next;
 693
 694     if ( $c->type eq PRIMARY_KEY ) {
 695         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 696     }
 697     elsif ( $c->type eq UNIQUE ) {
 698         return
 699         'UNIQUE '.
 700             (defined $c->name ? $qf.truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ).$qf.' ' : '').
 701             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
 702     }
 703     elsif ( $c->type eq FOREIGN_KEY ) {
 704         #
 705         # Make sure FK field is indexed or MySQL complains.
 706         #
 707
 708         my $table = $c->table;
 709         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
 710
 711         my $def = join(' ',
 712                        map { $_ || () }
 713                          'CONSTRAINT',
 714                          $qf . $c_name . $qf,
 715                          'FOREIGN KEY'
 716                       );
 717
 718
 719         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 720
 721         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
 722
 723         my @rfields = map { $_ || () } $c->reference_fields;
 724         unless ( @rfields ) {
 725             my $rtable_name = $c->reference_table;
 726             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 727                 push @rfields, $ref_table->primary_key;
 728             }
 729             else {
 730                 warn "Can't find reference table '$rtable_name' " .
 731                     "in schema\n" if $options->{show_warnings};
 732             }
 733         }
 734
 735         if ( @rfields ) {
 736             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 737         }
 738         else {
 739             warn "FK constraint on " . $table->name . '.' .
 740                 join('', @fields) . " has no reference fields\n"
 741                 if $options->{show_warnings};
 742         }
 743
 744         if ( $c->match_type ) {
 745             $def .= ' MATCH ' .
 746                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 747         }
 748
 749         if ( $c->on_delete ) {
 750             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 751         }
 752
 753         if ( $c->on_update ) {
 754             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 755         }
 756         return $def;
 757     }
 758
 759     return undef;
 760 }
 761
 762 sub alter_table
 763 {
 764     my ($to_table, $options) = @_;
 765
 766     my $qt = $options->{quote_table_names} || '';
 767
 768     my $table_options = generate_table_options($to_table, $options) || '';
 769     my $out = sprintf('ALTER TABLE %s%s',
 770                       $qt . $to_table->name . $qt,
 771                       $table_options);
 772
 773     return $out;
 774 }
 775
 776 sub rename_field { alter_field(@_) }
 777 sub alter_field
 778 {
 779     my ($from_field, $to_field, $options) = @_;
 780
 781     my $qf = $options->{quote_field_names} || '';
 782     my $qt = $options->{quote_table_names} || '';
 783
 784     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 785                       $qt . $to_field->table->name . $qt,
 786                       $qf . $from_field->name . $qf,
 787                       create_field($to_field, $options));
 788
 789     return $out;
 790 }
 791
 792 sub add_field
 793 {
 794     my ($new_field, $options) = @_;
 795
 796     my $qt = $options->{quote_table_names} || '';
 797
 798     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 799                       $qt . $new_field->table->name . $qt,
 800                       create_field($new_field, $options));
 801
 802     return $out;
 803
 804 }
 805
 806 sub drop_field
 807 {
 808     my ($old_field, $options) = @_;
 809
 810     my $qf = $options->{quote_field_names} || '';
 811     my $qt = $options->{quote_table_names} || '';
 812
 813     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 814                       $qt . $old_field->table->name . $qt,
 815                       $qf . $old_field->name . $qf);
 816
 817     return $out;
 818
 819 }
 820
 821 sub batch_alter_table {
 822   my ($table, $diff_hash, $options) = @_;
 823
 824   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 825   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
 826   #
 827   # We have to work round this.
 828
 829   my %fks_to_alter;
 830   my %fks_to_drop = map {
 831     $_->type eq FOREIGN_KEY
 832               ? ( $_->name => $_ )
 833               : ( )
 834   } @{$diff_hash->{alter_drop_constraint} };
 835
 836   my %fks_to_create = map {
 837     if ( $_->type eq FOREIGN_KEY) {
 838       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 839       ( $_->name => $_ );
 840     } else { ( ) }
 841   } @{$diff_hash->{alter_create_constraint} };
 842
 843   my @drop_stmt;
 844   if (scalar keys %fks_to_alter) {
 845     $diff_hash->{alter_drop_constraint} = [
 846       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 847     ];
 848
 849     @drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options);
 850
 851   }
 852
 853   my @stmts = map {
 854     if (@{ $diff_hash->{$_} || [] }) {
 855       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 856       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 857     } else { () }
 858   } qw/rename_table
 859        alter_drop_constraint
 860        alter_drop_index
 861        drop_field
 862        add_field
 863        alter_field
 864        rename_field
 865        alter_create_index
 866        alter_create_constraint
 867        alter_table/;
 868
 869   # rename_table makes things a bit more complex
 870   my $renamed_from = "";
 871   $renamed_from = $diff_hash->{rename_table}[0][0]->name
 872     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 873
 874   return unless @stmts;
 875   # Just zero or one stmts. return now
 876   return (@drop_stmt,@stmts) unless @stmts > 1;
 877
 878   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 879
 880   my $qt = $options->{quote_table_names} || '';
 881   my $table_name = $qt . $table->name . $qt;
 882
 883
 884   my $re = $renamed_from
 885          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$qt$renamed_from$qt\E) /
 886             : qr/^ALTER TABLE \Q$table_name\E /;
 887
 888   my $first = shift  @stmts;
 889   my ($alter_table) = $first =~ /($re)/;
 890
 891   my $padd = " " x length($alter_table);
 892
 893   return @drop_stmt, join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts);
 894
 895 }
 896
 897 sub drop_table {
 898   my ($table, $options) = @_;
 899
 900     my $qt = $options->{quote_table_names} || '';
 901
 902   # Drop (foreign key) constraints so table drops cleanly
 903   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
 904
 905   return (@sql, "DROP TABLE $qt$table$qt");
 906 #  return join("\n", @sql, "DROP TABLE $qt$table$qt");
 907
 908 }
 909
 910 sub rename_table {
 911   my ($old_table, $new_table, $options) = @_;
 912
 913   my $qt = $options->{quote_table_names} || '';
 914
 915   return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
 916 }
 917
 918 sub next_unused_name {
 919   my $name       = shift || '';
 920   if ( !defined($used_names{$name}) ) {
 921     $used_names{$name} = $name;
 922     return $name;
 923   }
 924
 925   my $i = 1;
 926   while ( defined($used_names{$name . '_' . $i}) ) {
 927     ++$i;
 928   }
 929   $name .= '_' . $i;
 930   $used_names{$name} = $name;
 931   return $name;
 932 }
 933
 934 1;
 935
 936 # -------------------------------------------------------------------
 937
 938 =pod
 939
 940 =head1 SEE ALSO
 941
 942 SQL::Translator, http://www.mysql.com/.
 943
 944 =head1 AUTHORS
 945
 946 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 947 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 948
 949 =cut