lib/SQL/Translator/Producer/MySQL.pm

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