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         if ( uc $default eq 'NULL') {
 558             $field_def .= ' DEFAULT NULL';
 559         } else {
 560             $field_def .= " DEFAULT '$default'";
 561         }
 562     }
 563
 564     if ( my $comments = $field->comments ) {
 565         $field_def .= qq[ comment '$comments'];
 566     }
 567
 568     # auto_increment?
 569     $field_def .= " auto_increment" if $field->is_auto_increment;
 570
 571     return $field_def;
 572 }
 573
 574 sub alter_create_index
 575 {
 576     my ($index, $options) = @_;
 577
 578     my $qt = $options->{quote_table_names} || '';
 579     my $qf = $options->{quote_field_names} || '';
 580
 581     return join( ' ',
 582                  'ALTER TABLE',
 583                  $qt.$index->table->name.$qt,
 584                  'ADD',
 585                  create_index(@_)
 586                  );
 587 }
 588
 589 sub create_index
 590 {
 591     my ($index, $options) = @_;
 592
 593     my $qf = $options->{quote_field_names} || '';
 594
 595     return join( ' ',
 596                  lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 597                  truncate_id_uniquely( $index->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ),
 598                  '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 599                  );
 600
 601 }
 602
 603 sub alter_drop_index
 604 {
 605     my ($index, $options) = @_;
 606
 607     my $qt = $options->{quote_table_names} || '';
 608     my $qf = $options->{quote_field_names} || '';
 609
 610     return join( ' ',
 611                  'ALTER TABLE',
 612                  $qt.$index->table->name.$qt,
 613                  'DROP',
 614                  'INDEX',
 615                  $index->name || $index->fields
 616                  );
 617
 618 }
 619
 620 sub alter_drop_constraint
 621 {
 622     my ($c, $options) = @_;
 623
 624     my $qt      = $options->{quote_table_names} || '';
 625     my $qc      = $options->{quote_field_names} || '';
 626
 627     my $out = sprintf('ALTER TABLE %s DROP %s %s',
 628                       $qt . $c->table->name . $qt,
 629                       $c->type eq FOREIGN_KEY ? $c->type : "INDEX",
 630                       $qc . $c->name . $qc );
 631
 632     return $out;
 633 }
 634
 635 sub alter_create_constraint
 636 {
 637     my ($index, $options) = @_;
 638
 639     my $qt = $options->{quote_table_names} || '';
 640     return join( ' ',
 641                  'ALTER TABLE',
 642                  $qt.$index->table->name.$qt,
 643                  'ADD',
 644                  create_constraint(@_) );
 645 }
 646
 647 sub create_constraint
 648 {
 649     my ($c, $options) = @_;
 650
 651     my $qf      = $options->{quote_field_names} || '';
 652     my $qt      = $options->{quote_table_names} || '';
 653     my $leave_name      = $options->{leave_name} || undef;
 654
 655     my @fields = $c->fields or next;
 656
 657     if ( $c->type eq PRIMARY_KEY ) {
 658         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 659     }
 660     elsif ( $c->type eq UNIQUE ) {
 661         return
 662         'UNIQUE '.
 663             (defined $c->name ? $qf.truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ).$qf.' ' : '').
 664             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
 665     }
 666     elsif ( $c->type eq FOREIGN_KEY ) {
 667         #
 668         # Make sure FK field is indexed or MySQL complains.
 669         #
 670
 671         my $table = $c->table;
 672         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
 673
 674         my $def = join(' ',
 675                        map { $_ || () }
 676                          'CONSTRAINT',
 677                          $qf . $c_name . $qf,
 678                          'FOREIGN KEY'
 679                       );
 680
 681
 682         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 683
 684         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
 685
 686         my @rfields = map { $_ || () } $c->reference_fields;
 687         unless ( @rfields ) {
 688             my $rtable_name = $c->reference_table;
 689             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 690                 push @rfields, $ref_table->primary_key;
 691             }
 692             else {
 693                 warn "Can't find reference table '$rtable_name' " .
 694                     "in schema\n" if $options->{show_warnings};
 695             }
 696         }
 697
 698         if ( @rfields ) {
 699             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 700         }
 701         else {
 702             warn "FK constraint on " . $table->name . '.' .
 703                 join('', @fields) . " has no reference fields\n"
 704                 if $options->{show_warnings};
 705         }
 706
 707         if ( $c->match_type ) {
 708             $def .= ' MATCH ' .
 709                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 710         }
 711
 712         if ( $c->on_delete ) {
 713             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 714         }
 715
 716         if ( $c->on_update ) {
 717             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 718         }
 719         return $def;
 720     }
 721
 722     return undef;
 723 }
 724
 725 sub alter_table
 726 {
 727     my ($to_table, $options) = @_;
 728
 729     my $qt = $options->{quote_table_names} || '';
 730
 731     my $table_options = generate_table_options($to_table) || '';
 732     my $out = sprintf('ALTER TABLE %s%s',
 733                       $qt . $to_table->name . $qt,
 734                       $table_options);
 735
 736     return $out;
 737 }
 738
 739 sub rename_field { alter_field(@_) }
 740 sub alter_field
 741 {
 742     my ($from_field, $to_field, $options) = @_;
 743
 744     my $qf = $options->{quote_field_names} || '';
 745     my $qt = $options->{quote_table_names} || '';
 746
 747     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 748                       $qt . $to_field->table->name . $qt,
 749                       $qf . $from_field->name . $qf,
 750                       create_field($to_field, $options));
 751
 752     return $out;
 753 }
 754
 755 sub add_field
 756 {
 757     my ($new_field, $options) = @_;
 758
 759     my $qt = $options->{quote_table_names} || '';
 760
 761     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 762                       $qt . $new_field->table->name . $qt,
 763                       create_field($new_field, $options));
 764
 765     return $out;
 766
 767 }
 768
 769 sub drop_field
 770 {
 771     my ($old_field, $options) = @_;
 772
 773     my $qf = $options->{quote_field_names} || '';
 774     my $qt = $options->{quote_table_names} || '';
 775
 776     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 777                       $qt . $old_field->table->name . $qt,
 778                       $qf . $old_field->name . $qf);
 779
 780     return $out;
 781
 782 }
 783
 784 sub batch_alter_table {
 785   my ($table, $diff_hash, $options) = @_;
 786
 787   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 788   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
 789   #
 790   # We have to work round this.
 791
 792   my %fks_to_alter;
 793   my %fks_to_drop = map {
 794     $_->type eq FOREIGN_KEY
 795               ? ( $_->name => $_ )
 796               : ( )
 797   } @{$diff_hash->{alter_drop_constraint} };
 798
 799   my %fks_to_create = map {
 800     if ( $_->type eq FOREIGN_KEY) {
 801       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 802       ( $_->name => $_ );
 803     } else { ( ) }
 804   } @{$diff_hash->{alter_create_constraint} };
 805
 806   my @drop_stmt;
 807   if (scalar keys %fks_to_alter) {
 808     $diff_hash->{alter_drop_constraint} = [
 809       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 810     ];
 811
 812     @drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options);
 813
 814   }
 815
 816   my @stmts = map {
 817     if (@{ $diff_hash->{$_} || [] }) {
 818       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 819       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 820     } else { () }
 821   } qw/rename_table
 822        alter_drop_constraint
 823        alter_drop_index
 824        drop_field
 825        add_field
 826        alter_field
 827        rename_field
 828        alter_create_index
 829        alter_create_constraint
 830        alter_table/;
 831
 832   # rename_table makes things a bit more complex
 833   my $renamed_from = "";
 834   $renamed_from = $diff_hash->{rename_table}[0][0]->name
 835     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 836
 837   return unless @stmts;
 838   # Just zero or one stmts. return now
 839   return (@drop_stmt,@stmts) unless @stmts > 1;
 840
 841   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 842
 843   my $qt = $options->{quote_table_names} || '';
 844   my $table_name = $qt . $table->name . $qt;
 845
 846
 847   my $re = $renamed_from
 848          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$qt$renamed_from$qt\E) /
 849             : qr/^ALTER TABLE \Q$table_name\E /;
 850
 851   my $first = shift  @stmts;
 852   my ($alter_table) = $first =~ /($re)/;
 853
 854   my $padd = " " x length($alter_table);
 855
 856   return @drop_stmt, join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts);
 857
 858 }
 859
 860 sub drop_table {
 861   my ($table, $options) = @_;
 862
 863     my $qt = $options->{quote_table_names} || '';
 864
 865   # Drop (foreign key) constraints so table drops cleanly
 866   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
 867
 868   return (@sql, "DROP TABLE $qt$table$qt");
 869 #  return join("\n", @sql, "DROP TABLE $qt$table$qt");
 870
 871 }
 872
 873 sub rename_table {
 874   my ($old_table, $new_table, $options) = @_;
 875
 876   my $qt = $options->{quote_table_names} || '';
 877
 878   return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
 879 }
 880
 881 sub next_unused_name {
 882   my $name       = shift || '';
 883   if ( !defined($used_names{$name}) ) {
 884     $used_names{$name} = $name;
 885     return $name;
 886   }
 887
 888   my $i = 1;
 889   while ( defined($used_names{$name . '_' . $i}) ) {
 890     ++$i;
 891   }
 892   $name .= '_' . $i;
 893   $used_names{$name} = $name;
 894   return $name;
 895 }
 896
 897 1;
 898
 899 # -------------------------------------------------------------------
 900
 901 =pod
 902
 903 =head1 SEE ALSO
 904
 905 SQL::Translator, http://www.mysql.com/.
 906
 907 =head1 AUTHORS
 908
 909 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 910 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 911
 912 =cut