lib/SQL/Translator/Producer/MySQL.pm

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