lib/SQL/Translator/Producer/MySQL.pm

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