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