lib/SQL/Translator/Producer/MySQL.pm

   1 package SQL::Translator::Producer::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.54 2007-11-10 03:36:43 mwz444 Exp $
   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: 1.54 $ =~ /(\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           'CURRENT_TIMESTAMP'
 571           ],
 572         );
 573     }
 574
 575     if ( my $comments = $field->comments ) {
 576         $field_def .= qq[ comment '$comments'];
 577     }
 578
 579     # auto_increment?
 580     $field_def .= " auto_increment" if $field->is_auto_increment;
 581
 582     return $field_def;
 583 }
 584
 585 sub alter_create_index
 586 {
 587     my ($index, $options) = @_;
 588
 589     my $qt = $options->{quote_table_names} || '';
 590     my $qf = $options->{quote_field_names} || '';
 591
 592     return join( ' ',
 593                  'ALTER TABLE',
 594                  $qt.$index->table->name.$qt,
 595                  'ADD',
 596                  create_index(@_)
 597                  );
 598 }
 599
 600 sub create_index
 601 {
 602     my ($index, $options) = @_;
 603
 604     my $qf = $options->{quote_field_names} || '';
 605
 606     return join( ' ',
 607                  lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 608                  truncate_id_uniquely( $index->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ),
 609                  '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 610                  );
 611
 612 }
 613
 614 sub alter_drop_index
 615 {
 616     my ($index, $options) = @_;
 617
 618     my $qt = $options->{quote_table_names} || '';
 619     my $qf = $options->{quote_field_names} || '';
 620
 621     return join( ' ',
 622                  'ALTER TABLE',
 623                  $qt.$index->table->name.$qt,
 624                  'DROP',
 625                  'INDEX',
 626                  $index->name || $index->fields
 627                  );
 628
 629 }
 630
 631 sub alter_drop_constraint
 632 {
 633     my ($c, $options) = @_;
 634
 635     my $qt      = $options->{quote_table_names} || '';
 636     my $qc      = $options->{quote_field_names} || '';
 637
 638     my $out = sprintf('ALTER TABLE %s DROP %s %s',
 639                       $qt . $c->table->name . $qt,
 640                       $c->type eq FOREIGN_KEY ? $c->type : "INDEX",
 641                       $qc . $c->name . $qc );
 642
 643     return $out;
 644 }
 645
 646 sub alter_create_constraint
 647 {
 648     my ($index, $options) = @_;
 649
 650     my $qt = $options->{quote_table_names} || '';
 651     return join( ' ',
 652                  'ALTER TABLE',
 653                  $qt.$index->table->name.$qt,
 654                  'ADD',
 655                  create_constraint(@_) );
 656 }
 657
 658 sub create_constraint
 659 {
 660     my ($c, $options) = @_;
 661
 662     my $qf      = $options->{quote_field_names} || '';
 663     my $qt      = $options->{quote_table_names} || '';
 664     my $leave_name      = $options->{leave_name} || undef;
 665
 666     my @fields = $c->fields or next;
 667
 668     if ( $c->type eq PRIMARY_KEY ) {
 669         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 670     }
 671     elsif ( $c->type eq UNIQUE ) {
 672         return
 673         'UNIQUE '.
 674             (defined $c->name ? $qf.truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ).$qf.' ' : '').
 675             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
 676     }
 677     elsif ( $c->type eq FOREIGN_KEY ) {
 678         #
 679         # Make sure FK field is indexed or MySQL complains.
 680         #
 681
 682         my $table = $c->table;
 683         my $c_name = truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH );
 684
 685         my $def = join(' ',
 686                        map { $_ || () }
 687                          'CONSTRAINT',
 688                          $qf . $c_name . $qf,
 689                          'FOREIGN KEY'
 690                       );
 691
 692
 693         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 694
 695         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
 696
 697         my @rfields = map { $_ || () } $c->reference_fields;
 698         unless ( @rfields ) {
 699             my $rtable_name = $c->reference_table;
 700             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 701                 push @rfields, $ref_table->primary_key;
 702             }
 703             else {
 704                 warn "Can't find reference table '$rtable_name' " .
 705                     "in schema\n" if $options->{show_warnings};
 706             }
 707         }
 708
 709         if ( @rfields ) {
 710             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 711         }
 712         else {
 713             warn "FK constraint on " . $table->name . '.' .
 714                 join('', @fields) . " has no reference fields\n"
 715                 if $options->{show_warnings};
 716         }
 717
 718         if ( $c->match_type ) {
 719             $def .= ' MATCH ' .
 720                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 721         }
 722
 723         if ( $c->on_delete ) {
 724             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 725         }
 726
 727         if ( $c->on_update ) {
 728             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 729         }
 730         return $def;
 731     }
 732
 733     return undef;
 734 }
 735
 736 sub alter_table
 737 {
 738     my ($to_table, $options) = @_;
 739
 740     my $qt = $options->{quote_table_names} || '';
 741
 742     my $table_options = generate_table_options($to_table, $options) || '';
 743     my $out = sprintf('ALTER TABLE %s%s',
 744                       $qt . $to_table->name . $qt,
 745                       $table_options);
 746
 747     return $out;
 748 }
 749
 750 sub rename_field { alter_field(@_) }
 751 sub alter_field
 752 {
 753     my ($from_field, $to_field, $options) = @_;
 754
 755     my $qf = $options->{quote_field_names} || '';
 756     my $qt = $options->{quote_table_names} || '';
 757
 758     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 759                       $qt . $to_field->table->name . $qt,
 760                       $qf . $from_field->name . $qf,
 761                       create_field($to_field, $options));
 762
 763     return $out;
 764 }
 765
 766 sub add_field
 767 {
 768     my ($new_field, $options) = @_;
 769
 770     my $qt = $options->{quote_table_names} || '';
 771
 772     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 773                       $qt . $new_field->table->name . $qt,
 774                       create_field($new_field, $options));
 775
 776     return $out;
 777
 778 }
 779
 780 sub drop_field
 781 {
 782     my ($old_field, $options) = @_;
 783
 784     my $qf = $options->{quote_field_names} || '';
 785     my $qt = $options->{quote_table_names} || '';
 786
 787     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 788                       $qt . $old_field->table->name . $qt,
 789                       $qf . $old_field->name . $qf);
 790
 791     return $out;
 792
 793 }
 794
 795 sub batch_alter_table {
 796   my ($table, $diff_hash, $options) = @_;
 797
 798   # InnoDB has an issue with dropping and re-adding a FK constraint under the
 799   # name in a single alter statment, see: http://bugs.mysql.com/bug.php?id=13741
 800   #
 801   # We have to work round this.
 802
 803   my %fks_to_alter;
 804   my %fks_to_drop = map {
 805     $_->type eq FOREIGN_KEY
 806               ? ( $_->name => $_ )
 807               : ( )
 808   } @{$diff_hash->{alter_drop_constraint} };
 809
 810   my %fks_to_create = map {
 811     if ( $_->type eq FOREIGN_KEY) {
 812       $fks_to_alter{$_->name} = $fks_to_drop{$_->name} if $fks_to_drop{$_->name};
 813       ( $_->name => $_ );
 814     } else { ( ) }
 815   } @{$diff_hash->{alter_create_constraint} };
 816
 817   my @drop_stmt;
 818   if (scalar keys %fks_to_alter) {
 819     $diff_hash->{alter_drop_constraint} = [
 820       grep { !$fks_to_alter{$_->name} } @{ $diff_hash->{alter_drop_constraint} }
 821     ];
 822
 823     @drop_stmt = batch_alter_table($table, { alter_drop_constraint => [ values %fks_to_alter ] }, $options);
 824
 825   }
 826
 827   my @stmts = map {
 828     if (@{ $diff_hash->{$_} || [] }) {
 829       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 830       map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
 831     } else { () }
 832   } qw/rename_table
 833        alter_drop_constraint
 834        alter_drop_index
 835        drop_field
 836        add_field
 837        alter_field
 838        rename_field
 839        alter_create_index
 840        alter_create_constraint
 841        alter_table/;
 842
 843   # rename_table makes things a bit more complex
 844   my $renamed_from = "";
 845   $renamed_from = $diff_hash->{rename_table}[0][0]->name
 846     if $diff_hash->{rename_table} && @{$diff_hash->{rename_table}};
 847
 848   return unless @stmts;
 849   # Just zero or one stmts. return now
 850   return (@drop_stmt,@stmts) unless @stmts > 1;
 851
 852   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 853
 854   my $qt = $options->{quote_table_names} || '';
 855   my $table_name = $qt . $table->name . $qt;
 856
 857
 858   my $re = $renamed_from
 859          ? qr/^ALTER TABLE (?:\Q$table_name\E|\Q$qt$renamed_from$qt\E) /
 860             : qr/^ALTER TABLE \Q$table_name\E /;
 861
 862   my $first = shift  @stmts;
 863   my ($alter_table) = $first =~ /($re)/;
 864
 865   my $padd = " " x length($alter_table);
 866
 867   return @drop_stmt, join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts);
 868
 869 }
 870
 871 sub drop_table {
 872   my ($table, $options) = @_;
 873
 874     my $qt = $options->{quote_table_names} || '';
 875
 876   # Drop (foreign key) constraints so table drops cleanly
 877   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] }, $options);
 878
 879   return (@sql, "DROP TABLE $qt$table$qt");
 880 #  return join("\n", @sql, "DROP TABLE $qt$table$qt");
 881
 882 }
 883
 884 sub rename_table {
 885   my ($old_table, $new_table, $options) = @_;
 886
 887   my $qt = $options->{quote_table_names} || '';
 888
 889   return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
 890 }
 891
 892 sub next_unused_name {
 893   my $name       = shift || '';
 894   if ( !defined($used_names{$name}) ) {
 895     $used_names{$name} = $name;
 896     return $name;
 897   }
 898
 899   my $i = 1;
 900   while ( defined($used_names{$name . '_' . $i}) ) {
 901     ++$i;
 902   }
 903   $name .= '_' . $i;
 904   $used_names{$name} = $name;
 905   return $name;
 906 }
 907
 908 1;
 909
 910 # -------------------------------------------------------------------
 911
 912 =pod
 913
 914 =head1 SEE ALSO
 915
 916 SQL::Translator, http://www.mysql.com/.
 917
 918 =head1 AUTHORS
 919
 920 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 921 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 922
 923 =cut