lib/SQL/Translator/Producer/MySQL.pm

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