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