lib/SQL/Translator/Producer/MySQL.pm

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