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 character set and collation order.
  73
  74 =item B<field.mysql_charset>, B<field.mysql_collate>
  75
  76 Set the fields character 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 length 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 doesn'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         if ( ref $val ) {
 610             $field_def .= " $qual ${$val}";
 611         }
 612         else {
 613             $field_def .= " $qual $val";
 614         }
 615     }
 616
 617     # Null?
 618     if ( $field->is_nullable ) {
 619         $field_def .= ' NULL';
 620     }
 621     else {
 622         $field_def .= ' NOT NULL';
 623     }
 624
 625     # Default?
 626     SQL::Translator::Producer->_apply_default_value(
 627       $field,
 628       \$field_def,
 629       [
 630         'NULL'       => \'NULL',
 631       ],
 632     );
 633
 634     if ( my $comments = $field->comments ) {
 635         $field_def .= qq[ comment '$comments'];
 636     }
 637
 638     # auto_increment?
 639     $field_def .= " auto_increment" if $field->is_auto_increment;
 640
 641     return $field_def;
 642 }
 643
 644 sub alter_create_index
 645 {
 646     my ($index, $options) = @_;
 647
 648     my $qt = $options->{quote_table_names} || '';
 649     my $qf = $options->{quote_field_names} || '';
 650     my $table_name = quote_table_name($index->table->name, $qt);
 651     return join( ' ',
 652                  'ALTER TABLE',
 653                  $table_name,
 654                  'ADD',
 655                  create_index(@_)
 656                  );
 657 }
 658
 659 sub create_index
 660 {
 661     my ( $index, $options ) = @_;
 662
 663     my $qf = $options->{quote_field_names} || '';
 664
 665     return join(
 666         ' ',
 667         map { $_ || () }
 668         lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 669         $index->name
 670         ? $qf . truncate_id_uniquely(
 671                 $index->name,
 672                 $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH
 673           ) . $qf
 674         : '',
 675         '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 676     );
 677 }
 678
 679 sub alter_drop_index
 680 {
 681     my ($index, $options) = @_;
 682
 683     my $qt = $options->{quote_table_names} || '';
 684     my $qf = $options->{quote_field_names} || '';
 685     my $table_name = quote_table_name($index->table->name, $qt);
 686
 687     return join( ' ',
 688                  'ALTER TABLE',
 689                  $table_name,
 690                  'DROP',
 691                  'INDEX',
 692                  $index->name || $index->fields
 693                  );
 694
 695 }
 696
 697 sub alter_drop_constraint
 698 {
 699     my ($c, $options) = @_;
 700
 701     my $qt      = $options->{quote_table_names} || '';
 702     my $qc      = $options->{quote_field_names} || '';
 703     my $table_name = quote_table_name($c->table->name, $qt);
 704
 705     my @out = ('ALTER','TABLE',$table_name,'DROP');
 706     if($c->type eq PRIMARY_KEY) {
 707         push @out, $c->type;
 708     }
 709     else {
 710         push @out, ($c->type eq FOREIGN_KEY ? $c->type : "INDEX"),
 711             $qc . $c->name . $qc;
 712     }
 713     return join(' ',@out);
 714 }
 715
 716 sub alter_create_constraint
 717 {
 718     my ($index, $options) = @_;
 719
 720     my $qt = $options->{quote_table_names} || '';
 721     my $table_name = quote_table_name($index->table->name, $qt);
 722     return join( ' ',
 723                  'ALTER TABLE',
 724                  $table_name,
 725                  'ADD',
 726                  create_constraint(@_) );
 727 }
 728
 729 sub create_constraint
 730 {
 731     my ($c, $options) = @_;
 732
 733     my $qf      = $options->{quote_field_names} || '';
 734     my $qt      = $options->{quote_table_names} || '';
 735     my $leave_name      = $options->{leave_name} || undef;
 736
 737     my $reference_table_name = quote_table_name($c->reference_table, $qt);
 738
 739     my @fields = $c->fields or return;
 740
 741     if ( $c->type eq PRIMARY_KEY ) {
 742         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 743     }
 744     elsif ( $c->type eq UNIQUE ) {
 745         return sprintf 'UNIQUE %s(%s)',
 746           ((defined $c->name && $c->name)
 747             ? join ('',
 748                 $qf,
 749                 truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ),
 750                 $qf,
 751                 ' '
 752               )
 753             : ''
 754           ),
 755           ( join ', ', map { "${qf}${_}${qf}" } @fields ),
 756         ;
 757     }
 758     elsif ( $c->type eq FOREIGN_KEY ) {
 759         #
 760         # Make sure FK field is indexed or MySQL complains.
 761         #
 762
 763         my $table = $c->table;
 764         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
 765
 766         my $def = join(' ',
 767                        map { $_ || () }
 768                          'CONSTRAINT',
 769                          $qf . $c_name . $qf,
 770                          'FOREIGN KEY'
 771                       );
 772
 773
 774         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 775
 776         $def .= ' REFERENCES ' . $reference_table_name;
 777
 778         my @rfields = map { $_ || () } $c->reference_fields;
 779         unless ( @rfields ) {
 780             my $rtable_name = $c->reference_table;
 781             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 782                 push @rfields, $ref_table->primary_key;
 783             }
 784             else {
 785                 warn "Can't find reference table '$rtable_name' " .
 786                     "in schema\n" if $options->{show_warnings};
 787             }
 788         }
 789
 790         if ( @rfields ) {
 791             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 792         }
 793         else {
 794             warn "FK constraint on " . $table->name . '.' .
 795                 join('', @fields) . " has no reference fields\n"
 796                 if $options->{show_warnings};
 797         }
 798
 799         if ( $c->match_type ) {
 800             $def .= ' MATCH ' .
 801                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 802         }
 803
 804         if ( $c->on_delete ) {
 805             $def .= ' ON DELETE '. $c->on_delete;
 806         }
 807
 808         if ( $c->on_update ) {
 809             $def .= ' ON UPDATE '. $c->on_update;
 810         }
 811         return $def;
 812     }
 813
 814     return undef;
 815 }
 816
 817 sub alter_table
 818 {
 819     my ($to_table, $options) = @_;
 820
 821     my $qt = $options->{quote_table_names} || '';
 822
 823     my $table_options = generate_table_options($to_table, $options) || '';
 824     my $table_name = quote_table_name($to_table->name, $qt);
 825     my $out = sprintf('ALTER TABLE %s%s',
 826                       $table_name,
 827                       $table_options);
 828
 829     return $out;
 830 }
 831
 832 sub rename_field { alter_field(@_) }
 833 sub alter_field
 834 {
 835     my ($from_field, $to_field, $options) = @_;
 836
 837     my $qf = $options->{quote_field_names} || '';
 838     my $qt = $options->{quote_table_names} || '';
 839     my $table_name = quote_table_name($to_field->table->name, $qt);
 840
 841     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 842                       $table_name,
 843                       $qf . $from_field->name . $qf,
 844                       create_field($to_field, $options));
 845
 846     return $out;
 847 }
 848
 849 sub add_field
 850 {
 851     my ($new_field, $options) = @_;
 852
 853     my $qt = $options->{quote_table_names} || '';
 854     my $table_name = quote_table_name($new_field->table->name, $qt);
 855
 856     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 857                       $table_name,
 858                       create_field($new_field, $options));
 859
 860     return $out;
 861
 862 }
 863
 864 sub drop_field
 865 {
 866     my ($old_field, $options) = @_;
 867
 868     my $qf = $options->{quote_field_names} || '';
 869     my $qt = $options->{quote_table_names} || '';
 870     my $table_name = quote_table_name($old_field->table->name, $qt);
 871
 872     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 873                       $table_name,
 874                       $qf . $old_field->name . $qf);
 875
 876     return $out;
 877
 878 }
 879
 880 sub batch_alter_table {
 881   my ($table, $diff_hash, $options) = @_;
 882
 883   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 884   # name in a single alter statement, see: http://bugs.mysql.com/bug.php?id=13741
 885   #
 886   # We have to work round this.
 887
 888   my %fks_to_alter;
 889   my %fks_to_drop = map {
 890     $_->type eq FOREIGN_KEY
 891               ? ( $_->name => $_ )
 892               : ( )
 893   } @{$diff_hash->{alter_drop_constraint} };
 894
 895   my %fks_to_create = map {
 896     if ( $_->type eq FOREIGN_KEY) {
 897       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 898       ( $_->name => $_ );
 899     } else { ( ) }
 900   } @{$diff_hash->{alter_create_constraint} };
 901
 902   my @drop_stmt;
 903   if (scalar keys %fks_to_alter) {
 904     $diff_hash->{alter_drop_constraint} = [
 905       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 906     ];
 907
 908     @drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options);
 909
 910   }
 911
 912   my @stmts = map {
 913     if (@{ $diff_hash->{$_} || [] }) {
 914       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 915       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 916     } else { () }
 917   } qw/rename_table
 918        alter_drop_constraint
 919        alter_drop_index
 920        drop_field
 921        add_field
 922        alter_field
 923        rename_field
 924        alter_create_index
 925        alter_create_constraint
 926        alter_table/;
 927
 928   #quote
 929   my $qt = $options->{quote_table_names} || '';
 930
 931   # rename_table makes things a bit more complex
 932   my $renamed_from = "";
 933   $renamed_from = quote_table_name($diff_hash->{rename_table}[0][0]->name, $qt)
 934     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 935
 936   return unless @stmts;
 937   # Just zero or one stmts. return now
 938   return (@drop_stmt,@stmts) unless @stmts > 1;
 939
 940   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 941
 942   my $table_name = quote_table_name($table->name, $qt);
 943
 944   my $re = $renamed_from
 945          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$renamed_from\E) /
 946             : qr/^ALTER TABLE \Q$table_name\E /;
 947
 948   my $first = shift  @stmts;
 949   my ($alter_table) = $first =~ /($re)/;
 950
 951   my $padd = " " x length($alter_table);
 952
 953   return @drop_stmt, join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts);
 954
 955 }
 956
 957 sub drop_table {
 958   my ($table, $options) = @_;
 959
 960     my $qt = $options->{quote_table_names} || '';
 961
 962   # Drop (foreign key) constraints so table drops cleanly
 963   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
 964
 965   my $table_name = quote_table_name($table, $qt);
 966   return (@sql, "DROP TABLE $table");
 967
 968 }
 969
 970 sub rename_table {
 971   my ($old_table, $new_table, $options) = @_;
 972
 973   my $qt = $options->{quote_table_names} || '';
 974   my $old_table_name = quote_table_name($old_table, $qt);
 975   my $new_table_name = quote_table_name($new_table, $qt);
 976
 977   return "ALTER TABLE $old_table_name RENAME TO $new_table_name";
 978 }
 979
 980 sub next_unused_name {
 981   my $name       = shift || '';
 982   if ( !defined($used_names{$name}) ) {
 983     $used_names{$name} = $name;
 984     return $name;
 985   }
 986
 987   my $i = 1;
 988   while ( defined($used_names{$name . '_' . $i}) ) {
 989     ++$i;
 990   }
 991   $name .= '_' . $i;
 992   $used_names{$name} = $name;
 993   return $name;
 994 }
 995
 996 1;
 997
 998 =pod
 999
1000 =head1 SEE ALSO
1001
1002 SQL::Translator, http://www.mysql.com/.
1003
1004 =head1 AUTHORS
1005
1006 darren chamberlain E<lt>darren@cpan.orgE<gt>,
1007 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
1008
1009 =cut