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     for my $view ( $schema->get_views ) {
 290 #        print $view->name, "\n";
 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 #    print "@table_defs\n";
 304     push @table_defs, "SET foreign_key_checks=1;\n\n";
 305
 306     return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
 307 }
 308
 309 sub create_view {
 310     my ($view, $options) = @_;
 311     my $qt = $options->{quote_table_names} || '';
 312     my $qf = $options->{quote_field_names} || '';
 313
 314     my $view_name = $view->name;
 315     debug("PKG: Looking at view '${view_name}'\n");
 316
 317     # Header.  Should this look like what mysqldump produces?
 318     my $create = '';
 319     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n" unless $options->{no_comments};
 320     $create .= 'CREATE';
 321     $create .= ' OR REPLACE' if $options->{add_replace_view};
 322     $create .= "\n";
 323
 324     my $extra = $view->extra;
 325     # ALGORITHM
 326     if( exists($extra->{mysql_algorithm}) && defined(my $algorithm = $extra->{mysql_algorithm}) ){
 327       $create .= "   ALGORITHM = ${algorithm}\n" if $algorithm =~ /(?:UNDEFINED|MERGE|TEMPTABLE)/i;
 328     }
 329     # DEFINER
 330     if( exists($extra->{mysql_definer}) && defined(my $user = $extra->{mysql_definer}) ){
 331       $create .= "   DEFINER = ${user}\n";
 332     }
 333     # SECURITY
 334     if( exists($extra->{mysql_security}) && defined(my $security = $extra->{mysql_security}) ){
 335       $create .= "   SQL SECURITY ${security}\n" if $security =~ /(?:DEFINER|INVOKER)/i;
 336     }
 337
 338     #Header, cont.
 339     $create .= "  VIEW ${qt}${view_name}${qt}";
 340
 341     if( my @fields = $view->fields ){
 342       my $list = join ', ', map { "${qf}${_}${qf}"} @fields;
 343       $create .= " ( ${list} )";
 344     }
 345     if( my $sql = $view->sql ){
 346       $create .= " AS (\n    ${sql}\n  )";
 347     }
 348     $create .= ";\n\n";
 349     return $create;
 350 }
 351
 352 sub create_table
 353 {
 354     my ($table, $options) = @_;
 355
 356     my $qt = $options->{quote_table_names} || '';
 357     my $qf = $options->{quote_field_names} || '';
 358
 359     my $table_name = $table->name;
 360     debug("PKG: Looking at table '$table_name'\n");
 361
 362     #
 363     # Header.  Should this look like what mysqldump produces?
 364     #
 365     my $create = '';
 366     my $drop;
 367     $create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
 368     $drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
 369     $create .= "CREATE TABLE $qt$table_name$qt (\n";
 370
 371     #
 372     # Fields
 373     #
 374     my @field_defs;
 375     for my $field ( $table->get_fields ) {
 376         push @field_defs, create_field($field, $options);
 377     }
 378
 379     #
 380     # Indices
 381     #
 382     my @index_defs;
 383     my %indexed_fields;
 384     for my $index ( $table->get_indices ) {
 385         push @index_defs, create_index($index, $options);
 386         $indexed_fields{ $_ } = 1 for $index->fields;
 387     }
 388
 389     #
 390     # Constraints -- need to handle more than just FK. -ky
 391     #
 392     my @constraint_defs;
 393     my @constraints = $table->get_constraints;
 394     for my $c ( @constraints ) {
 395         my $constr = create_constraint($c, $options);
 396         push @constraint_defs, $constr if($constr);
 397
 398          unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
 399              push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
 400              $indexed_fields{ ($c->fields())[0] } = 1;
 401          }
 402     }
 403
 404     $create .= join(",\n", map { "  $_" }
 405                     @field_defs, @index_defs, @constraint_defs
 406                     );
 407
 408     #
 409     # Footer
 410     #
 411     $create .= "\n)";
 412     $create .= generate_table_options($table) || '';
 413     $create .= ";\n\n";
 414
 415     return $drop ? ($drop,$create) : $create;
 416 }
 417
 418 sub generate_table_options
 419 {
 420   my ($table) = @_;
 421   my $create;
 422
 423   my $table_type_defined = 0;
 424   my $charset          = $table->extra('mysql_charset');
 425   my $collate          = $table->extra('mysql_collate');
 426   for my $t1_option_ref ( $table->options ) {
 427     my($key, $value) = %{$t1_option_ref};
 428     $table_type_defined = 1
 429       if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
 430     if (uc $key eq 'CHARACTER SET') {
 431       $charset = $value;
 432       next;
 433     } elsif (uc $key eq 'COLLATE') {
 434       $collate = $value;
 435       next;
 436     }
 437     $create .= " $key=$value";
 438   }
 439
 440   my $mysql_table_type = $table->extra('mysql_table_type');
 441   $create .= " ENGINE=$mysql_table_type"
 442     if $mysql_table_type && !$table_type_defined;
 443   my $comments         = $table->comments;
 444
 445   $create .= " DEFAULT CHARACTER SET $charset" if $charset;
 446   $create .= " COLLATE $collate" if $collate;
 447   $create .= qq[ comment='$comments'] if $comments;
 448   return $create;
 449 }
 450
 451 sub create_field
 452 {
 453     my ($field, $options) = @_;
 454
 455     my $qf = $options->{quote_field_names} ||= '';
 456
 457     my $field_name = $field->name;
 458     debug("PKG: Looking at field '$field_name'\n");
 459     my $field_def = "$qf$field_name$qf";
 460
 461     # data type and size
 462     my $data_type = $field->data_type;
 463     my @size      = $field->size;
 464     my %extra     = $field->extra;
 465     my $list      = $extra{'list'} || [];
 466     # \todo deal with embedded quotes
 467     my $commalist = join( ', ', map { qq['$_'] } @$list );
 468     my $charset = $extra{'mysql_charset'};
 469     my $collate = $extra{'mysql_collate'};
 470
 471     #
 472     # Oracle "number" type -- figure best MySQL type
 473     #
 474     if ( lc $data_type eq 'number' ) {
 475         # not an integer
 476         if ( scalar @size > 1 ) {
 477             $data_type = 'double';
 478         }
 479         elsif ( $size[0] && $size[0] >= 12 ) {
 480             $data_type = 'bigint';
 481         }
 482         elsif ( $size[0] && $size[0] <= 1 ) {
 483             $data_type = 'tinyint';
 484         }
 485         else {
 486             $data_type = 'int';
 487         }
 488     }
 489     #
 490     # Convert a large Oracle varchar to "text"
 491     #
 492     elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
 493         $data_type = 'text';
 494         @size      = ();
 495     }
 496     elsif ( $data_type =~ /boolean/i ) {
 497         my $mysql_version = $options->{mysql_version} || 0;
 498         if ($mysql_version >= 4) {
 499             $data_type = 'boolean';
 500         } else {
 501             $data_type = 'enum';
 502             $commalist = "'0','1'";
 503         }
 504     }
 505     elsif ( exists $translate{ lc $data_type } ) {
 506         $data_type = $translate{ lc $data_type };
 507     }
 508
 509     @size = () if $data_type =~ /(text|blob)/i;
 510
 511     if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
 512         push @size, '0';
 513     }
 514
 515     $field_def .= " $data_type";
 516
 517     if ( lc($data_type) eq 'enum' || lc($data_type) eq 'set') {
 518         $field_def .= '(' . $commalist . ')';
 519     }
 520     elsif ( defined $size[0] && $size[0] > 0 ) {
 521         $field_def .= '(' . join( ', ', @size ) . ')';
 522     }
 523
 524     # char sets
 525     $field_def .= " CHARACTER SET $charset" if $charset;
 526     $field_def .= " COLLATE $collate" if $collate;
 527
 528     # MySQL qualifiers
 529     for my $qual ( qw[ binary unsigned zerofill ] ) {
 530         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 531         $field_def .= " $qual";
 532     }
 533     for my $qual ( 'character set', 'collate', 'on update' ) {
 534         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 535         $field_def .= " $qual $val";
 536     }
 537
 538     # Null?
 539     $field_def .= ' NOT NULL' unless $field->is_nullable;
 540
 541     # Default?  XXX Need better quoting!
 542     my $default = $field->default_value;
 543     if ( defined $default ) {
 544         if ( uc $default eq 'NULL') {
 545             $field_def .= ' DEFAULT NULL';
 546         } else {
 547             $field_def .= " DEFAULT '$default'";
 548         }
 549     }
 550
 551     if ( my $comments = $field->comments ) {
 552         $field_def .= qq[ comment '$comments'];
 553     }
 554
 555     # auto_increment?
 556     $field_def .= " auto_increment" if $field->is_auto_increment;
 557
 558     return $field_def;
 559 }
 560
 561 sub alter_create_index
 562 {
 563     my ($index, $options) = @_;
 564
 565     my $qt = $options->{quote_table_names} || '';
 566     my $qf = $options->{quote_field_names} || '';
 567
 568     return join( ' ',
 569                  'ALTER TABLE',
 570                  $qt.$index->table->name.$qt,
 571                  'ADD',
 572                  create_index(@_)
 573                  );
 574 }
 575
 576 sub create_index
 577 {
 578     my ($index, $options) = @_;
 579
 580     my $qf = $options->{quote_field_names} || '';
 581
 582     return join( ' ',
 583                  lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 584                  truncate_id_uniquely( $index->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ),
 585                  '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 586                  );
 587
 588 }
 589
 590 sub alter_drop_index
 591 {
 592     my ($index, $options) = @_;
 593
 594     my $qt = $options->{quote_table_names} || '';
 595     my $qf = $options->{quote_field_names} || '';
 596
 597     return join( ' ',
 598                  'ALTER TABLE',
 599                  $qt.$index->table->name.$qt,
 600                  'DROP',
 601                  'INDEX',
 602                  $index->name || $index->fields
 603                  );
 604
 605 }
 606
 607 sub alter_drop_constraint
 608 {
 609     my ($c, $options) = @_;
 610
 611     my $qt      = $options->{quote_table_names} || '';
 612     my $qc      = $options->{quote_field_names} || '';
 613
 614     my $out = sprintf('ALTER TABLE %s DROP %s %s',
 615                       $qt . $c->table->name . $qt,
 616                       $c->type eq FOREIGN_KEY ? $c->type : "INDEX",
 617                       $qc . $c->name . $qc );
 618
 619     return $out;
 620 }
 621
 622 sub alter_create_constraint
 623 {
 624     my ($index, $options) = @_;
 625
 626     my $qt = $options->{quote_table_names} || '';
 627     return join( ' ',
 628                  'ALTER TABLE',
 629                  $qt.$index->table->name.$qt,
 630                  'ADD',
 631                  create_constraint(@_) );
 632 }
 633
 634 sub create_constraint
 635 {
 636     my ($c, $options) = @_;
 637
 638     my $qf      = $options->{quote_field_names} || '';
 639     my $qt      = $options->{quote_table_names} || '';
 640     my $leave_name      = $options->{leave_name} || undef;
 641
 642     my @fields = $c->fields or next;
 643
 644     if ( $c->type eq PRIMARY_KEY ) {
 645         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 646     }
 647     elsif ( $c->type eq UNIQUE ) {
 648         return
 649         'UNIQUE '.
 650             (defined $c->name ? $qf.truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ).$qf.' ' : '').
 651             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
 652     }
 653     elsif ( $c->type eq FOREIGN_KEY ) {
 654         #
 655         # Make sure FK field is indexed or MySQL complains.
 656         #
 657
 658         my $table = $c->table;
 659         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
 660
 661         my $def = join(' ',
 662                        map { $_ || () }
 663                          'CONSTRAINT',
 664                          $qf . $c_name . $qf,
 665                          'FOREIGN KEY'
 666                       );
 667
 668
 669         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 670
 671         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
 672
 673         my @rfields = map { $_ || () } $c->reference_fields;
 674         unless ( @rfields ) {
 675             my $rtable_name = $c->reference_table;
 676             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 677                 push @rfields, $ref_table->primary_key;
 678             }
 679             else {
 680                 warn "Can't find reference table '$rtable_name' " .
 681                     "in schema\n" if $options->{show_warnings};
 682             }
 683         }
 684
 685         if ( @rfields ) {
 686             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 687         }
 688         else {
 689             warn "FK constraint on " . $table->name . '.' .
 690                 join('', @fields) . " has no reference fields\n"
 691                 if $options->{show_warnings};
 692         }
 693
 694         if ( $c->match_type ) {
 695             $def .= ' MATCH ' .
 696                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 697         }
 698
 699         if ( $c->on_delete ) {
 700             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 701         }
 702
 703         if ( $c->on_update ) {
 704             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 705         }
 706         return $def;
 707     }
 708
 709     return undef;
 710 }
 711
 712 sub alter_table
 713 {
 714     my ($to_table, $options) = @_;
 715
 716     my $qt = $options->{quote_table_names} || '';
 717
 718     my $table_options = generate_table_options($to_table) || '';
 719     my $out = sprintf('ALTER TABLE %s%s',
 720                       $qt . $to_table->name . $qt,
 721                       $table_options);
 722
 723     return $out;
 724 }
 725
 726 sub rename_field { alter_field(@_) }
 727 sub alter_field
 728 {
 729     my ($from_field, $to_field, $options) = @_;
 730
 731     my $qf = $options->{quote_field_names} || '';
 732     my $qt = $options->{quote_table_names} || '';
 733
 734     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 735                       $qt . $to_field->table->name . $qt,
 736                       $qf . $from_field->name . $qf,
 737                       create_field($to_field, $options));
 738
 739     return $out;
 740 }
 741
 742 sub add_field
 743 {
 744     my ($new_field, $options) = @_;
 745
 746     my $qt = $options->{quote_table_names} || '';
 747
 748     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 749                       $qt . $new_field->table->name . $qt,
 750                       create_field($new_field, $options));
 751
 752     return $out;
 753
 754 }
 755
 756 sub drop_field
 757 {
 758     my ($old_field, $options) = @_;
 759
 760     my $qf = $options->{quote_field_names} || '';
 761     my $qt = $options->{quote_table_names} || '';
 762
 763     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 764                       $qt . $old_field->table->name . $qt,
 765                       $qf . $old_field->name . $qf);
 766
 767     return $out;
 768
 769 }
 770
 771 sub batch_alter_table {
 772   my ($table, $diff_hash, $options) = @_;
 773
 774   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 775   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
 776   #
 777   # We have to work round this.
 778
 779   my %fks_to_alter;
 780   my %fks_to_drop = map {
 781     $_->type eq FOREIGN_KEY
 782               ? ( $_->name => $_ )
 783               : ( )
 784   } @{$diff_hash->{alter_drop_constraint} };
 785
 786   my %fks_to_create = map {
 787     if ( $_->type eq FOREIGN_KEY) {
 788       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 789       ( $_->name => $_ );
 790     } else { ( ) }
 791   } @{$diff_hash->{alter_create_constraint} };
 792
 793   my $drop_stmt = '';
 794   if (scalar keys %fks_to_alter) {
 795     $diff_hash->{alter_drop_constraint} = [
 796       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 797     ];
 798
 799     $drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options)
 800                . "\n";
 801
 802   }
 803
 804   my @stmts = map {
 805     if (@{ $diff_hash->{$_} || [] }) {
 806       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 807       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 808     } else { () }
 809   } qw/rename_table
 810        alter_drop_constraint
 811        alter_drop_index
 812        drop_field
 813        add_field
 814        alter_field
 815        rename_field
 816        alter_create_index
 817        alter_create_constraint
 818        alter_table/;
 819
 820   # rename_table makes things a bit more complex
 821   my $renamed_from = "";
 822   $renamed_from = $diff_hash->{rename_table}[0][0]->name
 823     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 824
 825   return unless @stmts;
 826   # Just zero or one stmts. return now
 827   return "$drop_stmt@stmts;" unless @stmts > 1;
 828
 829   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 830
 831   my $qt = $options->{quote_table_names} || '';
 832   my $table_name = $qt . $table->name . $qt;
 833
 834
 835   my $re = $renamed_from
 836          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$qt$renamed_from$qt\E) /
 837             : qr/^ALTER TABLE \Q$table_name\E /;
 838
 839   my $first = shift  @stmts;
 840   my ($alter_table) = $first =~ /($re)/;
 841
 842   my $padd = " " x length($alter_table);
 843
 844   return $drop_stmt . join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts) . ';';
 845
 846 }
 847
 848 sub drop_table {
 849   my ($table, $options) = @_;
 850
 851     my $qt = $options->{quote_table_names} || '';
 852
 853   # Drop (foreign key) constraints so table drops cleanly
 854   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
 855
 856   return join("\n", @sql, "DROP TABLE $qt$table$qt;");
 857
 858 }
 859
 860 sub rename_table {
 861   my ($old_table, $new_table, $options) = @_;
 862
 863   my $qt = $options->{quote_table_names} || '';
 864
 865   return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
 866 }
 867
 868 sub next_unused_name {
 869   my $name       = shift || '';
 870   if ( !defined($used_names{$name}) ) {
 871     $used_names{$name} = $name;
 872     return $name;
 873   }
 874
 875   my $i = 1;
 876   while ( defined($used_names{$name . '_' . $i}) ) {
 877     ++$i;
 878   }
 879   $name .= '_' . $i;
 880   $used_names{$name} = $name;
 881   return $name;
 882 }
 883
 884 1;
 885
 886 # -------------------------------------------------------------------
 887
 888 =pod
 889
 890 =head1 SEE ALSO
 891
 892 SQL::Translator, http://www.mysql.com/.
 893
 894 =head1 AUTHORS
 895
 896 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 897 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 898
 899 =cut