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