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