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 =head2 Table Types
  44
  45 Normally the tables will be created without any explicit table type given and
  46 so will use the MySQL default.
  47
  48 Any tables involved in foreign key constraints automatically get a table type
  49 of InnoDB, unless this is overridden by setting the C<mysql_table_type> extra
  50 attribute explicitly on the table.
  51
  52 =head2 Extra attributes.
  53
  54 The producer recognises the following extra attributes on the Schema objects.
  55
  56 =over 4
  57
  58 =item field.list
  59
  60 Set the list of allowed values for Enum fields.
  61
  62 =item field.binary, field.unsigned, field.zerofill
  63
  64 Set the MySQL field options of the same name.
  65
  66 =item field.renamed_from
  67
  68 Used when producing diffs to say this column is the new name fo the specified
  69 old column.
  70
  71 =item table.mysql_table_type
  72
  73 Set the type of the table e.g. 'InnoDB', 'MyISAM'. This will be
  74 automatically set for tables involved in foreign key constraints if it is
  75 not already set explicitly. See L<"Table Types">.
  76
  77 =item table.mysql_charset, table.mysql_collate
  78
  79 Set the tables default charater set and collation order.
  80
  81 =item field.mysql_charset, field.mysql_collate
  82
  83 Set the fields charater set and collation order.
  84
  85 =back
  86
  87 =cut
  88
  89 use strict;
  90 use warnings;
  91 use vars qw[ $VERSION $DEBUG %used_names ];
  92 $VERSION = sprintf "%d.%02d", q$Revision: 1.54 $ =~ /(\d+)\.(\d+)/;
  93 $DEBUG   = 0 unless defined $DEBUG;
  94
  95 use Data::Dumper;
  96 use SQL::Translator::Schema::Constants;
  97 use SQL::Translator::Utils qw(debug header_comment);
  98
  99 #
 100 # Use only lowercase for the keys (e.g. "long" and not "LONG")
 101 #
 102 my %translate  = (
 103     #
 104     # Oracle types
 105     #
 106     varchar2   => 'varchar',
 107     long       => 'text',
 108     clob       => 'longtext',
 109
 110     #
 111     # Sybase types
 112     #
 113     int        => 'integer',
 114     money      => 'float',
 115     real       => 'double',
 116     comment    => 'text',
 117     bit        => 'tinyint',
 118
 119     #
 120     # Access types
 121     #
 122     'long integer' => 'integer',
 123     'text'         => 'text',
 124     'datetime'     => 'datetime',
 125 );
 126
 127
 128 sub preprocess_schema {
 129     my ($class, $schema) = @_;
 130
 131     # extra->{mysql_table_type} used to be the type. It belongs in options, so
 132     # move it if we find it. Return Engine type if found in extra or options
 133     my $mysql_table_type_to_options = sub {
 134       my ($table) = @_;
 135
 136       my $extra = $table->extra;
 137
 138       my $extra_type = delete $extra->{mysql_table_type};
 139
 140       # Now just to find if there is already an Engine or Type option...
 141       # and lets normalize it to ENGINE since:
 142       #
 143       # The ENGINE table option specifies the storage engine for the table.
 144       # TYPE is a synonym, but ENGINE is the preferred option name.
 145       #
 146
 147       # We have to use the hash directly here since otherwise there is no way
 148       # to remove options.
 149       my $options = ( $table->{options} ||= []);
 150
 151       # This assumes that there isn't both a Type and an Engine option.
 152       for my $idx ( 0..$#{$options} ) {
 153         my ($key, $value) = %{ $options->[$idx] };
 154
 155         next unless uc $key eq 'ENGINE' || uc $key eq 'TYPE';
 156
 157         # if the extra.mysql_table_type is given, use that
 158         delete $options->[$idx]{$key};
 159         return $options->[$idx]{ENGINE} = $value || $extra_type;
 160
 161       }
 162
 163       if ($extra_type) {
 164         push @$options, { ENGINE => $extra_type };
 165         return $extra_type;
 166       }
 167
 168     };
 169
 170     #
 171     # Work out which tables need to be InnoDB to support foreign key
 172     # constraints. We do this first as we need InnoDB at both ends.
 173     #
 174     foreach my $table ( $schema->get_tables ) {
 175
 176         $mysql_table_type_to_options->($table);
 177
 178         foreach ( $table->get_constraints ) {
 179             next unless $_->type eq FOREIGN_KEY;
 180             for my $meth (qw/table reference_table/) {
 181                 my $table = $schema->get_table($_->$meth) || next;
 182                 next if $mysql_table_type_to_options->($table);
 183                 $table->options( { 'ENGINE' => 'InnoDB' } );
 184             }
 185         }
 186     }
 187 }
 188
 189 sub produce {
 190     my $translator     = shift;
 191     local $DEBUG       = $translator->debug;
 192     local %used_names;
 193     my $no_comments    = $translator->no_comments;
 194     my $add_drop_table = $translator->add_drop_table;
 195     my $schema         = $translator->schema;
 196     my $show_warnings  = $translator->show_warnings || 0;
 197
 198     my ($qt, $qf) = ('','');
 199     $qt = '`' if $translator->quote_table_names;
 200     $qf = '`' if $translator->quote_field_names;
 201
 202     debug("PKG: Beginning production\n");
 203     %used_names = ();
 204     my $create;
 205     $create .= header_comment unless ($no_comments);
 206     # \todo Don't set if MySQL 3.x is set on command line
 207     $create .= "SET foreign_key_checks=0;\n\n";
 208
 209     __PACKAGE__->preprocess_schema($schema);
 210
 211     #
 212     # Generate sql
 213     #
 214     my @table_defs =();
 215
 216     for my $table ( $schema->get_tables ) {
 217 #        print $table->name, "\n";
 218         push @table_defs, create_table($table,
 219                                        { add_drop_table    => $add_drop_table,
 220                                          show_warnings     => $show_warnings,
 221                                          no_comments       => $no_comments,
 222                                          quote_table_names => $qt,
 223                                          quote_field_names => $qf
 224                                          });
 225     }
 226
 227 #    print "@table_defs\n";
 228     push @table_defs, "SET foreign_key_checks=1;\n\n";
 229
 230     return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
 231 }
 232
 233 sub create_table
 234 {
 235     my ($table, $options) = @_;
 236
 237     my $qt = $options->{quote_table_names} || '';
 238     my $qf = $options->{quote_field_names} || '';
 239
 240     my $table_name = $table->name;
 241     debug("PKG: Looking at table '$table_name'\n");
 242
 243     #
 244     # Header.  Should this look like what mysqldump produces?
 245     #
 246     my $create = '';
 247     my $drop;
 248     $create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
 249     $drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
 250     $create .= "CREATE TABLE $qt$table_name$qt (\n";
 251
 252     #
 253     # Fields
 254     #
 255     my @field_defs;
 256     for my $field ( $table->get_fields ) {
 257         push @field_defs, create_field($field, $options);
 258     }
 259
 260     #
 261     # Indices
 262     #
 263     my @index_defs;
 264     my %indexed_fields;
 265     for my $index ( $table->get_indices ) {
 266         push @index_defs, create_index($index, $options);
 267         $indexed_fields{ $_ } = 1 for $index->fields;
 268     }
 269
 270     #
 271     # Constraints -- need to handle more than just FK. -ky
 272     #
 273     my @constraint_defs;
 274     my @constraints = $table->get_constraints;
 275     for my $c ( @constraints ) {
 276         my $constr = create_constraint($c, $options);
 277         push @constraint_defs, $constr if($constr);
 278
 279          unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
 280              push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
 281              $indexed_fields{ ($c->fields())[0] } = 1;
 282          }
 283     }
 284
 285     $create .= join(",\n", map { "  $_" }
 286                     @field_defs, @index_defs, @constraint_defs
 287                     );
 288
 289     #
 290     # Footer
 291     #
 292     $create .= "\n)";
 293     $create .= generate_table_options($table) || '';
 294     $create .= ";\n\n";
 295
 296     return $drop ? ($drop,$create) : $create;
 297 }
 298
 299 sub generate_table_options
 300 {
 301   my ($table) = @_;
 302   my $create;
 303
 304   my $table_type_defined = 0;
 305   for my $t1_option_ref ( $table->options ) {
 306     my($key, $value) = %{$t1_option_ref};
 307     $table_type_defined = 1
 308       if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
 309     $create .= " $key=$value";
 310   }
 311
 312   my $mysql_table_type = $table->extra('mysql_table_type');
 313   $create .= " ENGINE=$mysql_table_type"
 314     if $mysql_table_type && !$table_type_defined;
 315   my $charset          = $table->extra('mysql_charset');
 316   my $collate          = $table->extra('mysql_collate');
 317   my $comments         = $table->comments;
 318
 319   $create .= " DEFAULT CHARACTER SET $charset" if $charset;
 320   $create .= " COLLATE $collate" if $collate;
 321   $create .= qq[ comment='$comments'] if $comments;
 322   return $create;
 323 }
 324
 325 sub create_field
 326 {
 327     my ($field, $options) = @_;
 328
 329     my $qf = $options->{quote_field_names} ||= '';
 330
 331     my $field_name = $field->name;
 332     debug("PKG: Looking at field '$field_name'\n");
 333     my $field_def = "$qf$field_name$qf";
 334
 335     # data type and size
 336     my $data_type = $field->data_type;
 337     my @size      = $field->size;
 338     my %extra     = $field->extra;
 339     my $list      = $extra{'list'} || [];
 340     # \todo deal with embedded quotes
 341     my $commalist = join( ', ', map { qq['$_'] } @$list );
 342     my $charset = $extra{'mysql_charset'};
 343     my $collate = $extra{'mysql_collate'};
 344
 345     #
 346     # Oracle "number" type -- figure best MySQL type
 347     #
 348     if ( lc $data_type eq 'number' ) {
 349         # not an integer
 350         if ( scalar @size > 1 ) {
 351             $data_type = 'double';
 352         }
 353         elsif ( $size[0] && $size[0] >= 12 ) {
 354             $data_type = 'bigint';
 355         }
 356         elsif ( $size[0] && $size[0] <= 1 ) {
 357             $data_type = 'tinyint';
 358         }
 359         else {
 360             $data_type = 'int';
 361         }
 362     }
 363     #
 364     # Convert a large Oracle varchar to "text"
 365     #
 366     elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
 367         $data_type = 'text';
 368         @size      = ();
 369     }
 370     elsif ( $data_type =~ /char/i && ! $size[0] ) {
 371         @size = (255);
 372     }
 373     elsif ( $data_type =~ /boolean/i ) {
 374         $data_type = 'enum';
 375         $commalist = "'0','1'";
 376     }
 377     elsif ( exists $translate{ lc $data_type } ) {
 378         $data_type = $translate{ lc $data_type };
 379     }
 380
 381     @size = () if $data_type =~ /(text|blob)/i;
 382
 383     if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
 384         push @size, '0';
 385     }
 386
 387     $field_def .= " $data_type";
 388
 389     if ( lc $data_type eq 'enum' ) {
 390         $field_def .= '(' . $commalist . ')';
 391     }
 392     elsif ( defined $size[0] && $size[0] > 0 ) {
 393         $field_def .= '(' . join( ', ', @size ) . ')';
 394     }
 395
 396     # char sets
 397     $field_def .= " CHARACTER SET $charset" if $charset;
 398     $field_def .= " COLLATE $collate" if $collate;
 399
 400     # MySQL qualifiers
 401     for my $qual ( qw[ binary unsigned zerofill ] ) {
 402         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 403         $field_def .= " $qual";
 404     }
 405     for my $qual ( 'character set', 'collate', 'on update' ) {
 406         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 407         $field_def .= " $qual $val";
 408     }
 409
 410     # Null?
 411     $field_def .= ' NOT NULL' unless $field->is_nullable;
 412
 413     # Default?  XXX Need better quoting!
 414     my $default = $field->default_value;
 415     if ( defined $default ) {
 416         if ( uc $default eq 'NULL') {
 417             $field_def .= ' DEFAULT NULL';
 418         } else {
 419             $field_def .= " DEFAULT '$default'";
 420         }
 421     }
 422
 423     if ( my $comments = $field->comments ) {
 424         $field_def .= qq[ comment '$comments'];
 425     }
 426
 427     # auto_increment?
 428     $field_def .= " auto_increment" if $field->is_auto_increment;
 429
 430     return $field_def;
 431 }
 432
 433 sub alter_create_index
 434 {
 435     my ($index, $options) = @_;
 436
 437     my $qt = $options->{quote_table_names} || '';
 438     my $qf = $options->{quote_field_names} || '';
 439
 440     return join( ' ',
 441                  'ALTER TABLE',
 442                  $qt.$index->table->name.$qt,
 443                  'ADD',
 444                  create_index(@_)
 445                  );
 446 }
 447
 448 sub create_index
 449 {
 450     my ($index, $options) = @_;
 451
 452     my $qf = $options->{quote_field_names} || '';
 453
 454     return join( ' ',
 455                  lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 456                  $index->name,
 457                  '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 458                  );
 459
 460 }
 461
 462 sub alter_drop_index
 463 {
 464     my ($index, $options) = @_;
 465
 466     my $qt = $options->{quote_table_names} || '';
 467     my $qf = $options->{quote_field_names} || '';
 468
 469     return join( ' ',
 470                  'ALTER TABLE',
 471                  $qt.$index->table->name.$qt,
 472                  'DROP',
 473                  'INDEX',
 474                  $index->name || $index->fields
 475                  );
 476
 477 }
 478
 479 sub alter_drop_constraint
 480 {
 481     my ($c, $options) = @_;
 482
 483     my $qt      = $options->{quote_table_names} || '';
 484     my $qc      = $options->{quote_constraint_names} || '';
 485
 486     my $out = sprintf('ALTER TABLE %s DROP %s %s',
 487                       $c->table->name,
 488                       $c->type,
 489                       $qc . $c->name . $qc );
 490
 491     return $out;
 492 }
 493
 494 sub alter_create_constraint
 495 {
 496     my ($index, $options) = @_;
 497
 498     my $qt = $options->{quote_table_names} || '';
 499     return join( ' ',
 500                  'ALTER TABLE',
 501                  $qt.$index->table->name.$qt,
 502                  'ADD',
 503                  create_constraint(@_) );
 504 }
 505
 506 sub create_constraint
 507 {
 508     my ($c, $options) = @_;
 509
 510     my $qf      = $options->{quote_field_names} || '';
 511     my $qt      = $options->{quote_table_names} || '';
 512     my $leave_name      = $options->{leave_name} || undef;
 513     my $counter = ($options->{fk_name_counter}   ||= {});
 514
 515     my @fields = $c->fields or next;
 516
 517     if ( $c->type eq PRIMARY_KEY ) {
 518         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 519     }
 520     elsif ( $c->type eq UNIQUE ) {
 521         return
 522         'UNIQUE '.
 523             (defined $c->name ? $qf.$c->name.$qf.' ' : '').
 524             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
 525     }
 526     elsif ( $c->type eq FOREIGN_KEY ) {
 527         #
 528         # Make sure FK field is indexed or MySQL complains.
 529         #
 530
 531         my $table = $c->table;
 532         my $c_name = $c->name;
 533
 534         # Give the constraint a name if it doesn't have one, so it doens't feel
 535         # left out
 536         unless ( $c_name ){
 537             $c_name   = $table->name . '_fk';
 538         }
 539
 540         $counter->{$table} ||= {};
 541         my $def = join(' ',
 542                        map { $_ || () }
 543                          'CONSTRAINT',
 544                          $qt . join('_', next_unused_name($c_name)
 545                                    ) . $qt,
 546                          'FOREIGN KEY'
 547                       );
 548
 549
 550         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 551
 552         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
 553
 554         my @rfields = map { $_ || () } $c->reference_fields;
 555         unless ( @rfields ) {
 556             my $rtable_name = $c->reference_table;
 557             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 558                 push @rfields, $ref_table->primary_key;
 559             }
 560             else {
 561                 warn "Can't find reference table '$rtable_name' " .
 562                     "in schema\n" if $options->{show_warnings};
 563             }
 564         }
 565
 566         if ( @rfields ) {
 567             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 568         }
 569         else {
 570             warn "FK constraint on " . $table->name . '.' .
 571                 join('', @fields) . " has no reference fields\n"
 572                 if $options->{show_warnings};
 573         }
 574
 575         if ( $c->match_type ) {
 576             $def .= ' MATCH ' .
 577                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 578         }
 579
 580         if ( $c->on_delete ) {
 581             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 582         }
 583
 584         if ( $c->on_update ) {
 585             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 586         }
 587         return $def;
 588     }
 589
 590     return undef;
 591 }
 592
 593 sub alter_table
 594 {
 595     my ($to_table, $options) = @_;
 596
 597     my $qt = $options->{quote_table_name} || '';
 598
 599     my $table_options = generate_table_options($to_table) || '';
 600     my $out = sprintf('ALTER TABLE %s%s',
 601                       $qt . $to_table->name . $qt,
 602                       $table_options);
 603
 604     return $out;
 605 }
 606
 607 sub rename_field { alter_field(@_) }
 608 sub alter_field
 609 {
 610     my ($from_field, $to_field, $options) = @_;
 611
 612     my $qf = $options->{quote_field_name} || '';
 613     my $qt = $options->{quote_table_name} || '';
 614
 615     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 616                       $qt . $to_field->table->name . $qt,
 617                       $qf . $from_field->name . $qf,
 618                       create_field($to_field, $options));
 619
 620     return $out;
 621 }
 622
 623 sub add_field
 624 {
 625     my ($new_field, $options) = @_;
 626
 627     my $qt = $options->{quote_table_name} || '';
 628
 629     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 630                       $qt . $new_field->table->name . $qt,
 631                       create_field($new_field, $options));
 632
 633     return $out;
 634
 635 }
 636
 637 sub drop_field
 638 {
 639     my ($old_field, $options) = @_;
 640
 641     my $qf = $options->{quote_field_name} || '';
 642     my $qt = $options->{quote_table_name} || '';
 643
 644     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 645                       $qt . $old_field->table->name . $qt,
 646                       $qf . $old_field->name . $qf);
 647
 648     return $out;
 649
 650 }
 651
 652 sub batch_alter_table {
 653   my ($table, $diff_hash, $options) = @_;
 654
 655   my @stmts = map {
 656     if (@{ $diff_hash->{$_} || [] }) {
 657       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 658       map { $meth->(ref $_ eq 'ARRAY' ? @$_ : $_) } @{ $diff_hash->{$_} }
 659     } else { () }
 660   } qw/alter_drop_constraint
 661        alter_drop_index
 662        drop_field
 663        add_field
 664        alter_field
 665        rename_field
 666        alter_create_index
 667        alter_create_constraint
 668        alter_table/;
 669
 670   return unless @stmts;
 671   # Just zero or one stmts. return now
 672   return "@stmts;" unless @stmts > 1;
 673
 674   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 675
 676   my $qt = $options->{quote_table_name} || '';
 677   my $table_name = $qt . $table->name . $qt;
 678
 679   my $first = shift  @stmts;
 680   my ($alter_table) = $first =~ /^(ALTER TABLE \Q$table_name\E )/;
 681   my $re = qr/^$alter_table/;
 682   my $padd = " " x length($alter_table);
 683
 684   return join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts) . ';';
 685 }
 686
 687 sub drop_table {
 688   my ($table) = @_;
 689
 690   # Drop (foreign key) constraints so table drops cleanly
 691   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] });
 692
 693   return join("\n", @sql, "DROP TABLE $table;");
 694
 695 }
 696
 697 sub next_unused_name {
 698   my $name       = shift || '';
 699   if ( !defined($used_names{$name}) ) {
 700     $used_names{$name} = $name;
 701     return $name;
 702   }
 703
 704   my $i = 1;
 705   while ( defined($used_names{$name . '_' . $i}) ) {
 706     ++$i;
 707   }
 708   $name .= '_' . $i;
 709   $used_names{$name} = $name;
 710   return $name;
 711 }
 712
 713 1;
 714
 715 # -------------------------------------------------------------------
 716
 717 =pod
 718
 719 =head1 SEE ALSO
 720
 721 SQL::Translator, http://www.mysql.com/.
 722
 723 =head1 AUTHORS
 724
 725 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 726 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 727
 728 =cut