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     # Names are only specific to a given schema
 171     local %used_names = ();
 172
 173     #
 174     # Work out which tables need to be InnoDB to support foreign key
 175     # constraints. We do this first as we need InnoDB at both ends.
 176     #
 177     foreach my $table ( $schema->get_tables ) {
 178
 179         $mysql_table_type_to_options->($table);
 180
 181         foreach my $c( $table->get_constraints ) {
 182             next unless $c->type eq FOREIGN_KEY;
 183
 184             # Normalize constraint names here.
 185             my $c_name = $c->name;
 186             # Give the constraint a name if it doesn't have one, so it doens't feel
 187             # left out
 188             $c_name   = $table->name . '_fk' unless length $c_name;
 189
 190             $c->name( next_unused_name($c_name) );
 191
 192             for my $meth (qw/table reference_table/) {
 193                 my $table = $schema->get_table($c->$meth) || next;
 194                 next if $mysql_table_type_to_options->($table);
 195                 $table->options( { 'ENGINE' => 'InnoDB' } );
 196             }
 197         }
 198     }
 199 }
 200
 201 sub produce {
 202     my $translator     = shift;
 203     local $DEBUG       = $translator->debug;
 204     local %used_names;
 205     my $no_comments    = $translator->no_comments;
 206     my $add_drop_table = $translator->add_drop_table;
 207     my $schema         = $translator->schema;
 208     my $show_warnings  = $translator->show_warnings || 0;
 209
 210     my ($qt, $qf) = ('','');
 211     $qt = '`' if $translator->quote_table_names;
 212     $qf = '`' if $translator->quote_field_names;
 213
 214     debug("PKG: Beginning production\n");
 215     %used_names = ();
 216     my $create;
 217     $create .= header_comment unless ($no_comments);
 218     # \todo Don't set if MySQL 3.x is set on command line
 219     $create .= "SET foreign_key_checks=0;\n\n";
 220
 221     __PACKAGE__->preprocess_schema($schema);
 222
 223     #
 224     # Generate sql
 225     #
 226     my @table_defs =();
 227
 228     for my $table ( $schema->get_tables ) {
 229 #        print $table->name, "\n";
 230         push @table_defs, create_table($table,
 231                                        { add_drop_table    => $add_drop_table,
 232                                          show_warnings     => $show_warnings,
 233                                          no_comments       => $no_comments,
 234                                          quote_table_names => $qt,
 235                                          quote_field_names => $qf
 236                                          });
 237     }
 238
 239 #    print "@table_defs\n";
 240     push @table_defs, "SET foreign_key_checks=1;\n\n";
 241
 242     return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
 243 }
 244
 245 sub create_table
 246 {
 247     my ($table, $options) = @_;
 248
 249     my $qt = $options->{quote_table_names} || '';
 250     my $qf = $options->{quote_field_names} || '';
 251
 252     my $table_name = $table->name;
 253     debug("PKG: Looking at table '$table_name'\n");
 254
 255     #
 256     # Header.  Should this look like what mysqldump produces?
 257     #
 258     my $create = '';
 259     my $drop;
 260     $create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
 261     $drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
 262     $create .= "CREATE TABLE $qt$table_name$qt (\n";
 263
 264     #
 265     # Fields
 266     #
 267     my @field_defs;
 268     for my $field ( $table->get_fields ) {
 269         push @field_defs, create_field($field, $options);
 270     }
 271
 272     #
 273     # Indices
 274     #
 275     my @index_defs;
 276     my %indexed_fields;
 277     for my $index ( $table->get_indices ) {
 278         push @index_defs, create_index($index, $options);
 279         $indexed_fields{ $_ } = 1 for $index->fields;
 280     }
 281
 282     #
 283     # Constraints -- need to handle more than just FK. -ky
 284     #
 285     my @constraint_defs;
 286     my @constraints = $table->get_constraints;
 287     for my $c ( @constraints ) {
 288         my $constr = create_constraint($c, $options);
 289         push @constraint_defs, $constr if($constr);
 290
 291          unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
 292              push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
 293              $indexed_fields{ ($c->fields())[0] } = 1;
 294          }
 295     }
 296
 297     $create .= join(",\n", map { "  $_" }
 298                     @field_defs, @index_defs, @constraint_defs
 299                     );
 300
 301     #
 302     # Footer
 303     #
 304     $create .= "\n)";
 305     $create .= generate_table_options($table) || '';
 306     $create .= ";\n\n";
 307
 308     return $drop ? ($drop,$create) : $create;
 309 }
 310
 311 sub generate_table_options
 312 {
 313   my ($table) = @_;
 314   my $create;
 315
 316   my $table_type_defined = 0;
 317   for my $t1_option_ref ( $table->options ) {
 318     my($key, $value) = %{$t1_option_ref};
 319     $table_type_defined = 1
 320       if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
 321     $create .= " $key=$value";
 322   }
 323
 324   my $mysql_table_type = $table->extra('mysql_table_type');
 325   $create .= " ENGINE=$mysql_table_type"
 326     if $mysql_table_type && !$table_type_defined;
 327   my $charset          = $table->extra('mysql_charset');
 328   my $collate          = $table->extra('mysql_collate');
 329   my $comments         = $table->comments;
 330
 331   $create .= " DEFAULT CHARACTER SET $charset" if $charset;
 332   $create .= " COLLATE $collate" if $collate;
 333   $create .= qq[ comment='$comments'] if $comments;
 334   return $create;
 335 }
 336
 337 sub create_field
 338 {
 339     my ($field, $options) = @_;
 340
 341     my $qf = $options->{quote_field_names} ||= '';
 342
 343     my $field_name = $field->name;
 344     debug("PKG: Looking at field '$field_name'\n");
 345     my $field_def = "$qf$field_name$qf";
 346
 347     # data type and size
 348     my $data_type = $field->data_type;
 349     my @size      = $field->size;
 350     my %extra     = $field->extra;
 351     my $list      = $extra{'list'} || [];
 352     # \todo deal with embedded quotes
 353     my $commalist = join( ', ', map { qq['$_'] } @$list );
 354     my $charset = $extra{'mysql_charset'};
 355     my $collate = $extra{'mysql_collate'};
 356
 357     #
 358     # Oracle "number" type -- figure best MySQL type
 359     #
 360     if ( lc $data_type eq 'number' ) {
 361         # not an integer
 362         if ( scalar @size > 1 ) {
 363             $data_type = 'double';
 364         }
 365         elsif ( $size[0] && $size[0] >= 12 ) {
 366             $data_type = 'bigint';
 367         }
 368         elsif ( $size[0] && $size[0] <= 1 ) {
 369             $data_type = 'tinyint';
 370         }
 371         else {
 372             $data_type = 'int';
 373         }
 374     }
 375     #
 376     # Convert a large Oracle varchar to "text"
 377     #
 378     elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
 379         $data_type = 'text';
 380         @size      = ();
 381     }
 382     elsif ( $data_type =~ /char/i && ! $size[0] ) {
 383         @size = (255);
 384     }
 385     elsif ( $data_type =~ /boolean/i ) {
 386         $data_type = 'enum';
 387         $commalist = "'0','1'";
 388     }
 389     elsif ( exists $translate{ lc $data_type } ) {
 390         $data_type = $translate{ lc $data_type };
 391     }
 392
 393     @size = () if $data_type =~ /(text|blob)/i;
 394
 395     if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
 396         push @size, '0';
 397     }
 398
 399     $field_def .= " $data_type";
 400
 401     if ( lc $data_type eq 'enum' ) {
 402         $field_def .= '(' . $commalist . ')';
 403     }
 404     elsif ( defined $size[0] && $size[0] > 0 ) {
 405         $field_def .= '(' . join( ', ', @size ) . ')';
 406     }
 407
 408     # char sets
 409     $field_def .= " CHARACTER SET $charset" if $charset;
 410     $field_def .= " COLLATE $collate" if $collate;
 411
 412     # MySQL qualifiers
 413     for my $qual ( qw[ binary unsigned zerofill ] ) {
 414         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 415         $field_def .= " $qual";
 416     }
 417     for my $qual ( 'character set', 'collate', 'on update' ) {
 418         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
 419         $field_def .= " $qual $val";
 420     }
 421
 422     # Null?
 423     $field_def .= ' NOT NULL' unless $field->is_nullable;
 424
 425     # Default?  XXX Need better quoting!
 426     my $default = $field->default_value;
 427     if ( defined $default ) {
 428         if ( uc $default eq 'NULL') {
 429             $field_def .= ' DEFAULT NULL';
 430         } else {
 431             $field_def .= " DEFAULT '$default'";
 432         }
 433     }
 434
 435     if ( my $comments = $field->comments ) {
 436         $field_def .= qq[ comment '$comments'];
 437     }
 438
 439     # auto_increment?
 440     $field_def .= " auto_increment" if $field->is_auto_increment;
 441
 442     return $field_def;
 443 }
 444
 445 sub alter_create_index
 446 {
 447     my ($index, $options) = @_;
 448
 449     my $qt = $options->{quote_table_names} || '';
 450     my $qf = $options->{quote_field_names} || '';
 451
 452     return join( ' ',
 453                  'ALTER TABLE',
 454                  $qt.$index->table->name.$qt,
 455                  'ADD',
 456                  create_index(@_)
 457                  );
 458 }
 459
 460 sub create_index
 461 {
 462     my ($index, $options) = @_;
 463
 464     my $qf = $options->{quote_field_names} || '';
 465
 466     return join( ' ',
 467                  lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
 468                  $index->name,
 469                  '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
 470                  );
 471
 472 }
 473
 474 sub alter_drop_index
 475 {
 476     my ($index, $options) = @_;
 477
 478     my $qt = $options->{quote_table_names} || '';
 479     my $qf = $options->{quote_field_names} || '';
 480
 481     return join( ' ',
 482                  'ALTER TABLE',
 483                  $qt.$index->table->name.$qt,
 484                  'DROP',
 485                  'INDEX',
 486                  $index->name || $index->fields
 487                  );
 488
 489 }
 490
 491 sub alter_drop_constraint
 492 {
 493     my ($c, $options) = @_;
 494
 495     my $qt      = $options->{quote_table_names} || '';
 496     my $qc      = $options->{quote_constraint_names} || '';
 497
 498     my $out = sprintf('ALTER TABLE %s DROP %s %s',
 499                       $c->table->name,
 500                       $c->type,
 501                       $qc . $c->name . $qc );
 502
 503     return $out;
 504 }
 505
 506 sub alter_create_constraint
 507 {
 508     my ($index, $options) = @_;
 509
 510     my $qt = $options->{quote_table_names} || '';
 511     return join( ' ',
 512                  'ALTER TABLE',
 513                  $qt.$index->table->name.$qt,
 514                  'ADD',
 515                  create_constraint(@_) );
 516 }
 517
 518 sub create_constraint
 519 {
 520     my ($c, $options) = @_;
 521
 522     my $qf      = $options->{quote_field_names} || '';
 523     my $qt      = $options->{quote_table_names} || '';
 524     my $leave_name      = $options->{leave_name} || undef;
 525
 526     my @fields = $c->fields or next;
 527
 528     if ( $c->type eq PRIMARY_KEY ) {
 529         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
 530     }
 531     elsif ( $c->type eq UNIQUE ) {
 532         return
 533         'UNIQUE '.
 534             (defined $c->name ? $qf.$c->name.$qf.' ' : '').
 535             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
 536     }
 537     elsif ( $c->type eq FOREIGN_KEY ) {
 538         #
 539         # Make sure FK field is indexed or MySQL complains.
 540         #
 541
 542         my $table = $c->table;
 543         my $c_name = $c->name;
 544
 545         my $def = join(' ',
 546                        map { $_ || () }
 547                          'CONSTRAINT',
 548                          $qt . $c_name . $qt,
 549                          'FOREIGN KEY'
 550                       );
 551
 552
 553         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
 554
 555         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
 556
 557         my @rfields = map { $_ || () } $c->reference_fields;
 558         unless ( @rfields ) {
 559             my $rtable_name = $c->reference_table;
 560             if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
 561                 push @rfields, $ref_table->primary_key;
 562             }
 563             else {
 564                 warn "Can't find reference table '$rtable_name' " .
 565                     "in schema\n" if $options->{show_warnings};
 566             }
 567         }
 568
 569         if ( @rfields ) {
 570             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
 571         }
 572         else {
 573             warn "FK constraint on " . $table->name . '.' .
 574                 join('', @fields) . " has no reference fields\n"
 575                 if $options->{show_warnings};
 576         }
 577
 578         if ( $c->match_type ) {
 579             $def .= ' MATCH ' .
 580                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 581         }
 582
 583         if ( $c->on_delete ) {
 584             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 585         }
 586
 587         if ( $c->on_update ) {
 588             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 589         }
 590         return $def;
 591     }
 592
 593     return undef;
 594 }
 595
 596 sub alter_table
 597 {
 598     my ($to_table, $options) = @_;
 599
 600     my $qt = $options->{quote_table_name} || '';
 601
 602     my $table_options = generate_table_options($to_table) || '';
 603     my $out = sprintf('ALTER TABLE %s%s',
 604                       $qt . $to_table->name . $qt,
 605                       $table_options);
 606
 607     return $out;
 608 }
 609
 610 sub rename_field { alter_field(@_) }
 611 sub alter_field
 612 {
 613     my ($from_field, $to_field, $options) = @_;
 614
 615     my $qf = $options->{quote_field_name} || '';
 616     my $qt = $options->{quote_table_name} || '';
 617
 618     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
 619                       $qt . $to_field->table->name . $qt,
 620                       $qf . $from_field->name . $qf,
 621                       create_field($to_field, $options));
 622
 623     return $out;
 624 }
 625
 626 sub add_field
 627 {
 628     my ($new_field, $options) = @_;
 629
 630     my $qt = $options->{quote_table_name} || '';
 631
 632     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 633                       $qt . $new_field->table->name . $qt,
 634                       create_field($new_field, $options));
 635
 636     return $out;
 637
 638 }
 639
 640 sub drop_field
 641 {
 642     my ($old_field, $options) = @_;
 643
 644     my $qf = $options->{quote_field_name} || '';
 645     my $qt = $options->{quote_table_name} || '';
 646
 647     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 648                       $qt . $old_field->table->name . $qt,
 649                       $qf . $old_field->name . $qf);
 650
 651     return $out;
 652
 653 }
 654
 655 sub batch_alter_table {
 656   my ($table, $diff_hash, $options) = @_;
 657
 658   my @stmts = map {
 659     if (@{ $diff_hash->{$_} || [] }) {
 660       my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
 661       map { $meth->(ref $_ eq 'ARRAY' ? @$_ : $_) } @{ $diff_hash->{$_} }
 662     } else { () }
 663   } qw/alter_drop_constraint
 664        alter_drop_index
 665        drop_field
 666        add_field
 667        alter_field
 668        rename_field
 669        alter_create_index
 670        alter_create_constraint
 671        alter_table/;
 672
 673   return unless @stmts;
 674   # Just zero or one stmts. return now
 675   return "@stmts;" unless @stmts > 1;
 676
 677   # Now strip off the 'ALTER TABLE xyz' of all but the first one
 678
 679   my $qt = $options->{quote_table_name} || '';
 680   my $table_name = $qt . $table->name . $qt;
 681
 682   my $first = shift  @stmts;
 683   my ($alter_table) = $first =~ /^(ALTER TABLE \Q$table_name\E )/;
 684   my $re = qr/^$alter_table/;
 685   my $padd = " " x length($alter_table);
 686
 687   return join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts) . ';';
 688 }
 689
 690 sub drop_table {
 691   my ($table) = @_;
 692
 693   # Drop (foreign key) constraints so table drops cleanly
 694   my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] });
 695
 696   return join("\n", @sql, "DROP TABLE $table;");
 697
 698 }
 699
 700 sub next_unused_name {
 701   my $name       = shift || '';
 702   if ( !defined($used_names{$name}) ) {
 703     $used_names{$name} = $name;
 704     return $name;
 705   }
 706
 707   my $i = 1;
 708   while ( defined($used_names{$name . '_' . $i}) ) {
 709     ++$i;
 710   }
 711   $name .= '_' . $i;
 712   $used_names{$name} = $name;
 713   return $name;
 714 }
 715
 716 1;
 717
 718 # -------------------------------------------------------------------
 719
 720 =pod
 721
 722 =head1 SEE ALSO
 723
 724 SQL::Translator, http://www.mysql.com/.
 725
 726 =head1 AUTHORS
 727
 728 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 729 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 730
 731 =cut