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
 244     my ($qt, $qf, $qc) = ('','', '');
 245     $qt = '`' if $translator->quote_table_names;
 246     $qf = '`' if $translator->quote_field_names;
 247
 248     debug("PKG: Beginning production\n");
 249     %used_names = ();
 250     my $create;
 251     $create .= header_comment unless ($no_comments);
 252     # \todo Don't set if MySQL 3.x is set on command line
 253     $create .= "SET foreign_key_checks=0;\n\n";
 254
 255     preprocess_schema($schema);
 256
 257     #
 258     # Generate sql
 259     #
 260     my @table_defs =();
 261
 262     for my $table ( $schema->get_tables ) {
 263 #        print $table->name, "\n";
 264         push @table_defs, create_table($table,
 265                                        { add_drop_table    => $add_drop_table,
 266                                          show_warnings     => $show_warnings,
 267                                          no_comments       => $no_comments,
 268                                          quote_table_names => $qt,
 269                                          quote_field_names => $qf
 270                                          });
 271     }
 272
 273 #    print "@table_defs\n";
 274     push @table_defs, "SET foreign_key_checks=1;\n\n";
 275
 276     return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
 277 }
 278
 279 sub create_table
 280 {
 281     my ($table, $options) = @_;
 282
 283     my $qt = $options->{quote_table_names} || '';
 284     my $qf = $options->{quote_field_names} || '';
 285
 286     my $table_name = $table->name;
 287     debug("PKG: Looking at table '$table_name'\n");
 288
 289     #
 290     # Header.  Should this look like what mysqldump produces?
 291     #
 292     my $create = '';
 293     my $drop;
 294     $create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
 295     $drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
 296     $create .= "CREATE TABLE $qt$table_name$qt (\n";
 297
 298     #
 299     # Fields
 300     #
 301     my @field_defs;
 302     for my $field ( $table->get_fields ) {
 303         push @field_defs, create_field($field, $options);
 304     }
 305
 306     #
 307     # Indices
 308     #
 309     my @index_defs;
 310     my %indexed_fields;
 311     for my $index ( $table->get_indices ) {
 312         push @index_defs, create_index($index, $options);
 313         $indexed_fields{ $_ } = 1 for $index->fields;
 314     }
 315
 316     #
 317     # Constraints -- need to handle more than just FK. -ky
 318     #
 319     my @constraint_defs;
 320     my @constraints = $table->get_constraints;
 321     for my $c ( @constraints ) {
 322         my $constr = create_constraint($c, $options);
 323         push @constraint_defs, $constr if($constr);
 324
 325          unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
 326              push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
 327              $indexed_fields{ ($c->fields())[0] } = 1;
 328          }
 329     }
 330
 331     $create .= join(",\n", map { "  $_" }
 332                     @field_defs, @index_defs, @constraint_defs
 333                     );
 334
 335     #
 336     # Footer
 337     #
 338     $create .= "\n)";
 339     $create .= generate_table_options($table) || '';
 340     $create .= ";\n\n";
 341
 342     return $drop ? ($drop,$create) : $create;
 343 }
 344
 345 sub generate_table_options
 346 {
 347   my ($table) = @_;
 348   my $create;
 349
 350   my $table_type_defined = 0;
 351   my $charset          = $table->extra('mysql_charset');
 352   my $collate          = $table->extra('mysql_collate');
 353   for my $t1_option_ref ( $table->options ) {
 354     my($key, $value) = %{$t1_option_ref};
 355     $table_type_defined = 1
 356       if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
 357     if (uc $key eq 'CHARACTER SET') {
 358       $charset = $value;
 359       next;
 360     } elsif (uc $key eq 'COLLATE') {
 361       $collate = $value;
 362       next;
 363     }
 364     $create .= " $key=$value";
 365   }
 366
 367   my $mysql_table_type = $table->extra('mysql_table_type');
 368   $create .= " ENGINE=$mysql_table_type"
 369     if $mysql_table_type && !$table_type_defined;
 370   my $comments         = $table->comments;
 371
 372   $create .= " DEFAULT CHARACTER SET $charset" if $charset;
 373   $create .= " COLLATE $collate" if $collate;
 374   $create .= qq[ comment='$comments'] if $comments;
 375   return $create;
 376 }
 377
 378 sub create_field
 379 {
 380     my ($field, $options) = @_;
 381
 382     my $qf = $options->{quote_field_names} ||= '';
 383
 384     my $field_name = $field->name;
 385     debug("PKG: Looking at field '$field_name'\n");
 386     my $field_def = "$qf$field_name$qf";
 387
 388     # data type and size
 389     my $data_type = $field->data_type;
 390     my @size      = $field->size;
 391     my %extra     = $field->extra;
 392     my $list      = $extra{'list'} || [];
 393     # \todo deal with embedded quotes
 394     my $commalist = join( ', ', map { qq['$_'] } @$list );
 395     my $charset = $extra{'mysql_charset'};
 396     my $collate = $extra{'mysql_collate'};
 397
 398     #
 399     # Oracle "number" type -- figure best MySQL type
 400     #
 401     if ( lc $data_type eq 'number' ) {
 402         # not an integer
 403         if ( scalar @size > 1 ) {
 404             $data_type = 'double';
 405         }
 406         elsif ( $size[0] && $size[0] >= 12 ) {
 407             $data_type = 'bigint';
 408         }
 409         elsif ( $size[0] && $size[0] <= 1 ) {
 410             $data_type = 'tinyint';
 411         }
 412         else {
 413             $data_type = 'int';
 414         }
 415     }
 416     #
 417     # Convert a large Oracle varchar to "text"
 418     #
 419     elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
 420         $data_type = 'text';
 421         @size      = ();
 422     }
 423     elsif ( $data_type =~ /boolean/i ) {
 424         $data_type = 'enum';
 425         $commalist = "'0','1'";
 426     }
 427     elsif ( exists $translate{ lc $data_type } ) {
 428         $data_type = $translate{ lc $data_type };
 429     }
 430
 431     @size = () if $data_type =~ /(text|blob)/i;
 432
 433     if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
 434         push @size, '0';
 435     }
 436
 437     $field_def .= " $data_type";
 438
 439     if ( lc $data_type eq 'enum' ) {
 440         $field_def .= '(' . $commalist . ')';
 441     }
 442     elsif ( defined $size[0] && $size[0] > 0 ) {
 443         $field_def .= '(' . join( ', ', @size ) . ')';
 444     }
 445
 446     # char sets
 447     $field_def .= " CHARACTER SET $charset" if $charset;
 448     $field_def .= " COLLATE $collate" if $collate;
 449
 450     # MySQL qualifiers
 451     for my $qual ( qw[ binary unsigned zerofill ] ) {
 452         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 453         $field_def .= " $qual";
 454     }
 455     for my $qual ( 'character set', 'collate', 'on update' ) {
 456         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 457         $field_def .= " $qual $val";
 458     }
 459
 460     # Null?
 461     $field_def .= ' NOT NULL' unless $field->is_nullable;
 462
 463     # Default?  XXX Need better quoting!
 464     my $default = $field->default_value;
 465     if ( defined $default ) {
 466         if ( uc $default eq 'NULL') {
 467             $field_def .= ' DEFAULT NULL';
 468         } else {
 469             $field_def .= " DEFAULT '$default'";
 470         }
 471     }
 472
 473     if ( my $comments = $field->comments ) {
 474         $field_def .= qq[ comment '$comments'];
 475     }
 476
 477     # auto_increment?
 478     $field_def .= " auto_increment" if $field->is_auto_increment;
 479
 480     return $field_def;
 481 }
 482
 483 sub alter_create_index
 484 {
 485     my ($index, $options) = @_;
 486
 487     my $qt = $options->{quote_table_names} || '';
 488     my $qf = $options->{quote_field_names} || '';
 489
 490     return join( ' ',
 491                  'ALTER TABLE',
 492                  $qt.$index->table->name.$qt,
 493                  'ADD',
 494                  create_index(@_)
 495                  );
 496 }
 497
 498 sub create_index
 499 {
 500     my ($index, $options) = @_;
 501
 502     my $qf = $options->{quote_field_names} || '';
 503
 504     return join( ' ',
 505                  lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 506                  $index->name,
 507                  '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 508                  );
 509
 510 }
 511
 512 sub alter_drop_index
 513 {
 514     my ($index, $options) = @_;
 515
 516     my $qt = $options->{quote_table_names} || '';
 517     my $qf = $options->{quote_field_names} || '';
 518
 519     return join( ' ',
 520                  'ALTER TABLE',
 521                  $qt.$index->table->name.$qt,
 522                  'DROP',
 523                  'INDEX',
 524                  $index->name || $index->fields
 525                  );
 526
 527 }
 528
 529 sub alter_drop_constraint
 530 {
 531     my ($c, $options) = @_;
 532
 533     my $qt      = $options->{quote_table_names} || '';
 534     my $qc      = $options->{quote_field_names} || '';
 535
 536     my $out = sprintf('ALTER TABLE %s DROP %s %s',
 537                       $qt . $c->table->name . $qt,
 538                       $c->type eq FOREIGN_KEY ? $c->type : "INDEX",
 539                       $qc . $c->name . $qc );
 540
 541     return $out;
 542 }
 543
 544 sub alter_create_constraint
 545 {
 546     my ($index, $options) = @_;
 547
 548     my $qt = $options->{quote_table_names} || '';
 549     return join( ' ',
 550                  'ALTER TABLE',
 551                  $qt.$index->table->name.$qt,
 552                  'ADD',
 553                  create_constraint(@_) );
 554 }
 555
 556 sub create_constraint
 557 {
 558     my ($c, $options) = @_;
 559
 560     my $qf      = $options->{quote_field_names} || '';
 561     my $qt      = $options->{quote_table_names} || '';
 562     my $leave_name      = $options->{leave_name} || undef;
 563
 564     my @fields = $c->fields or next;
 565
 566     if ( $c->type eq PRIMARY_KEY ) {
 567         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 568     }
 569     elsif ( $c->type eq UNIQUE ) {
 570         return
 571         'UNIQUE '.
 572             (defined $c->name ? $qf.$c->name.$qf.' ' : '').
 573             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
 574     }
 575     elsif ( $c->type eq FOREIGN_KEY ) {
 576         #
 577         # Make sure FK field is indexed or MySQL complains.
 578         #
 579
 580         my $table = $c->table;
 581         my $c_name = $c->name;
 582
 583         my $def = join(' ',
 584                        map { $_ || () }
 585                          'CONSTRAINT',
 586                          $qf . $c_name . $qf,
 587                          'FOREIGN KEY'
 588                       );
 589
 590
 591         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 592
 593         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
 594
 595         my @rfields = map { $_ || () } $c->reference_fields;
 596         unless ( @rfields ) {
 597             my $rtable_name = $c->reference_table;
 598             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 599                 push @rfields, $ref_table->primary_key;
 600             }
 601             else {
 602                 warn "Can't find reference table '$rtable_name' " .
 603                     "in schema\n" if $options->{show_warnings};
 604             }
 605         }
 606
 607         if ( @rfields ) {
 608             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 609         }
 610         else {
 611             warn "FK constraint on " . $table->name . '.' .
 612                 join('', @fields) . " has no reference fields\n"
 613                 if $options->{show_warnings};
 614         }
 615
 616         if ( $c->match_type ) {
 617             $def .= ' MATCH ' .
 618                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 619         }
 620
 621         if ( $c->on_delete ) {
 622             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 623         }
 624
 625         if ( $c->on_update ) {
 626             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 627         }
 628         return $def;
 629     }
 630
 631     return undef;
 632 }
 633
 634 sub alter_table
 635 {
 636     my ($to_table, $options) = @_;
 637
 638     my $qt = $options->{quote_table_names} || '';
 639
 640     my $table_options = generate_table_options($to_table) || '';
 641     my $out = sprintf('ALTER TABLE %s%s',
 642                       $qt . $to_table->name . $qt,
 643                       $table_options);
 644
 645     return $out;
 646 }
 647
 648 sub rename_field { alter_field(@_) }
 649 sub alter_field
 650 {
 651     my ($from_field, $to_field, $options) = @_;
 652
 653     my $qf = $options->{quote_field_names} || '';
 654     my $qt = $options->{quote_table_names} || '';
 655
 656     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 657                       $qt . $to_field->table->name . $qt,
 658                       $qf . $from_field->name . $qf,
 659                       create_field($to_field, $options));
 660
 661     return $out;
 662 }
 663
 664 sub add_field
 665 {
 666     my ($new_field, $options) = @_;
 667
 668     my $qt = $options->{quote_table_names} || '';
 669
 670     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 671                       $qt . $new_field->table->name . $qt,
 672                       create_field($new_field, $options));
 673
 674     return $out;
 675
 676 }
 677
 678 sub drop_field
 679 {
 680     my ($old_field, $options) = @_;
 681
 682     my $qf = $options->{quote_field_names} || '';
 683     my $qt = $options->{quote_table_names} || '';
 684
 685     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 686                       $qt . $old_field->table->name . $qt,
 687                       $qf . $old_field->name . $qf);
 688
 689     return $out;
 690
 691 }
 692
 693 sub batch_alter_table {
 694   my ($table, $diff_hash, $options) = @_;
 695
 696   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 697   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
 698   #
 699   # We have to work round this.
 700
 701   my %fks_to_alter;
 702   my %fks_to_drop = map {
 703     $_->type eq FOREIGN_KEY
 704               ? ( $_->name => $_ )
 705               : ( )
 706   } @{$diff_hash->{alter_drop_constraint} };
 707
 708   my %fks_to_create = map {
 709     if ( $_->type eq FOREIGN_KEY) {
 710       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 711       ( $_->name => $_ );
 712     } else { ( ) }
 713   } @{$diff_hash->{alter_create_constraint} };
 714
 715   my $drop_stmt = '';
 716   if (scalar keys %fks_to_alter) {
 717     $diff_hash->{alter_drop_constraint} = [
 718       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 719     ];
 720
 721     $drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options)
 722                . "\n";
 723
 724   }
 725
 726   my @stmts = map {
 727     if (@{ $diff_hash->{$_} || [] }) {
 728       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 729       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 730     } else { () }
 731   } qw/rename_table
 732        alter_drop_constraint
 733        alter_drop_index
 734        drop_field
 735        add_field
 736        alter_field
 737        rename_field
 738        alter_create_index
 739        alter_create_constraint
 740        alter_table/;
 741
 742   # rename_table makes things a bit more complex
 743   my $renamed_from = "";
 744   $renamed_from = $diff_hash->{rename_table}[0][0]->name
 745     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 746
 747   return unless @stmts;
 748   # Just zero or one stmts. return now
 749   return "$drop_stmt@stmts;" unless @stmts > 1;
 750
 751   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 752
 753   my $qt = $options->{quote_table_names} || '';
 754   my $table_name = $qt . $table->name . $qt;
 755
 756
 757   my $re = $renamed_from
 758          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$qt$renamed_from$qt\E) /
 759             : qr/^ALTER TABLE \Q$table_name\E /;
 760
 761   my $first = shift  @stmts;
 762   my ($alter_table) = $first =~ /($re)/;
 763
 764   my $padd = " " x length($alter_table);
 765
 766   return $drop_stmt . join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts) . ';';
 767
 768 }
 769
 770 sub drop_table {
 771   my ($table, $options) = @_;
 772
 773     my $qt = $options->{quote_table_names} || '';
 774
 775   # Drop (foreign key) constraints so table drops cleanly
 776   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
 777
 778   return join("\n", @sql, "DROP TABLE $qt$table$qt;");
 779
 780 }
 781
 782 sub rename_table {
 783   my ($old_table, $new_table, $options) = @_;
 784
 785   my $qt = $options->{quote_table_names} || '';
 786
 787   return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
 788 }
 789
 790 sub next_unused_name {
 791   my $name       = shift || '';
 792   if ( !defined($used_names{$name}) ) {
 793     $used_names{$name} = $name;
 794     return $name;
 795   }
 796
 797   my $i = 1;
 798   while ( defined($used_names{$name . '_' . $i}) ) {
 799     ++$i;
 800   }
 801   $name .= '_' . $i;
 802   $used_names{$name} = $name;
 803   return $name;
 804 }
 805
 806 1;
 807
 808 # -------------------------------------------------------------------
 809
 810 =pod
 811
 812 =head1 SEE ALSO
 813
 814 SQL::Translator, http://www.mysql.com/.
 815
 816 =head1 AUTHORS
 817
 818 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 819 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 820
 821 =cut