lib/SQL/Translator/Producer/MySQL.pm

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