lib/SQL/Translator/Producer/MySQL.pm

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