lib/SQL/Translator/Producer/MySQL.pm

   1 package SQL::Translator::Producer::MySQL;
   2
   3 =head1 NAME
   4
   5 SQL::Translator::Producer::MySQL - MySQL-specific producer for SQL::Translator
   6
   7 =head1 SYNOPSIS
   8
   9 Use via SQL::Translator:
  10
  11   use SQL::Translator;
  12
  13   my $t = SQL::Translator->new( parser => '...', producer => 'MySQL', '...' );
  14   $t->translate;
  15
  16 =head1 DESCRIPTION
  17
  18 This module will produce text output of the schema suitable for MySQL.
  19 There are still some issues to be worked out with syntax differences
  20 between MySQL versions 3 and 4 ("SET foreign_key_checks," character sets
  21 for fields, etc.).
  22
  23 =head1 ARGUMENTS
  24
  25 This producer takes a single optional producer_arg C<mysql_version>, which
  26 provides the desired version for the target database. By default MySQL v3 is
  27 assumed, and statements pertaining to any features introduced in later versions
  28 (e.g. CREATE VIEW) are not produced.
  29
  30 Valid version specifiers for C<mysql_version> are listed L<here|SQL::Translator::Utils/parse_mysql_version>
  31
  32 =head2 Table Types
  33
  34 Normally the tables will be created without any explicit table type given and
  35 so will use the MySQL default.
  36
  37 Any tables involved in foreign key constraints automatically get a table type
  38 of InnoDB, unless this is overridden by setting the C<mysql_table_type> extra
  39 attribute explicitly on the table.
  40
  41 =head2 Extra attributes.
  42
  43 The producer recognises the following extra attributes on the Schema objects.
  44
  45 =over 4
  46
  47 =item B<field.list>
  48
  49 Set the list of allowed values for Enum fields.
  50
  51 =item B<field.binary>, B<field.unsigned>, B<field.zerofill>
  52
  53 Set the MySQL field options of the same name.
  54
  55 =item B<field.renamed_from>, B<table.renamed_from>
  56
  57 Use when producing diffs to indicate that the current table/field has been
  58 renamed from the old name as given in the attribute value.
  59
  60 =item B<table.mysql_table_type>
  61
  62 Set the type of the table e.g. 'InnoDB', 'MyISAM'. This will be
  63 automatically set for tables involved in foreign key constraints if it is
  64 not already set explicitly. See L<"Table Types">.
  65
  66 Please note that the C<ENGINE> option is the preferred method of specifying
  67 the MySQL storage engine to use, but this method still works for backwards
  68 compatibility.
  69
  70 =item B<table.mysql_charset>, B<table.mysql_collate>
  71
  72 Set the tables default charater set and collation order.
  73
  74 =item B<field.mysql_charset>, B<field.mysql_collate>
  75
  76 Set the fields charater set and collation order.
  77
  78 =back
  79
  80 =cut
  81
  82 use strict;
  83 use warnings;
  84 our ( $DEBUG, %used_names );
  85 our $VERSION = '1.59';
  86 $DEBUG   = 0 unless defined $DEBUG;
  87
  88 # Maximum length for most identifiers is 64, according to:
  89 #   http://dev.mysql.com/doc/refman/4.1/en/identifiers.html
  90 #   http://dev.mysql.com/doc/refman/5.0/en/identifiers.html
  91 my $DEFAULT_MAX_ID_LENGTH = 64;
  92
  93 use Data::Dumper;
  94 use SQL::Translator::Schema::Constants;
  95 use SQL::Translator::Utils qw(debug header_comment
  96     truncate_id_uniquely parse_mysql_version);
  97
  98 #
  99 # Use only lowercase for the keys (e.g. "long" and not "LONG")
 100 #
 101 my %translate  = (
 102     #
 103     # Oracle types
 104     #
 105     varchar2   => 'varchar',
 106     long       => 'text',
 107     clob       => 'longtext',
 108
 109     #
 110     # Sybase types
 111     #
 112     int        => 'integer',
 113     money      => 'float',
 114     real       => 'double',
 115     comment    => 'text',
 116     bit        => 'tinyint',
 117
 118     #
 119     # Access types
 120     #
 121     'long integer' => 'integer',
 122     'text'         => 'text',
 123     'datetime'     => 'datetime',
 124
 125     #
 126     # PostgreSQL types
 127     #
 128     bytea => 'BLOB',
 129 );
 130
 131 #
 132 # Column types that do not support lenth attribute
 133 #
 134 my @no_length_attr = qw/
 135   date time timestamp datetime year
 136   /;
 137
 138
 139 sub preprocess_schema {
 140     my ($schema) = @_;
 141
 142     # extra->{mysql_table_type} used to be the type. It belongs in options, so
 143     # move it if we find it. Return Engine type if found in extra or options
 144     # Similarly for mysql_charset and mysql_collate
 145     my $extra_to_options = sub {
 146       my ($table, $extra_name, $opt_name) = @_;
 147
 148       my $extra = $table->extra;
 149
 150       my $extra_type = delete $extra->{$extra_name};
 151
 152       # Now just to find if there is already an Engine or Type option...
 153       # and lets normalize it to ENGINE since:
 154       #
 155       # The ENGINE table option specifies the storage engine for the table.
 156       # TYPE is a synonym, but ENGINE is the preferred option name.
 157       #
 158
 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  = parse_mysql_version ($producer_args->{mysql_version}, 'perl') || 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     my @create = "SET foreign_key_checks=0";
 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.000001) {
 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     if ($mysql_version >= 5.000002) {
 304       for my $trigger ( $schema->get_triggers ) {
 305         push @table_defs, create_trigger($trigger,
 306                                          { add_drop_trigger  => $add_drop_table,
 307                                            show_warnings        => $show_warnings,
 308                                            no_comments          => $no_comments,
 309                                            quote_table_names    => $qt,
 310                                            quote_field_names    => $qf,
 311                                            max_id_length        => $max_id_length,
 312                                            mysql_version        => $mysql_version
 313                                            });
 314       }
 315     }
 316
 317
 318 #    print "@table_defs\n";
 319     push @table_defs, "SET foreign_key_checks=1";
 320
 321     return wantarray ? ($create ? $create : (), @create, @table_defs) : ($create . join('', map { $_ ? "$_;\n\n" : () } (@create, @table_defs)));
 322 }
 323
 324 sub create_trigger {
 325     my ($trigger, $options) = @_;
 326     my $qt = $options->{quote_table_names} || '';
 327     my $qf = $options->{quote_field_names} || '';
 328
 329     my $trigger_name = $trigger->name;
 330     debug("PKG: Looking at trigger '${trigger_name}'\n");
 331
 332     my @statements;
 333
 334     my $events = $trigger->database_events;
 335     for my $event ( @$events ) {
 336         my $name = $trigger_name;
 337         if (@$events > 1) {
 338             $name .= "_$event";
 339
 340             warn "Multiple database events supplied for trigger '${trigger_name}', ",
 341                 "creating trigger '${name}'  for the '${event}' event\n"
 342                     if $options->{show_warnings};
 343         }
 344
 345         my $action = $trigger->action;
 346         $action .= ";" unless $action =~ /;\s*\z/;
 347
 348         push @statements, "DROP TRIGGER IF EXISTS ${qt}${name}${qt}" if $options->{add_drop_trigger};
 349         push @statements, sprintf(
 350             "CREATE TRIGGER ${qt}%s${qt} %s %s ON ${qt}%s${qt}\n  FOR EACH ROW BEGIN %s END",
 351             $name, $trigger->perform_action_when, $event, $trigger->on_table, $action,
 352         );
 353
 354     }
 355     # Tack the comment onto the first statement
 356     $statements[0] = "--\n-- Trigger ${qt}${trigger_name}${qt}\n--\n" . $statements[0] unless $options->{no_comments};
 357     return @statements;
 358 }
 359
 360 sub create_view {
 361     my ($view, $options) = @_;
 362     my $qt = $options->{quote_table_names} || '';
 363     my $qf = $options->{quote_field_names} || '';
 364
 365     my $view_name = $view->name;
 366     debug("PKG: Looking at view '${view_name}'\n");
 367
 368     # Header.  Should this look like what mysqldump produces?
 369     my $create = '';
 370     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n" unless $options->{no_comments};
 371     $create .= 'CREATE';
 372     $create .= ' OR REPLACE' if $options->{add_replace_view};
 373     $create .= "\n";
 374
 375     my $extra = $view->extra;
 376     # ALGORITHM
 377     if( exists($extra->{mysql_algorithm}) && defined(my $algorithm = $extra->{mysql_algorithm}) ){
 378       $create .= "   ALGORITHM = ${algorithm}\n" if $algorithm =~ /(?:UNDEFINED|MERGE|TEMPTABLE)/i;
 379     }
 380     # DEFINER
 381     if( exists($extra->{mysql_definer}) && defined(my $user = $extra->{mysql_definer}) ){
 382       $create .= "   DEFINER = ${user}\n";
 383     }
 384     # SECURITY
 385     if( exists($extra->{mysql_security}) && defined(my $security = $extra->{mysql_security}) ){
 386       $create .= "   SQL SECURITY ${security}\n" if $security =~ /(?:DEFINER|INVOKER)/i;
 387     }
 388
 389     #Header, cont.
 390     $create .= "  VIEW ${qt}${view_name}${qt}";
 391
 392     if( my @fields = $view->fields ){
 393       my $list = join ', ', map { "${qf}${_}${qf}"} @fields;
 394       $create .= " ( ${list} )";
 395     }
 396     if( my $sql = $view->sql ){
 397       # do not wrap parenthesis around the selector, mysql doesn't like this
 398       # http://bugs.mysql.com/bug.php?id=9198
 399       $create .= " AS\n    ${sql}\n";
 400     }
 401 #    $create .= "";
 402     return $create;
 403 }
 404
 405 sub create_table
 406 {
 407     my ($table, $options) = @_;
 408
 409     my $qt = $options->{quote_table_names} || '';
 410     my $qf = $options->{quote_field_names} || '';
 411
 412     my $table_name = quote_table_name($table->name, $qt);
 413     debug("PKG: Looking at table '$table_name'\n");
 414
 415     #
 416     # Header.  Should this look like what mysqldump produces?
 417     #
 418     my $create = '';
 419     my $drop;
 420     $create .= "--\n-- Table: $table_name\n--\n" unless $options->{no_comments};
 421     $drop = qq[DROP TABLE IF EXISTS $table_name] if $options->{add_drop_table};
 422     $create .= "CREATE TABLE $table_name (\n";
 423
 424     #
 425     # Fields
 426     #
 427     my @field_defs;
 428     for my $field ( $table->get_fields ) {
 429         push @field_defs, create_field($field, $options);
 430     }
 431
 432     #
 433     # Indices
 434     #
 435     my @index_defs;
 436     my %indexed_fields;
 437     for my $index ( $table->get_indices ) {
 438         push @index_defs, create_index($index, $options);
 439         $indexed_fields{ $_ } = 1 for $index->fields;
 440     }
 441
 442     #
 443     # Constraints -- need to handle more than just FK. -ky
 444     #
 445     my @constraint_defs;
 446     my @constraints = $table->get_constraints;
 447     for my $c ( @constraints ) {
 448         my $constr = create_constraint($c, $options);
 449         push @constraint_defs, $constr if($constr);
 450
 451          unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
 452              push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
 453              $indexed_fields{ ($c->fields())[0] } = 1;
 454          }
 455     }
 456
 457     $create .= join(",\n", map { "  $_" }
 458                     @field_defs, @index_defs, @constraint_defs
 459                     );
 460
 461     #
 462     # Footer
 463     #
 464     $create .= "\n)";
 465     $create .= generate_table_options($table, $options) || '';
 466 #    $create .= ";\n\n";
 467
 468     return $drop ? ($drop,$create) : $create;
 469 }
 470
 471 sub quote_table_name {
 472   my ($table_name, $qt) = @_;
 473
 474   $table_name =~ s/\./$qt.$qt/g;
 475
 476   return "$qt$table_name$qt";
 477 }
 478
 479 sub generate_table_options
 480 {
 481   my ($table, $options) = @_;
 482   my $create;
 483
 484   my $table_type_defined = 0;
 485   my $qf               = $options->{quote_field_names} ||= '';
 486   my $charset          = $table->extra('mysql_charset');
 487   my $collate          = $table->extra('mysql_collate');
 488   my $union            = undef;
 489   for my $t1_option_ref ( $table->options ) {
 490     my($key, $value) = %{$t1_option_ref};
 491     $table_type_defined = 1
 492       if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
 493     if (uc $key eq 'CHARACTER SET') {
 494       $charset = $value;
 495       next;
 496     } elsif (uc $key eq 'COLLATE') {
 497       $collate = $value;
 498       next;
 499     } elsif (uc $key eq 'UNION') {
 500       $union = "($qf". join("$qf, $qf", @$value) ."$qf)";
 501       next;
 502     }
 503     $create .= " $key=$value";
 504   }
 505
 506   my $mysql_table_type = $table->extra('mysql_table_type');
 507   $create .= " ENGINE=$mysql_table_type"
 508     if $mysql_table_type && !$table_type_defined;
 509   my $comments         = $table->comments;
 510
 511   $create .= " DEFAULT CHARACTER SET $charset" if $charset;
 512   $create .= " COLLATE $collate" if $collate;
 513   $create .= " UNION=$union" if $union;
 514   $create .= qq[ comment='$comments'] if $comments;
 515   return $create;
 516 }
 517
 518 sub create_field
 519 {
 520     my ($field, $options) = @_;
 521
 522     my $qf = $options->{quote_field_names} ||= '';
 523
 524     my $field_name = $field->name;
 525     debug("PKG: Looking at field '$field_name'\n");
 526     my $field_def = "$qf$field_name$qf";
 527
 528     # data type and size
 529     my $data_type = $field->data_type;
 530     my @size      = $field->size;
 531     my %extra     = $field->extra;
 532     my $list      = $extra{'list'} || [];
 533     # \todo deal with embedded quotes
 534     my $commalist = join( ', ', map { qq['$_'] } @$list );
 535     my $charset = $extra{'mysql_charset'};
 536     my $collate = $extra{'mysql_collate'};
 537
 538     my $mysql_version = $options->{mysql_version} || 0;
 539     #
 540     # Oracle "number" type -- figure best MySQL type
 541     #
 542     if ( lc $data_type eq 'number' ) {
 543         # not an integer
 544         if ( scalar @size > 1 ) {
 545             $data_type = 'double';
 546         }
 547         elsif ( $size[0] && $size[0] >= 12 ) {
 548             $data_type = 'bigint';
 549         }
 550         elsif ( $size[0] && $size[0] <= 1 ) {
 551             $data_type = 'tinyint';
 552         }
 553         else {
 554             $data_type = 'int';
 555         }
 556     }
 557     #
 558     # Convert a large Oracle varchar to "text"
 559     # (not necessary as of 5.0.3 http://dev.mysql.com/doc/refman/5.0/en/char.html)
 560     #
 561     elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
 562         unless ($size[0] <= 65535 && $mysql_version >= 5.000003 ) {
 563             $data_type = 'text';
 564             @size      = ();
 565         }
 566     }
 567     elsif ( $data_type =~ /boolean/i ) {
 568         if ($mysql_version >= 4) {
 569             $data_type = 'boolean';
 570         } else {
 571             $data_type = 'enum';
 572             $commalist = "'0','1'";
 573         }
 574     }
 575     elsif ( exists $translate{ lc $data_type } ) {
 576         $data_type = $translate{ lc $data_type };
 577     }
 578
 579     @size = () if $data_type =~ /(text|blob)/i;
 580
 581     if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
 582         push @size, '0';
 583     }
 584
 585     $field_def .= " $data_type";
 586
 587     if ( lc($data_type) eq 'enum' || lc($data_type) eq 'set') {
 588         $field_def .= '(' . $commalist . ')';
 589     }
 590     elsif (
 591         defined $size[0] && $size[0] > 0
 592         &&
 593         ! grep lc($data_type) eq $_, @no_length_attr
 594     ) {
 595         $field_def .= '(' . join( ', ', @size ) . ')';
 596     }
 597
 598     # char sets
 599     $field_def .= " CHARACTER SET $charset" if $charset;
 600     $field_def .= " COLLATE $collate" if $collate;
 601
 602     # MySQL qualifiers
 603     for my $qual ( qw[ binary unsigned zerofill ] ) {
 604         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 605         $field_def .= " $qual";
 606     }
 607     for my $qual ( 'character set', 'collate', 'on update' ) {
 608         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 609         $field_def .= " $qual $val";
 610     }
 611
 612     # Null?
 613     if ( $field->is_nullable ) {
 614         $field_def .= ' NULL';
 615     }
 616     else {
 617         $field_def .= ' NOT NULL';
 618     }
 619
 620     # Default?
 621     SQL::Translator::Producer->_apply_default_value(
 622       $field,
 623       \$field_def,
 624       [
 625         'NULL'       => \'NULL',
 626       ],
 627     );
 628
 629     if ( my $comments = $field->comments ) {
 630         $field_def .= qq[ comment '$comments'];
 631     }
 632
 633     # auto_increment?
 634     $field_def .= " auto_increment" if $field->is_auto_increment;
 635
 636     return $field_def;
 637 }
 638
 639 sub alter_create_index
 640 {
 641     my ($index, $options) = @_;
 642
 643     my $qt = $options->{quote_table_names} || '';
 644     my $qf = $options->{quote_field_names} || '';
 645     my $table_name = quote_table_name($index->table->name, $qt);
 646     return join( ' ',
 647                  'ALTER TABLE',
 648                  $table_name,
 649                  'ADD',
 650                  create_index(@_)
 651                  );
 652 }
 653
 654 sub create_index
 655 {
 656     my ( $index, $options ) = @_;
 657
 658     my $qf = $options->{quote_field_names} || '';
 659
 660     return join(
 661         ' ',
 662         map { $_ || () }
 663         lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 664         $index->name
 665         ? $qf . truncate_id_uniquely(
 666                 $index->name,
 667                 $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH
 668           ) . $qf
 669         : '',
 670         '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 671     );
 672 }
 673
 674 sub alter_drop_index
 675 {
 676     my ($index, $options) = @_;
 677
 678     my $qt = $options->{quote_table_names} || '';
 679     my $qf = $options->{quote_field_names} || '';
 680     my $table_name = quote_table_name($index->table->name, $qt);
 681
 682     return join( ' ',
 683                  'ALTER TABLE',
 684                  $table_name,
 685                  'DROP',
 686                  'INDEX',
 687                  $index->name || $index->fields
 688                  );
 689
 690 }
 691
 692 sub alter_drop_constraint
 693 {
 694     my ($c, $options) = @_;
 695
 696     my $qt      = $options->{quote_table_names} || '';
 697     my $qc      = $options->{quote_field_names} || '';
 698     my $table_name = quote_table_name($c->table->name, $qt);
 699
 700     my @out = ('ALTER','TABLE',$table_name,'DROP');
 701     if($c->type eq PRIMARY_KEY) {
 702         push @out, $c->type;
 703     }
 704     else {
 705         push @out, ($c->type eq FOREIGN_KEY ? $c->type : "INDEX"),
 706             $qc . $c->name . $qc;
 707     }
 708     return join(' ',@out);
 709 }
 710
 711 sub alter_create_constraint
 712 {
 713     my ($index, $options) = @_;
 714
 715     my $qt = $options->{quote_table_names} || '';
 716     my $table_name = quote_table_name($index->table->name, $qt);
 717     return join( ' ',
 718                  'ALTER TABLE',
 719                  $table_name,
 720                  'ADD',
 721                  create_constraint(@_) );
 722 }
 723
 724 sub create_constraint
 725 {
 726     my ($c, $options) = @_;
 727
 728     my $qf      = $options->{quote_field_names} || '';
 729     my $qt      = $options->{quote_table_names} || '';
 730     my $leave_name      = $options->{leave_name} || undef;
 731
 732     my $reference_table_name = quote_table_name($c->reference_table, $qt);
 733
 734     my @fields = $c->fields or next;
 735
 736     if ( $c->type eq PRIMARY_KEY ) {
 737         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 738     }
 739     elsif ( $c->type eq UNIQUE ) {
 740         return sprintf 'UNIQUE %s(%s)',
 741           ((defined $c->name && $c->name)
 742             ? join ('',
 743                 $qf,
 744                 truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ),
 745                 $qf,
 746                 ' '
 747               )
 748             : ''
 749           ),
 750           ( join ', ', map { "${qf}${_}${qf}" } @fields ),
 751         ;
 752     }
 753     elsif ( $c->type eq FOREIGN_KEY ) {
 754         #
 755         # Make sure FK field is indexed or MySQL complains.
 756         #
 757
 758         my $table = $c->table;
 759         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
 760
 761         my $def = join(' ',
 762                        map { $_ || () }
 763                          'CONSTRAINT',
 764                          $qf . $c_name . $qf,
 765                          'FOREIGN KEY'
 766                       );
 767
 768
 769         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 770
 771         $def .= ' REFERENCES ' . $reference_table_name;
 772
 773         my @rfields = map { $_ || () } $c->reference_fields;
 774         unless ( @rfields ) {
 775             my $rtable_name = $c->reference_table;
 776             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 777                 push @rfields, $ref_table->primary_key;
 778             }
 779             else {
 780                 warn "Can't find reference table '$rtable_name' " .
 781                     "in schema\n" if $options->{show_warnings};
 782             }
 783         }
 784
 785         if ( @rfields ) {
 786             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 787         }
 788         else {
 789             warn "FK constraint on " . $table->name . '.' .
 790                 join('', @fields) . " has no reference fields\n"
 791                 if $options->{show_warnings};
 792         }
 793
 794         if ( $c->match_type ) {
 795             $def .= ' MATCH ' .
 796                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 797         }
 798
 799         if ( $c->on_delete ) {
 800             $def .= ' ON DELETE '. $c->on_delete;
 801         }
 802
 803         if ( $c->on_update ) {
 804             $def .= ' ON UPDATE '. $c->on_update;
 805         }
 806         return $def;
 807     }
 808
 809     return undef;
 810 }
 811
 812 sub alter_table
 813 {
 814     my ($to_table, $options) = @_;
 815
 816     my $qt = $options->{quote_table_names} || '';
 817
 818     my $table_options = generate_table_options($to_table, $options) || '';
 819     my $table_name = quote_table_name($to_table->name, $qt);
 820     my $out = sprintf('ALTER TABLE %s%s',
 821                       $table_name,
 822                       $table_options);
 823
 824     return $out;
 825 }
 826
 827 sub rename_field { alter_field(@_) }
 828 sub alter_field
 829 {
 830     my ($from_field, $to_field, $options) = @_;
 831
 832     my $qf = $options->{quote_field_names} || '';
 833     my $qt = $options->{quote_table_names} || '';
 834     my $table_name = quote_table_name($to_field->table->name, $qt);
 835
 836     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 837                       $table_name,
 838                       $qf . $from_field->name . $qf,
 839                       create_field($to_field, $options));
 840
 841     return $out;
 842 }
 843
 844 sub add_field
 845 {
 846     my ($new_field, $options) = @_;
 847
 848     my $qt = $options->{quote_table_names} || '';
 849     my $table_name = quote_table_name($new_field->table->name, $qt);
 850
 851     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 852                       $table_name,
 853                       create_field($new_field, $options));
 854
 855     return $out;
 856
 857 }
 858
 859 sub drop_field
 860 {
 861     my ($old_field, $options) = @_;
 862
 863     my $qf = $options->{quote_field_names} || '';
 864     my $qt = $options->{quote_table_names} || '';
 865     my $table_name = quote_table_name($old_field->table->name, $qt);
 866
 867     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 868                       $table_name,
 869                       $qf . $old_field->name . $qf);
 870
 871     return $out;
 872
 873 }
 874
 875 sub batch_alter_table {
 876   my ($table, $diff_hash, $options) = @_;
 877
 878   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 879   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
 880   #
 881   # We have to work round this.
 882
 883   my %fks_to_alter;
 884   my %fks_to_drop = map {
 885     $_->type eq FOREIGN_KEY
 886               ? ( $_->name => $_ )
 887               : ( )
 888   } @{$diff_hash->{alter_drop_constraint} };
 889
 890   my %fks_to_create = map {
 891     if ( $_->type eq FOREIGN_KEY) {
 892       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 893       ( $_->name => $_ );
 894     } else { ( ) }
 895   } @{$diff_hash->{alter_create_constraint} };
 896
 897   my @drop_stmt;
 898   if (scalar keys %fks_to_alter) {
 899     $diff_hash->{alter_drop_constraint} = [
 900       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 901     ];
 902
 903     @drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options);
 904
 905   }
 906
 907   my @stmts = map {
 908     if (@{ $diff_hash->{$_} || [] }) {
 909       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 910       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 911     } else { () }
 912   } qw/rename_table
 913        alter_drop_constraint
 914        alter_drop_index
 915        drop_field
 916        add_field
 917        alter_field
 918        rename_field
 919        alter_create_index
 920        alter_create_constraint
 921        alter_table/;
 922
 923   #quote
 924   my $qt = $options->{quote_table_names} || '';
 925
 926   # rename_table makes things a bit more complex
 927   my $renamed_from = "";
 928   $renamed_from = quote_table_name($diff_hash->{rename_table}[0][0]->name, $qt)
 929     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 930
 931   return unless @stmts;
 932   # Just zero or one stmts. return now
 933   return (@drop_stmt,@stmts) unless @stmts > 1;
 934
 935   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 936
 937   my $table_name = quote_table_name($table->name, $qt);
 938
 939   my $re = $renamed_from
 940          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$renamed_from\E) /
 941             : qr/^ALTER TABLE \Q$table_name\E /;
 942
 943   my $first = shift  @stmts;
 944   my ($alter_table) = $first =~ /($re)/;
 945
 946   my $padd = " " x length($alter_table);
 947
 948   return @drop_stmt, join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts);
 949
 950 }
 951
 952 sub drop_table {
 953   my ($table, $options) = @_;
 954
 955     my $qt = $options->{quote_table_names} || '';
 956
 957   # Drop (foreign key) constraints so table drops cleanly
 958   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
 959
 960   my $table_name = quote_table_name($table, $qt);
 961   return (@sql, "DROP TABLE $table");
 962
 963 }
 964
 965 sub rename_table {
 966   my ($old_table, $new_table, $options) = @_;
 967
 968   my $qt = $options->{quote_table_names} || '';
 969   my $old_table_name = quote_table_name($old_table, $qt);
 970   my $new_table_name = quote_table_name($new_table, $qt);
 971
 972   return "ALTER TABLE $old_table_name RENAME TO $new_table_name";
 973 }
 974
 975 sub next_unused_name {
 976   my $name       = shift || '';
 977   if ( !defined($used_names{$name}) ) {
 978     $used_names{$name} = $name;
 979     return $name;
 980   }
 981
 982   my $i = 1;
 983   while ( defined($used_names{$name . '_' . $i}) ) {
 984     ++$i;
 985   }
 986   $name .= '_' . $i;
 987   $used_names{$name} = $name;
 988   return $name;
 989 }
 990
 991 1;
 992
 993 =pod
 994
 995 =head1 SEE ALSO
 996
 997 SQL::Translator, http://www.mysql.com/.
 998
 999 =head1 AUTHORS
1000
1001 darren chamberlain E<lt>darren@cpan.orgE<gt>,
1002 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
1003
1004 =cut