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 =head2 Index options
  81
  82 =over 4
  83
  84 =item prefix_length
  85
  86 This option allows to use a prefix of certain character type (eg. char,
  87 varchar, text) fields in the index.
  88
  89 The value of this option is a hashref, keys are the field names, values are the
  90 prefix lengths.
  91
  92 Example:
  93
  94     $table->add_index(
  95         name    => 'idx1',
  96         fields  => [ 'id', 'name', 'address' ],
  97         type    => 'normal',
  98         options => [
  99             {
 100                 prefix_length => {
 101                     name    => 10,
 102                     address => 20,
 103                 }
 104             },
 105         ],
 106     );
 107
 108     # It will generate the following SQL snippet in the table definition:
 109     INDEX `idx1` (`id`, `name`(10), `address`(20)),
 110
 111 =back
 112
 113 =cut
 114
 115 use strict;
 116 use warnings;
 117 our ( $DEBUG, %used_names );
 118 our $VERSION = '1.59';
 119 $DEBUG   = 0 unless defined $DEBUG;
 120
 121 # Maximum length for most identifiers is 64, according to:
 122 #   http://dev.mysql.com/doc/refman/4.1/en/identifiers.html
 123 #   http://dev.mysql.com/doc/refman/5.0/en/identifiers.html
 124 my $DEFAULT_MAX_ID_LENGTH = 64;
 125
 126 use Data::Dumper;
 127 use List::Util qw(first);
 128 use SQL::Translator::Schema::Constants;
 129 use SQL::Translator::Utils qw(debug header_comment
 130     truncate_id_uniquely parse_mysql_version);
 131
 132 #
 133 # Use only lowercase for the keys (e.g. "long" and not "LONG")
 134 #
 135 my %translate  = (
 136     #
 137     # Oracle types
 138     #
 139     varchar2   => 'varchar',
 140     long       => 'text',
 141     clob       => 'longtext',
 142
 143     #
 144     # Sybase types
 145     #
 146     int        => 'integer',
 147     money      => 'float',
 148     real       => 'double',
 149     comment    => 'text',
 150     bit        => 'tinyint',
 151
 152     #
 153     # Access types
 154     #
 155     'long integer' => 'integer',
 156     'text'         => 'text',
 157     'datetime'     => 'datetime',
 158
 159     #
 160     # PostgreSQL types
 161     #
 162     bytea => 'BLOB',
 163 );
 164
 165 #
 166 # Column types that do not support lenth attribute
 167 #
 168 my @no_length_attr = qw/
 169   date time timestamp datetime year
 170   /;
 171
 172
 173 sub preprocess_schema {
 174     my ($schema) = @_;
 175
 176     # extra->{mysql_table_type} used to be the type. It belongs in options, so
 177     # move it if we find it. Return Engine type if found in extra or options
 178     # Similarly for mysql_charset and mysql_collate
 179     my $extra_to_options = sub {
 180       my ($table, $extra_name, $opt_name) = @_;
 181
 182       my $extra = $table->extra;
 183
 184       my $extra_type = delete $extra->{$extra_name};
 185
 186       # Now just to find if there is already an Engine or Type option...
 187       # and lets normalize it to ENGINE since:
 188       #
 189       # The ENGINE table option specifies the storage engine for the table.
 190       # TYPE is a synonym, but ENGINE is the preferred option name.
 191       #
 192
 193       # We have to use the hash directly here since otherwise there is no way
 194       # to remove options.
 195       my $options = ( $table->{options} ||= []);
 196
 197       # If multiple option names, normalize to the first one
 198       if (ref $opt_name) {
 199         OPT_NAME: for ( @$opt_name[1..$#$opt_name] ) {
 200           for my $idx ( 0..$#{$options} ) {
 201             my ($key, $value) = %{ $options->[$idx] };
 202
 203             if (uc $key eq $_) {
 204               $options->[$idx] = { $opt_name->[0] => $value };
 205               last OPT_NAME;
 206             }
 207           }
 208         }
 209         $opt_name = $opt_name->[0];
 210
 211       }
 212
 213
 214       # This assumes that there isn't both a Type and an Engine option.
 215       OPTION:
 216       for my $idx ( 0..$#{$options} ) {
 217         my ($key, $value) = %{ $options->[$idx] };
 218
 219         next unless uc $key eq $opt_name;
 220
 221         # make sure case is right on option name
 222         delete $options->[$idx]{$key};
 223         return $options->[$idx]{$opt_name} = $value || $extra_type;
 224
 225       }
 226
 227       if ($extra_type) {
 228         push @$options, { $opt_name => $extra_type };
 229         return $extra_type;
 230       }
 231
 232     };
 233
 234     # Names are only specific to a given schema
 235     local %used_names = ();
 236
 237     #
 238     # Work out which tables need to be InnoDB to support foreign key
 239     # constraints. We do this first as we need InnoDB at both ends.
 240     #
 241     foreach my $table ( $schema->get_tables ) {
 242
 243         $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE'] );
 244         $extra_to_options->($table, 'mysql_charset', 'CHARACTER SET' );
 245         $extra_to_options->($table, 'mysql_collate', 'COLLATE' );
 246
 247         foreach my $c ( $table->get_constraints ) {
 248             next unless $c->type eq FOREIGN_KEY;
 249
 250             # Normalize constraint names here.
 251             my $c_name = $c->name;
 252             # Give the constraint a name if it doesn't have one, so it doens't feel
 253             # left out
 254             $c_name   = $table->name . '_fk' unless length $c_name;
 255
 256             $c->name( next_unused_name($c_name) );
 257
 258             for my $meth (qw/table reference_table/) {
 259                 my $table = $schema->get_table($c->$meth) || next;
 260                 # This normalizes the types to ENGINE and returns the value if its there
 261                 next if $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE']);
 262                 $table->options( { 'ENGINE' => 'InnoDB' } );
 263             }
 264         } # foreach constraints
 265
 266         my %map = ( mysql_collate => 'collate', mysql_charset => 'character set');
 267         foreach my $f ( $table->get_fields ) {
 268           my $extra = $f->extra;
 269           for (keys %map) {
 270             $extra->{$map{$_}} = delete $extra->{$_} if exists $extra->{$_};
 271           }
 272
 273           my @size = $f->size;
 274           if ( !$size[0] && $f->data_type =~ /char$/ ) {
 275             $f->size( (255) );
 276           }
 277         }
 278
 279     }
 280 }
 281
 282 sub produce {
 283     my $translator     = shift;
 284     local $DEBUG       = $translator->debug;
 285     local %used_names;
 286     my $no_comments    = $translator->no_comments;
 287     my $add_drop_table = $translator->add_drop_table;
 288     my $schema         = $translator->schema;
 289     my $show_warnings  = $translator->show_warnings || 0;
 290     my $producer_args  = $translator->producer_args;
 291     my $mysql_version  = parse_mysql_version ($producer_args->{mysql_version}, 'perl') || 0;
 292     my $max_id_length  = $producer_args->{mysql_max_id_length} || $DEFAULT_MAX_ID_LENGTH;
 293
 294     my ($qt, $qf, $qc) = ('','', '');
 295     $qt = '`' if $translator->quote_table_names;
 296     $qf = '`' if $translator->quote_field_names;
 297
 298     debug("PKG: Beginning production\n");
 299     %used_names = ();
 300     my $create = '';
 301     $create .= header_comment unless ($no_comments);
 302     # \todo Don't set if MySQL 3.x is set on command line
 303     my @create = "SET foreign_key_checks=0";
 304
 305     preprocess_schema($schema);
 306
 307     #
 308     # Generate sql
 309     #
 310     my @table_defs =();
 311
 312     for my $table ( $schema->get_tables ) {
 313 #        print $table->name, "\n";
 314         push @table_defs, create_table($table,
 315                                        { add_drop_table    => $add_drop_table,
 316                                          show_warnings     => $show_warnings,
 317                                          no_comments       => $no_comments,
 318                                          quote_table_names => $qt,
 319                                          quote_field_names => $qf,
 320                                          max_id_length     => $max_id_length,
 321                                          mysql_version     => $mysql_version
 322                                          });
 323     }
 324
 325     if ($mysql_version >= 5.000001) {
 326       for my $view ( $schema->get_views ) {
 327         push @table_defs, create_view($view,
 328                                        { add_replace_view  => $add_drop_table,
 329                                          show_warnings     => $show_warnings,
 330                                          no_comments       => $no_comments,
 331                                          quote_table_names => $qt,
 332                                          quote_field_names => $qf,
 333                                          max_id_length     => $max_id_length,
 334                                          mysql_version     => $mysql_version
 335                                          });
 336       }
 337     }
 338
 339     if ($mysql_version >= 5.000002) {
 340       for my $trigger ( $schema->get_triggers ) {
 341         push @table_defs, create_trigger($trigger,
 342                                          { add_drop_trigger  => $add_drop_table,
 343                                            show_warnings        => $show_warnings,
 344                                            no_comments          => $no_comments,
 345                                            quote_table_names    => $qt,
 346                                            quote_field_names    => $qf,
 347                                            max_id_length        => $max_id_length,
 348                                            mysql_version        => $mysql_version
 349                                            });
 350       }
 351     }
 352
 353
 354 #    print "@table_defs\n";
 355     push @table_defs, "SET foreign_key_checks=1";
 356
 357     return wantarray ? ($create ? $create : (), @create, @table_defs) : ($create . join('', map { $_ ? "$_;\n\n" : () } (@create, @table_defs)));
 358 }
 359
 360 sub create_trigger {
 361     my ($trigger, $options) = @_;
 362     my $qt = $options->{quote_table_names} || '';
 363     my $qf = $options->{quote_field_names} || '';
 364
 365     my $trigger_name = $trigger->name;
 366     debug("PKG: Looking at trigger '${trigger_name}'\n");
 367
 368     my @statements;
 369
 370     my $events = $trigger->database_events;
 371     for my $event ( @$events ) {
 372         my $name = $trigger_name;
 373         if (@$events > 1) {
 374             $name .= "_$event";
 375
 376             warn "Multiple database events supplied for trigger '${trigger_name}', ",
 377                 "creating trigger '${name}'  for the '${event}' event\n"
 378                     if $options->{show_warnings};
 379         }
 380
 381         my $action = $trigger->action;
 382         $action .= ";" unless $action =~ /;\s*\z/;
 383
 384         push @statements, "DROP TRIGGER IF EXISTS ${qt}${name}${qt}" if $options->{add_drop_trigger};
 385         push @statements, sprintf(
 386             "CREATE TRIGGER ${qt}%s${qt} %s %s ON ${qt}%s${qt}\n  FOR EACH ROW BEGIN %s END",
 387             $name, $trigger->perform_action_when, $event, $trigger->on_table, $action,
 388         );
 389
 390     }
 391     # Tack the comment onto the first statement
 392     $statements[0] = "--\n-- Trigger ${qt}${trigger_name}${qt}\n--\n" . $statements[0] unless $options->{no_comments};
 393     return @statements;
 394 }
 395
 396 sub create_view {
 397     my ($view, $options) = @_;
 398     my $qt = $options->{quote_table_names} || '';
 399     my $qf = $options->{quote_field_names} || '';
 400
 401     my $view_name = $view->name;
 402     debug("PKG: Looking at view '${view_name}'\n");
 403
 404     # Header.  Should this look like what mysqldump produces?
 405     my $create = '';
 406     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n" unless $options->{no_comments};
 407     $create .= 'CREATE';
 408     $create .= ' OR REPLACE' if $options->{add_replace_view};
 409     $create .= "\n";
 410
 411     my $extra = $view->extra;
 412     # ALGORITHM
 413     if( exists($extra->{mysql_algorithm}) && defined(my $algorithm = $extra->{mysql_algorithm}) ){
 414       $create .= "   ALGORITHM = ${algorithm}\n" if $algorithm =~ /(?:UNDEFINED|MERGE|TEMPTABLE)/i;
 415     }
 416     # DEFINER
 417     if( exists($extra->{mysql_definer}) && defined(my $user = $extra->{mysql_definer}) ){
 418       $create .= "   DEFINER = ${user}\n";
 419     }
 420     # SECURITY
 421     if( exists($extra->{mysql_security}) && defined(my $security = $extra->{mysql_security}) ){
 422       $create .= "   SQL SECURITY ${security}\n" if $security =~ /(?:DEFINER|INVOKER)/i;
 423     }
 424
 425     #Header, cont.
 426     $create .= "  VIEW ${qt}${view_name}${qt}";
 427
 428     if( my @fields = $view->fields ){
 429       my $list = join ', ', map { "${qf}${_}${qf}"} @fields;
 430       $create .= " ( ${list} )";
 431     }
 432     if( my $sql = $view->sql ){
 433       # do not wrap parenthesis around the selector, mysql doesn't like this
 434       # http://bugs.mysql.com/bug.php?id=9198
 435       $create .= " AS\n    ${sql}\n";
 436     }
 437 #    $create .= "";
 438     return $create;
 439 }
 440
 441 sub create_table
 442 {
 443     my ($table, $options) = @_;
 444
 445     my $qt = $options->{quote_table_names} || '';
 446     my $qf = $options->{quote_field_names} || '';
 447
 448     my $table_name = quote_table_name($table->name, $qt);
 449     debug("PKG: Looking at table '$table_name'\n");
 450
 451     #
 452     # Header.  Should this look like what mysqldump produces?
 453     #
 454     my $create = '';
 455     my $drop;
 456     $create .= "--\n-- Table: $table_name\n--\n" unless $options->{no_comments};
 457     $drop = qq[DROP TABLE IF EXISTS $table_name] if $options->{add_drop_table};
 458     $create .= "CREATE TABLE $table_name (\n";
 459
 460     #
 461     # Fields
 462     #
 463     my @field_defs;
 464     for my $field ( $table->get_fields ) {
 465         push @field_defs, create_field($field, $options);
 466     }
 467
 468     #
 469     # Indices
 470     #
 471     my @index_defs;
 472     my %indexed_fields;
 473     for my $index ( $table->get_indices ) {
 474         push @index_defs, create_index($index, $options);
 475         $indexed_fields{ $_ } = 1 for $index->fields;
 476     }
 477
 478     #
 479     # Constraints -- need to handle more than just FK. -ky
 480     #
 481     my @constraint_defs;
 482     my @constraints = $table->get_constraints;
 483     for my $c ( @constraints ) {
 484         my $constr = create_constraint($c, $options);
 485         push @constraint_defs, $constr if($constr);
 486
 487          unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
 488              push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
 489              $indexed_fields{ ($c->fields())[0] } = 1;
 490          }
 491     }
 492
 493     $create .= join(",\n", map { "  $_" }
 494                     @field_defs, @index_defs, @constraint_defs
 495                     );
 496
 497     #
 498     # Footer
 499     #
 500     $create .= "\n)";
 501     $create .= generate_table_options($table, $options) || '';
 502 #    $create .= ";\n\n";
 503
 504     return $drop ? ($drop,$create) : $create;
 505 }
 506
 507 sub quote_table_name {
 508   my ($table_name, $qt) = @_;
 509
 510   $table_name =~ s/\./$qt.$qt/g;
 511
 512   return "$qt$table_name$qt";
 513 }
 514
 515 sub generate_table_options
 516 {
 517   my ($table, $options) = @_;
 518   my $create;
 519
 520   my $table_type_defined = 0;
 521   my $qf               = $options->{quote_field_names} ||= '';
 522   my $charset          = $table->extra('mysql_charset');
 523   my $collate          = $table->extra('mysql_collate');
 524   my $union            = undef;
 525   for my $t1_option_ref ( $table->options ) {
 526     my($key, $value) = %{$t1_option_ref};
 527     $table_type_defined = 1
 528       if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
 529     if (uc $key eq 'CHARACTER SET') {
 530       $charset = $value;
 531       next;
 532     } elsif (uc $key eq 'COLLATE') {
 533       $collate = $value;
 534       next;
 535     } elsif (uc $key eq 'UNION') {
 536       $union = "($qf". join("$qf, $qf", @$value) ."$qf)";
 537       next;
 538     }
 539     $create .= " $key=$value";
 540   }
 541
 542   my $mysql_table_type = $table->extra('mysql_table_type');
 543   $create .= " ENGINE=$mysql_table_type"
 544     if $mysql_table_type && !$table_type_defined;
 545   my $comments         = $table->comments;
 546
 547   $create .= " DEFAULT CHARACTER SET $charset" if $charset;
 548   $create .= " COLLATE $collate" if $collate;
 549   $create .= " UNION=$union" if $union;
 550   $create .= qq[ comment='$comments'] if $comments;
 551   return $create;
 552 }
 553
 554 sub create_field
 555 {
 556     my ($field, $options) = @_;
 557
 558     my $qf = $options->{quote_field_names} ||= '';
 559
 560     my $field_name = $field->name;
 561     debug("PKG: Looking at field '$field_name'\n");
 562     my $field_def = "$qf$field_name$qf";
 563
 564     # data type and size
 565     my $data_type = $field->data_type;
 566     my @size      = $field->size;
 567     my %extra     = $field->extra;
 568     my $list      = $extra{'list'} || [];
 569     # \todo deal with embedded quotes
 570     my $commalist = join( ', ', map { qq['$_'] } @$list );
 571     my $charset = $extra{'mysql_charset'};
 572     my $collate = $extra{'mysql_collate'};
 573
 574     my $mysql_version = $options->{mysql_version} || 0;
 575     #
 576     # Oracle "number" type -- figure best MySQL type
 577     #
 578     if ( lc $data_type eq 'number' ) {
 579         # not an integer
 580         if ( scalar @size > 1 ) {
 581             $data_type = 'double';
 582         }
 583         elsif ( $size[0] && $size[0] >= 12 ) {
 584             $data_type = 'bigint';
 585         }
 586         elsif ( $size[0] && $size[0] <= 1 ) {
 587             $data_type = 'tinyint';
 588         }
 589         else {
 590             $data_type = 'int';
 591         }
 592     }
 593     #
 594     # Convert a large Oracle varchar to "text"
 595     # (not necessary as of 5.0.3 http://dev.mysql.com/doc/refman/5.0/en/char.html)
 596     #
 597     elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
 598         unless ($size[0] <= 65535 && $mysql_version >= 5.000003 ) {
 599             $data_type = 'text';
 600             @size      = ();
 601         }
 602     }
 603     elsif ( $data_type =~ /boolean/i ) {
 604         if ($mysql_version >= 4) {
 605             $data_type = 'boolean';
 606         } else {
 607             $data_type = 'enum';
 608             $commalist = "'0','1'";
 609         }
 610     }
 611     elsif ( exists $translate{ lc $data_type } ) {
 612         $data_type = $translate{ lc $data_type };
 613     }
 614
 615     @size = () if $data_type =~ /(text|blob)/i;
 616
 617     if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
 618         push @size, '0';
 619     }
 620
 621     $field_def .= " $data_type";
 622
 623     if ( lc($data_type) eq 'enum' || lc($data_type) eq 'set') {
 624         $field_def .= '(' . $commalist . ')';
 625     }
 626     elsif (
 627         defined $size[0] && $size[0] > 0
 628         &&
 629         ! grep lc($data_type) eq $_, @no_length_attr
 630     ) {
 631         $field_def .= '(' . join( ', ', @size ) . ')';
 632     }
 633
 634     # char sets
 635     $field_def .= " CHARACTER SET $charset" if $charset;
 636     $field_def .= " COLLATE $collate" if $collate;
 637
 638     # MySQL qualifiers
 639     for my $qual ( qw[ binary unsigned zerofill ] ) {
 640         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 641         $field_def .= " $qual";
 642     }
 643     for my $qual ( 'character set', 'collate', 'on update' ) {
 644         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 645         $field_def .= " $qual $val";
 646     }
 647
 648     # Null?
 649     if ( $field->is_nullable ) {
 650         $field_def .= ' NULL';
 651     }
 652     else {
 653         $field_def .= ' NOT NULL';
 654     }
 655
 656     # Default?
 657     SQL::Translator::Producer->_apply_default_value(
 658       $field,
 659       \$field_def,
 660       [
 661         'NULL'       => \'NULL',
 662       ],
 663     );
 664
 665     if ( my $comments = $field->comments ) {
 666         $field_def .= qq[ comment '$comments'];
 667     }
 668
 669     # auto_increment?
 670     $field_def .= " auto_increment" if $field->is_auto_increment;
 671
 672     return $field_def;
 673 }
 674
 675 sub alter_create_index
 676 {
 677     my ($index, $options) = @_;
 678
 679     my $qt = $options->{quote_table_names} || '';
 680     my $qf = $options->{quote_field_names} || '';
 681     my $table_name = quote_table_name($index->table->name, $qt);
 682     return join( ' ',
 683                  'ALTER TABLE',
 684                  $table_name,
 685                  'ADD',
 686                  create_index(@_)
 687                  );
 688 }
 689
 690 sub create_index
 691 {
 692     my ( $index, $options ) = @_;
 693
 694     my $qf = $options->{quote_field_names} || '';
 695
 696     my ($prefix_length) = map { ( $_ || {} )->{prefix_length} || {} }
 697         first { ref $_ eq 'HASH' && exists $_->{prefix_length} }
 698             $index->options;
 699
 700     my @fields = map {
 701         "$qf$_$qf" . (defined $prefix_length->{$_} ? "($prefix_length->{$_})" : "")
 702     } $index->fields;
 703
 704     return join(
 705         ' ',
 706         map { $_ || () }
 707         lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 708         $index->name
 709         ? $qf . truncate_id_uniquely(
 710                 $index->name,
 711                 $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH
 712           ) . $qf
 713         : '',
 714         '(' . join(", ", @fields) . ')'
 715     );
 716 }
 717
 718 sub alter_drop_index
 719 {
 720     my ($index, $options) = @_;
 721
 722     my $qt = $options->{quote_table_names} || '';
 723     my $qf = $options->{quote_field_names} || '';
 724     my $table_name = quote_table_name($index->table->name, $qt);
 725
 726     return join( ' ',
 727                  'ALTER TABLE',
 728                  $table_name,
 729                  'DROP',
 730                  'INDEX',
 731                  $index->name || $index->fields
 732                  );
 733
 734 }
 735
 736 sub alter_drop_constraint
 737 {
 738     my ($c, $options) = @_;
 739
 740     my $qt      = $options->{quote_table_names} || '';
 741     my $qc      = $options->{quote_field_names} || '';
 742     my $table_name = quote_table_name($c->table->name, $qt);
 743
 744     my @out = ('ALTER','TABLE',$table_name,'DROP');
 745     if($c->type eq PRIMARY_KEY) {
 746         push @out, $c->type;
 747     }
 748     else {
 749         push @out, ($c->type eq FOREIGN_KEY ? $c->type : "INDEX"),
 750             $qc . $c->name . $qc;
 751     }
 752     return join(' ',@out);
 753 }
 754
 755 sub alter_create_constraint
 756 {
 757     my ($index, $options) = @_;
 758
 759     my $qt = $options->{quote_table_names} || '';
 760     my $table_name = quote_table_name($index->table->name, $qt);
 761     return join( ' ',
 762                  'ALTER TABLE',
 763                  $table_name,
 764                  'ADD',
 765                  create_constraint(@_) );
 766 }
 767
 768 sub create_constraint
 769 {
 770     my ($c, $options) = @_;
 771
 772     my $qf      = $options->{quote_field_names} || '';
 773     my $qt      = $options->{quote_table_names} || '';
 774     my $leave_name      = $options->{leave_name} || undef;
 775
 776     my $reference_table_name = quote_table_name($c->reference_table, $qt);
 777
 778     my @fields = $c->fields or next;
 779
 780     if ( $c->type eq PRIMARY_KEY ) {
 781         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 782     }
 783     elsif ( $c->type eq UNIQUE ) {
 784         return sprintf 'UNIQUE %s(%s)',
 785           ((defined $c->name && $c->name)
 786             ? join ('',
 787                 $qf,
 788                 truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ),
 789                 $qf,
 790                 ' '
 791               )
 792             : ''
 793           ),
 794           ( join ', ', map { "${qf}${_}${qf}" } @fields ),
 795         ;
 796     }
 797     elsif ( $c->type eq FOREIGN_KEY ) {
 798         #
 799         # Make sure FK field is indexed or MySQL complains.
 800         #
 801
 802         my $table = $c->table;
 803         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
 804
 805         my $def = join(' ',
 806                        map { $_ || () }
 807                          'CONSTRAINT',
 808                          $qf . $c_name . $qf,
 809                          'FOREIGN KEY'
 810                       );
 811
 812
 813         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 814
 815         $def .= ' REFERENCES ' . $reference_table_name;
 816
 817         my @rfields = map { $_ || () } $c->reference_fields;
 818         unless ( @rfields ) {
 819             my $rtable_name = $c->reference_table;
 820             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 821                 push @rfields, $ref_table->primary_key;
 822             }
 823             else {
 824                 warn "Can't find reference table '$rtable_name' " .
 825                     "in schema\n" if $options->{show_warnings};
 826             }
 827         }
 828
 829         if ( @rfields ) {
 830             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 831         }
 832         else {
 833             warn "FK constraint on " . $table->name . '.' .
 834                 join('', @fields) . " has no reference fields\n"
 835                 if $options->{show_warnings};
 836         }
 837
 838         if ( $c->match_type ) {
 839             $def .= ' MATCH ' .
 840                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 841         }
 842
 843         if ( $c->on_delete ) {
 844             $def .= ' ON DELETE '. $c->on_delete;
 845         }
 846
 847         if ( $c->on_update ) {
 848             $def .= ' ON UPDATE '. $c->on_update;
 849         }
 850         return $def;
 851     }
 852
 853     return undef;
 854 }
 855
 856 sub alter_table
 857 {
 858     my ($to_table, $options) = @_;
 859
 860     my $qt = $options->{quote_table_names} || '';
 861
 862     my $table_options = generate_table_options($to_table, $options) || '';
 863     my $table_name = quote_table_name($to_table->name, $qt);
 864     my $out = sprintf('ALTER TABLE %s%s',
 865                       $table_name,
 866                       $table_options);
 867
 868     return $out;
 869 }
 870
 871 sub rename_field { alter_field(@_) }
 872 sub alter_field
 873 {
 874     my ($from_field, $to_field, $options) = @_;
 875
 876     my $qf = $options->{quote_field_names} || '';
 877     my $qt = $options->{quote_table_names} || '';
 878     my $table_name = quote_table_name($to_field->table->name, $qt);
 879
 880     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 881                       $table_name,
 882                       $qf . $from_field->name . $qf,
 883                       create_field($to_field, $options));
 884
 885     return $out;
 886 }
 887
 888 sub add_field
 889 {
 890     my ($new_field, $options) = @_;
 891
 892     my $qt = $options->{quote_table_names} || '';
 893     my $table_name = quote_table_name($new_field->table->name, $qt);
 894
 895     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 896                       $table_name,
 897                       create_field($new_field, $options));
 898
 899     return $out;
 900
 901 }
 902
 903 sub drop_field
 904 {
 905     my ($old_field, $options) = @_;
 906
 907     my $qf = $options->{quote_field_names} || '';
 908     my $qt = $options->{quote_table_names} || '';
 909     my $table_name = quote_table_name($old_field->table->name, $qt);
 910
 911     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 912                       $table_name,
 913                       $qf . $old_field->name . $qf);
 914
 915     return $out;
 916
 917 }
 918
 919 sub batch_alter_table {
 920   my ($table, $diff_hash, $options) = @_;
 921
 922   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 923   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
 924   #
 925   # We have to work round this.
 926
 927   my %fks_to_alter;
 928   my %fks_to_drop = map {
 929     $_->type eq FOREIGN_KEY
 930               ? ( $_->name => $_ )
 931               : ( )
 932   } @{$diff_hash->{alter_drop_constraint} };
 933
 934   my %fks_to_create = map {
 935     if ( $_->type eq FOREIGN_KEY) {
 936       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 937       ( $_->name => $_ );
 938     } else { ( ) }
 939   } @{$diff_hash->{alter_create_constraint} };
 940
 941   my @drop_stmt;
 942   if (scalar keys %fks_to_alter) {
 943     $diff_hash->{alter_drop_constraint} = [
 944       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 945     ];
 946
 947     @drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options);
 948
 949   }
 950
 951   my @stmts = map {
 952     if (@{ $diff_hash->{$_} || [] }) {
 953       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 954       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 955     } else { () }
 956   } qw/rename_table
 957        alter_drop_constraint
 958        alter_drop_index
 959        drop_field
 960        add_field
 961        alter_field
 962        rename_field
 963        alter_create_index
 964        alter_create_constraint
 965        alter_table/;
 966
 967   #quote
 968   my $qt = $options->{quote_table_names} || '';
 969
 970   # rename_table makes things a bit more complex
 971   my $renamed_from = "";
 972   $renamed_from = quote_table_name($diff_hash->{rename_table}[0][0]->name, $qt)
 973     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 974
 975   return unless @stmts;
 976   # Just zero or one stmts. return now
 977   return (@drop_stmt,@stmts) unless @stmts > 1;
 978
 979   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 980
 981   my $table_name = quote_table_name($table->name, $qt);
 982
 983   my $re = $renamed_from
 984          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$renamed_from\E) /
 985             : qr/^ALTER TABLE \Q$table_name\E /;
 986
 987   my $first = shift  @stmts;
 988   my ($alter_table) = $first =~ /($re)/;
 989
 990   my $padd = " " x length($alter_table);
 991
 992   return @drop_stmt, join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts);
 993
 994 }
 995
 996 sub drop_table {
 997   my ($table, $options) = @_;
 998
 999     my $qt = $options->{quote_table_names} || '';
1000
1001   # Drop (foreign key) constraints so table drops cleanly
1002   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
1003
1004   my $table_name = quote_table_name($table, $qt);
1005   return (@sql, "DROP TABLE $table");
1006
1007 }
1008
1009 sub rename_table {
1010   my ($old_table, $new_table, $options) = @_;
1011
1012   my $qt = $options->{quote_table_names} || '';
1013   my $old_table_name = quote_table_name($old_table, $qt);
1014   my $new_table_name = quote_table_name($new_table, $qt);
1015
1016   return "ALTER TABLE $old_table_name RENAME TO $new_table_name";
1017 }
1018
1019 sub next_unused_name {
1020   my $name       = shift || '';
1021   if ( !defined($used_names{$name}) ) {
1022     $used_names{$name} = $name;
1023     return $name;
1024   }
1025
1026   my $i = 1;
1027   while ( defined($used_names{$name . '_' . $i}) ) {
1028     ++$i;
1029   }
1030   $name .= '_' . $i;
1031   $used_names{$name} = $name;
1032   return $name;
1033 }
1034
1035 1;
1036
1037 =pod
1038
1039 =head1 SEE ALSO
1040
1041 SQL::Translator, http://www.mysql.com/.
1042
1043 =head1 AUTHORS
1044
1045 darren chamberlain E<lt>darren@cpan.orgE<gt>,
1046 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
1047
1048 =cut