lib/SQL/Translator/Producer/MySQL.pm

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