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 @fields = $c->fields or next;
 742
 743     if ( $c->type eq PRIMARY_KEY ) {
 744         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 745     }
 746     elsif ( $c->type eq UNIQUE ) {
 747         return
 748         'UNIQUE '.
 749             (defined $c->name ? $qf.truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ).$qf.' ' : '').
 750             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
 751     }
 752     elsif ( $c->type eq FOREIGN_KEY ) {
 753         #
 754         # Make sure FK field is indexed or MySQL complains.
 755         #
 756
 757         my $table = $c->table;
 758         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
 759
 760         my $def = join(' ',
 761                        map { $_ || () }
 762                          'CONSTRAINT',
 763                          $qf . $c_name . $qf,
 764                          'FOREIGN KEY'
 765                       );
 766
 767
 768         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 769
 770         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
 771
 772         my @rfields = map { $_ || () } $c->reference_fields;
 773         unless ( @rfields ) {
 774             my $rtable_name = $c->reference_table;
 775             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 776                 push @rfields, $ref_table->primary_key;
 777             }
 778             else {
 779                 warn "Can't find reference table '$rtable_name' " .
 780                     "in schema\n" if $options->{show_warnings};
 781             }
 782         }
 783
 784         if ( @rfields ) {
 785             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 786         }
 787         else {
 788             warn "FK constraint on " . $table->name . '.' .
 789                 join('', @fields) . " has no reference fields\n"
 790                 if $options->{show_warnings};
 791         }
 792
 793         if ( $c->match_type ) {
 794             $def .= ' MATCH ' .
 795                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 796         }
 797
 798         if ( $c->on_delete ) {
 799             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 800         }
 801
 802         if ( $c->on_update ) {
 803             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 804         }
 805         return $def;
 806     }
 807
 808     return undef;
 809 }
 810
 811 sub alter_table
 812 {
 813     my ($to_table, $options) = @_;
 814
 815     my $qt = $options->{quote_table_names} || '';
 816
 817     my $table_options = generate_table_options($to_table, $options) || '';
 818     my $out = sprintf('ALTER TABLE %s%s',
 819                       $qt . $to_table->name . $qt,
 820                       $table_options);
 821
 822     return $out;
 823 }
 824
 825 sub rename_field { alter_field(@_) }
 826 sub alter_field
 827 {
 828     my ($from_field, $to_field, $options) = @_;
 829
 830     my $qf = $options->{quote_field_names} || '';
 831     my $qt = $options->{quote_table_names} || '';
 832
 833     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 834                       $qt . $to_field->table->name . $qt,
 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
 847     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 848                       $qt . $new_field->table->name . $qt,
 849                       create_field($new_field, $options));
 850
 851     return $out;
 852
 853 }
 854
 855 sub drop_field
 856 {
 857     my ($old_field, $options) = @_;
 858
 859     my $qf = $options->{quote_field_names} || '';
 860     my $qt = $options->{quote_table_names} || '';
 861
 862     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 863                       $qt . $old_field->table->name . $qt,
 864                       $qf . $old_field->name . $qf);
 865
 866     return $out;
 867
 868 }
 869
 870 sub batch_alter_table {
 871   my ($table, $diff_hash, $options) = @_;
 872
 873   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 874   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
 875   #
 876   # We have to work round this.
 877
 878   my %fks_to_alter;
 879   my %fks_to_drop = map {
 880     $_->type eq FOREIGN_KEY
 881               ? ( $_->name => $_ )
 882               : ( )
 883   } @{$diff_hash->{alter_drop_constraint} };
 884
 885   my %fks_to_create = map {
 886     if ( $_->type eq FOREIGN_KEY) {
 887       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 888       ( $_->name => $_ );
 889     } else { ( ) }
 890   } @{$diff_hash->{alter_create_constraint} };
 891
 892   my @drop_stmt;
 893   if (scalar keys %fks_to_alter) {
 894     $diff_hash->{alter_drop_constraint} = [
 895       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 896     ];
 897
 898     @drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options);
 899
 900   }
 901
 902   my @stmts = map {
 903     if (@{ $diff_hash->{$_} || [] }) {
 904       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 905       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 906     } else { () }
 907   } qw/rename_table
 908        alter_drop_constraint
 909        alter_drop_index
 910        drop_field
 911        add_field
 912        alter_field
 913        rename_field
 914        alter_create_index
 915        alter_create_constraint
 916        alter_table/;
 917
 918   # rename_table makes things a bit more complex
 919   my $renamed_from = "";
 920   $renamed_from = $diff_hash->{rename_table}[0][0]->name
 921     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 922
 923   return unless @stmts;
 924   # Just zero or one stmts. return now
 925   return (@drop_stmt,@stmts) unless @stmts > 1;
 926
 927   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 928
 929   my $qt = $options->{quote_table_names} || '';
 930   my $table_name = $qt . $table->name . $qt;
 931
 932
 933   my $re = $renamed_from
 934          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$qt$renamed_from$qt\E) /
 935             : qr/^ALTER TABLE \Q$table_name\E /;
 936
 937   my $first = shift  @stmts;
 938   my ($alter_table) = $first =~ /($re)/;
 939
 940   my $padd = " " x length($alter_table);
 941
 942   return @drop_stmt, join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts);
 943
 944 }
 945
 946 sub drop_table {
 947   my ($table, $options) = @_;
 948
 949     my $qt = $options->{quote_table_names} || '';
 950
 951   # Drop (foreign key) constraints so table drops cleanly
 952   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
 953
 954   return (@sql, "DROP TABLE $qt$table$qt");
 955 #  return join("\n", @sql, "DROP TABLE $qt$table$qt");
 956
 957 }
 958
 959 sub rename_table {
 960   my ($old_table, $new_table, $options) = @_;
 961
 962   my $qt = $options->{quote_table_names} || '';
 963
 964   return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
 965 }
 966
 967 sub next_unused_name {
 968   my $name       = shift || '';
 969   if ( !defined($used_names{$name}) ) {
 970     $used_names{$name} = $name;
 971     return $name;
 972   }
 973
 974   my $i = 1;
 975   while ( defined($used_names{$name . '_' . $i}) ) {
 976     ++$i;
 977   }
 978   $name .= '_' . $i;
 979   $used_names{$name} = $name;
 980   return $name;
 981 }
 982
 983 1;
 984
 985 # -------------------------------------------------------------------
 986
 987 =pod
 988
 989 =head1 SEE ALSO
 990
 991 SQL::Translator, http://www.mysql.com/.
 992
 993 =head1 AUTHORS
 994
 995 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 996 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 997
 998 =cut