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