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