lib/SQL/Translator/Producer/MySQL.pm

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