Ignore all TT test while TT is broken
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / MySQL.pm
1 package SQL::Translator::Producer::MySQL;
2
3 # -------------------------------------------------------------------
4 # $Id: MySQL.pm,v 1.52 2006-11-27 19:28:04 schiffbruechige 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 table.mysql_table_type
67
68 Set the type of the table e.g. 'InnoDB', 'MyISAM'. This will be
69 automatically set for tables involved in foreign key constraints if it is
70 not already set explicitly. See L<"Table Types">.
71
72 =item mysql_character_set
73
74 MySql-4.1+. Set the tables character set.
75 Run SHOW CHARACTER SET to see list.
76
77 =item mysql_collate
78
79 MySql-4.1+. Set the tables colation order.
80
81 =item table.mysql_charset, table.mysql_collate
82
83 Set the tables default charater set and collation order.
84
85 =item field.mysql_charset, field.mysql_collate
86
87 Set the fields charater set and collation order.
88
89 =back
90
91 =cut
92
93 use strict;
94 use warnings;
95 use vars qw[ $VERSION $DEBUG ];
96 $VERSION = sprintf "%d.%02d", q$Revision: 1.52 $ =~ /(\d+)\.(\d+)/;
97 $DEBUG   = 0 unless defined $DEBUG;
98
99 use Data::Dumper;
100 use SQL::Translator::Schema::Constants;
101 use SQL::Translator::Utils qw(debug header_comment);
102
103 #
104 # Use only lowercase for the keys (e.g. "long" and not "LONG")
105 #
106 my %translate  = (
107     #
108     # Oracle types
109     #
110     varchar2   => 'varchar',
111     long       => 'text',
112     clob       => 'longtext',
113
114     #
115     # Sybase types
116     #
117     int        => 'integer',
118     money      => 'float',
119     real       => 'double',
120     comment    => 'text',
121     bit        => 'tinyint',
122
123     #
124     # Access types
125     #
126     'long integer' => 'integer',
127     'text'         => 'text',
128     'datetime'     => 'datetime',
129 );
130
131 sub produce {
132     my $translator     = shift;
133     local $DEBUG       = $translator->debug;
134     my $no_comments    = $translator->no_comments;
135     my $add_drop_table = $translator->add_drop_table;
136     my $schema         = $translator->schema;
137     my $show_warnings  = $translator->show_warnings || 0;
138
139     my ($qt, $qf) = ('','');
140     $qt = '`' if $translator->quote_table_names;
141     $qf = '`' if $translator->quote_field_names;
142
143     debug("PKG: Beginning production\n");
144
145     my $create; 
146     $create .= header_comment unless ($no_comments);
147     # \todo Don't set if MySQL 3.x is set on command line
148     $create .= "SET foreign_key_checks=0;\n\n";
149
150     #
151     # Work out which tables need to be InnoDB to support foreign key
152     # constraints. We do this first as we need InnoDB at both ends.
153     #
154     foreach ( map { $_->get_constraints } $schema->get_tables ) {
155         next unless $_->type eq FOREIGN_KEY;
156         foreach my $meth (qw/table reference_table/) {
157             my $table = $schema->get_table($_->$meth) || next;
158             next if $table->extra('mysql_table_type');
159             $table->extra( 'mysql_table_type' => 'InnoDB');
160         }
161     }
162
163     #
164     # Generate sql
165     #
166     my @table_defs =();
167     for my $table ( $schema->get_tables ) {
168 #        print $table->name, "\n";
169         push @table_defs, create_table($table, 
170                                        { add_drop_table    => $add_drop_table,
171                                          show_warnings     => $show_warnings,
172                                          no_comments       => $no_comments,
173                                          quote_table_names => $qt,
174                                          quote_field_names => $qf
175                                          });
176     }
177
178 #    print "@table_defs\n";
179     push @table_defs, "SET foreign_key_checks=1;\n\n";
180
181     return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
182 }
183
184 sub create_table
185 {
186     my ($table, $options) = @_;
187
188     my $qt = $options->{quote_table_names} || '';
189     my $qf = $options->{quote_field_names} || '';
190
191     my $table_name = $table->name;
192     debug("PKG: Looking at table '$table_name'\n");
193
194     #
195     # Header.  Should this look like what mysqldump produces?
196     #
197     my $create = '';
198     my $drop;
199     $create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
200     $drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
201     $create .= "CREATE TABLE $qt$table_name$qt (\n";
202
203     #
204     # Fields
205     #
206     my @field_defs;
207     for my $field ( $table->get_fields ) {
208         push @field_defs, create_field($field, $options);
209     }
210
211     #
212     # Indices
213     #
214     my @index_defs;
215     my %indexed_fields;
216     for my $index ( $table->get_indices ) {
217         push @index_defs, create_index($index, $options);
218         $indexed_fields{ $_ } = 1 for $index->fields;
219     }
220
221     #
222     # Constraints -- need to handle more than just FK. -ky
223     #
224     my @constraint_defs;
225     my @constraints = $table->get_constraints;
226     for my $c ( @constraints ) {
227         my $constr = create_constraint($c, $options);
228         push @constraint_defs, $constr if($constr);
229         
230         unless ( $indexed_fields{ ($c->fields())[0] } ) {
231             push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
232             $indexed_fields{ ($c->fields())[0] } = 1;
233         }
234     }
235
236     $create .= join(",\n", map { "  $_" } 
237                     @field_defs, @index_defs, @constraint_defs
238                     );
239
240     #
241     # Footer
242     #
243     $create .= "\n)";
244     my $table_type_defined = 0;
245     for my $t1_option_ref ( $table->options ) {
246         my($key, $value) = %{$t1_option_ref};
247         $table_type_defined = 1
248             if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
249         $create .= " $key=$value";
250     }
251     my $mysql_table_type = $table->extra('mysql_table_type');
252     #my $charset          = $table->extra('mysql_character_set');
253     #my $collate          = $table->extra('mysql_collate');
254     #$create .= " Type=$mysql_table_type" if $mysql_table_type;
255     #$create .= " DEFAULT CHARACTER SET $charset" if $charset;
256     #$create .= " COLLATE $collate" if $collate;
257     $create .= " Type=$mysql_table_type"
258         if $mysql_table_type && !$table_type_defined;
259     my $charset          = $table->extra('mysql_charset');
260     my $collate          = $table->extra('mysql_collate');
261     my $comments         = $table->comments;
262
263     $create .= " DEFAULT CHARACTER SET $charset" if $charset;
264     $create .= " COLLATE $collate" if $collate;
265     $create .= qq[ comment='$comments'] if $comments;
266     $create .= ";\n\n";
267
268     return $drop ? ($drop,$create) : $create;
269 }
270
271 sub create_field
272 {
273     my ($field, $options) = @_;
274
275     my $qf = $options->{quote_field_names} ||= '';
276
277     my $field_name = $field->name;
278     debug("PKG: Looking at field '$field_name'\n");
279     my $field_def = "$qf$field_name$qf";
280
281     # data type and size
282     my $data_type = $field->data_type;
283     my @size      = $field->size;
284     my %extra     = $field->extra;
285     my $list      = $extra{'list'} || [];
286     # \todo deal with embedded quotes
287     my $commalist = join( ', ', map { qq['$_'] } @$list );
288     my $charset = $extra{'mysql_charset'};
289     my $collate = $extra{'mysql_collate'};
290
291     #
292     # Oracle "number" type -- figure best MySQL type
293     #
294     if ( lc $data_type eq 'number' ) {
295         # not an integer
296         if ( scalar @size > 1 ) {
297             $data_type = 'double';
298         }
299         elsif ( $size[0] && $size[0] >= 12 ) {
300             $data_type = 'bigint';
301         }
302         elsif ( $size[0] && $size[0] <= 1 ) {
303             $data_type = 'tinyint';
304         }
305         else {
306             $data_type = 'int';
307         }
308     }
309     #
310     # Convert a large Oracle varchar to "text"
311     #
312     elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
313         $data_type = 'text';
314         @size      = ();
315     }
316     elsif ( $data_type =~ /char/i && ! $size[0] ) {
317         @size = (255);
318     }
319     elsif ( $data_type =~ /boolean/i ) {
320         $data_type = 'enum';
321         $commalist = "'0','1'";
322     }
323     elsif ( exists $translate{ lc $data_type } ) {
324         $data_type = $translate{ lc $data_type };
325     }
326
327     @size = () if $data_type =~ /(text|blob)/i;
328
329     if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
330         push @size, '0';
331     }
332
333     $field_def .= " $data_type";
334
335     if ( lc $data_type eq 'enum' ) {
336         $field_def .= '(' . $commalist . ')';
337     } 
338     elsif ( defined $size[0] && $size[0] > 0 ) {
339         $field_def .= '(' . join( ', ', @size ) . ')';
340     }
341
342     # char sets
343     $field_def .= " CHARACTER SET $charset" if $charset;
344     $field_def .= " COLLATE $collate" if $collate;
345
346     # MySQL qualifiers
347     for my $qual ( qw[ binary unsigned zerofill ] ) {
348         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
349         $field_def .= " $qual";
350     }
351     for my $qual ( 'character set', 'collate', 'on update' ) {
352         my $val = $extra{ $qual } || $extra{ uc $qual } or next;
353         $field_def .= " $qual $val";
354     }
355
356     # Null?
357     $field_def .= ' NOT NULL' unless $field->is_nullable;
358
359     # Default?  XXX Need better quoting!
360     my $default = $field->default_value;
361     if ( defined $default ) {
362         if ( uc $default eq 'NULL') {
363             $field_def .= ' DEFAULT NULL';
364         } else {
365             $field_def .= " DEFAULT '$default'";
366         }
367     }
368
369     if ( my $comments = $field->comments ) {
370         $field_def .= qq[ comment '$comments'];
371     }
372
373     # auto_increment?
374     $field_def .= " auto_increment" if $field->is_auto_increment;
375
376     return $field_def;
377 }
378
379 sub create_index
380 {
381     my ($index, $options) = @_;
382
383     my $qf = $options->{quote_field_names} || '';
384
385     return join( ' ', 
386                  lc $index->type eq 'normal' ? 'INDEX' : $index->type,
387                  $index->name,
388                  '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
389                  );
390
391 }
392
393 sub create_constraint
394 {
395     my ($c, $options) = @_;
396
397     my $qf      = $options->{quote_field_names} || '';
398     my $qt      = $options->{quote_table_names} || '';
399     my $counter = ($options->{fk_name_counter}   ||= {});
400
401     my @fields = $c->fields or next;
402
403     if ( $c->type eq PRIMARY_KEY ) {
404         return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
405     }
406     elsif ( $c->type eq UNIQUE ) {
407         return
408         'UNIQUE '. 
409             (defined $c->name ? $qf.$c->name.$qf.' ' : '').
410             '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
411     }
412     elsif ( $c->type eq FOREIGN_KEY ) {
413         #
414         # Make sure FK field is indexed or MySQL complains.
415         #
416
417         $counter->{$c->table} ||= {};
418         my $def = join(' ', 
419                        map { $_ || () } 
420                          'CONSTRAINT', 
421                          $qt . join('_', $c->table, 
422                                          $c->name,
423                                          ($counter->{$c->table}{$c->name}++ || ())
424                                    ) . $qt, 
425                          'FOREIGN KEY'
426                       );
427
428         $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
429
430         $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
431
432         my @rfields = map { $_ || () } $c->reference_fields;
433         unless ( @rfields ) {
434             my $rtable_name = $c->reference_table;
435             if ( my $ref_table = $c->table->schema->get_table( $rtable_name ) ) {
436                 push @rfields, $ref_table->primary_key;
437             }
438             else {
439                 warn "Can't find reference table '$rtable_name' " .
440                     "in schema\n" if $options->{show_warnings};
441             }
442         }
443
444         if ( @rfields ) {
445             $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
446         }
447         else {
448             warn "FK constraint on " . $c->table->name . '.' .
449                 join('', @fields) . " has no reference fields\n" 
450                 if $options->{show_warnings};
451         }
452
453         if ( $c->match_type ) {
454             $def .= ' MATCH ' . 
455                 ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
456         }
457
458         if ( $c->on_delete ) {
459             $def .= ' ON DELETE '.join( ' ', $c->on_delete );
460         }
461
462         if ( $c->on_update ) {
463             $def .= ' ON UPDATE '.join( ' ', $c->on_update );
464         }
465         return $def;
466     }
467
468     return undef;
469 }
470
471 sub alter_field
472 {
473     my ($from_field, $to_field, $options) = @_;
474
475     my $qf = $options->{quote_field_name} || '';
476     my $qt = $options->{quote_table_name} || '';
477
478     my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
479                       $qt . $to_field->table->name . $qt,
480                       $qf . $to_field->name . $qf,
481                       create_field($to_field, $options));
482
483     return $out;
484 }
485
486 sub add_field
487 {
488     my ($new_field, $options) = @_;
489
490     my $qt = $options->{quote_table_name} || '';
491
492     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
493                       $qt . $new_field->table->name . $qt,
494                       create_field($new_field, $options));
495
496     return $out;
497
498 }
499
500 sub drop_field
501
502     my ($old_field, $options) = @_;
503
504     my $qf = $options->{quote_field_name} || '';
505     my $qt = $options->{quote_table_name} || '';
506     
507     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
508                       $qt . $old_field->table->name . $qt,
509                       $qf . $old_field->name . $qf);
510
511     return $out;
512     
513 }
514
515 1;
516
517 # -------------------------------------------------------------------
518
519 =pod
520
521 =head1 SEE ALSO
522
523 SQL::Translator, http://www.mysql.com/.
524
525 =head1 AUTHORS
526
527 darren chamberlain E<lt>darren@cpan.orgE<gt>,
528 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
529
530 =cut