[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / MySQL.pm

package SQL::Translator::Producer::MySQL;

# -------------------------------------------------------------------
# $Id: MySQL.pm,v 1.54 2007-11-10 03:36:43 mwz444 Exp $
# -------------------------------------------------------------------
# Copyright (C) 2002-4 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=head1 NAME

SQL::Translator::Producer::MySQL - MySQL-specific producer for SQL::Translator

=head1 SYNOPSIS

Use via SQL::Translator:

  use SQL::Translator;

  my $t = SQL::Translator->new( parser => '...', producer => 'MySQL', '...' );
  $t->translate;

=head1 DESCRIPTION

This module will produce text output of the schema suitable for MySQL.
There are still some issues to be worked out with syntax differences 
between MySQL versions 3 and 4 ("SET foreign_key_checks," character sets
for fields, etc.).

=head2 Table Types

Normally the tables will be created without any explicit table type given and
so will use the MySQL default.

Any tables involved in foreign key constraints automatically get a table type
of InnoDB, unless this is overridden by setting the C<mysql_table_type> extra
attribute explicitly on the table.

=head2 Extra attributes.

The producer recognises the following extra attributes on the Schema objects.

=over 4

=item field.list

Set the list of allowed values for Enum fields.

=item field.binary, field.unsigned, field.zerofill

Set the MySQL field options of the same name.

=item field.renamed_from

Used when producing diffs to say this column is the new name fo the specified
old column.

=item table.mysql_table_type

Set the type of the table e.g. 'InnoDB', 'MyISAM'. This will be
automatically set for tables involved in foreign key constraints if it is
not already set explicitly. See L<"Table Types">.

=item table.mysql_charset, table.mysql_collate

Set the tables default charater set and collation order.

=item field.mysql_charset, field.mysql_collate

Set the fields charater set and collation order.

=back

=cut

use strict;
use warnings;
use vars qw[ $VERSION $DEBUG %used_names ];
$VERSION = sprintf "%d.%02d", q$Revision: 1.54 $ =~ /(\d+)\.(\d+)/;
$DEBUG   = 0 unless defined $DEBUG;

use Data::Dumper;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug header_comment);

#
# Use only lowercase for the keys (e.g. "long" and not "LONG")
#
my %translate  = (
    #
    # Oracle types
    #
    varchar2   => 'varchar',
    long       => 'text',
    clob       => 'longtext',

    #
    # Sybase types
    #
    int        => 'integer',
    money      => 'float',
    real       => 'double',
    comment    => 'text',
    bit        => 'tinyint',

    #
    # Access types
    #
    'long integer' => 'integer',
    'text'         => 'text',
    'datetime'     => 'datetime',
);


sub preprocess_schema {
    my ($class, $schema) = @_;

    # extra->{mysql_table_type} used to be the type. It belongs in options, so
    # move it if we find it. Return Engine type if found in extra or options
    my $mysql_table_type_to_options = sub {
      my ($table) = @_;

      my $extra = $table->extra;

      my $extra_type = delete $extra->{mysql_table_type};

      # Now just to find if there is already an Engine or Type option...
      # and lets normalize it to ENGINE since:
      #
      # The ENGINE table option specifies the storage engine for the table. 
      # TYPE is a synonym, but ENGINE is the preferred option name.
      #

      # We have to use the hash directly here since otherwise there is no way 
      # to remove options.
      my $options = ( $table->{options} ||= []);

      # This assumes that there isn't both a Type and an Engine option.
      for my $idx ( 0..$#{$options} ) {
        my ($key, $value) = %{ $options->[$idx] };

        next unless uc $key eq 'ENGINE' || uc $key eq 'TYPE';

        # if the extra.mysql_table_type is given, use that
        delete $options->[$idx]{$key};
        return $options->[$idx]{ENGINE} = $value || $extra_type;

      }
  
      if ($extra_type) {
        push @$options, { ENGINE => $extra_type };
        return $extra_type;
      }

    };

    # Names are only specific to a given schema
    local %used_names = ();

    #
    # Work out which tables need to be InnoDB to support foreign key
    # constraints. We do this first as we need InnoDB at both ends.
    #
    foreach my $table ( $schema->get_tables ) {
       
        $mysql_table_type_to_options->($table);

        foreach my $c( $table->get_constraints ) {
            next unless $c->type eq FOREIGN_KEY;

            # Normalize constraint names here.
            my $c_name = $c->name;
            # Give the constraint a name if it doesn't have one, so it doens't feel
            # left out
            $c_name   = $table->name . '_fk' unless length $c_name;
            
            $c->name( next_unused_name($c_name) );

            for my $meth (qw/table reference_table/) {
                my $table = $schema->get_table($c->$meth) || next;
                next if $mysql_table_type_to_options->($table);
                $table->options( { 'ENGINE' => 'InnoDB' } );
            }
        }
    }
}

sub produce {
    my $translator     = shift;
    local $DEBUG       = $translator->debug;
    local %used_names;
    my $no_comments    = $translator->no_comments;
    my $add_drop_table = $translator->add_drop_table;
    my $schema         = $translator->schema;
    my $show_warnings  = $translator->show_warnings || 0;

    my ($qt, $qf) = ('','');
    $qt = '`' if $translator->quote_table_names;
    $qf = '`' if $translator->quote_field_names;

    debug("PKG: Beginning production\n");
    %used_names = ();
    my $create; 
    $create .= header_comment unless ($no_comments);
    # \todo Don't set if MySQL 3.x is set on command line
    $create .= "SET foreign_key_checks=0;\n\n";

    __PACKAGE__->preprocess_schema($schema);

    #
    # Generate sql
    #
    my @table_defs =();
    
    for my $table ( $schema->get_tables ) {
#        print $table->name, "\n";
        push @table_defs, create_table($table, 
                                       { add_drop_table    => $add_drop_table,
                                         show_warnings     => $show_warnings,
                                         no_comments       => $no_comments,
                                         quote_table_names => $qt,
                                         quote_field_names => $qf
                                         });
    }

#    print "@table_defs\n";
    push @table_defs, "SET foreign_key_checks=1;\n\n";

    return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
}

sub create_table
{
    my ($table, $options) = @_;

    my $qt = $options->{quote_table_names} || '';
    my $qf = $options->{quote_field_names} || '';

    my $table_name = $table->name;
    debug("PKG: Looking at table '$table_name'\n");

    #
    # Header.  Should this look like what mysqldump produces?
    #
    my $create = '';
    my $drop;
    $create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
    $drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
    $create .= "CREATE TABLE $qt$table_name$qt (\n";

    #
    # Fields
    #
    my @field_defs;
    for my $field ( $table->get_fields ) {
        push @field_defs, create_field($field, $options);
    }

    #
    # Indices
    #
    my @index_defs;
    my %indexed_fields;
    for my $index ( $table->get_indices ) {
        push @index_defs, create_index($index, $options);
        $indexed_fields{ $_ } = 1 for $index->fields;
    }

    #
    # Constraints -- need to handle more than just FK. -ky
    #
    my @constraint_defs;
    my @constraints = $table->get_constraints;
    for my $c ( @constraints ) {
        my $constr = create_constraint($c, $options);
        push @constraint_defs, $constr if($constr);
        
         unless ( $indexed_fields{ ($c->fields())[0] } || $c->type ne FOREIGN_KEY ) {
             push @index_defs, "INDEX ($qf" . ($c->fields())[0] . "$qf)";
             $indexed_fields{ ($c->fields())[0] } = 1;
         }
    }

    $create .= join(",\n", map { "  $_" } 
                    @field_defs, @index_defs, @constraint_defs
                    );

    #
    # Footer
    #
    $create .= "\n)";
    $create .= generate_table_options($table) || '';
    $create .= ";\n\n";

    return $drop ? ($drop,$create) : $create;
}

sub generate_table_options 
{
  my ($table) = @_;
  my $create;

  my $table_type_defined = 0;
  for my $t1_option_ref ( $table->options ) {
    my($key, $value) = %{$t1_option_ref};
    $table_type_defined = 1
      if uc $key eq 'ENGINE' or uc $key eq 'TYPE';
    $create .= " $key=$value";
  }

  my $mysql_table_type = $table->extra('mysql_table_type');
  $create .= " ENGINE=$mysql_table_type"
    if $mysql_table_type && !$table_type_defined;
  my $charset          = $table->extra('mysql_charset');
  my $collate          = $table->extra('mysql_collate');
  my $comments         = $table->comments;

  $create .= " DEFAULT CHARACTER SET $charset" if $charset;
  $create .= " COLLATE $collate" if $collate;
  $create .= qq[ comment='$comments'] if $comments;
  return $create;
}

sub create_field
{
    my ($field, $options) = @_;

    my $qf = $options->{quote_field_names} ||= '';

    my $field_name = $field->name;
    debug("PKG: Looking at field '$field_name'\n");
    my $field_def = "$qf$field_name$qf";

    # data type and size
    my $data_type = $field->data_type;
    my @size      = $field->size;
    my %extra     = $field->extra;
    my $list      = $extra{'list'} || [];
    # \todo deal with embedded quotes
    my $commalist = join( ', ', map { qq['$_'] } @$list );
    my $charset = $extra{'mysql_charset'};
    my $collate = $extra{'mysql_collate'};

    #
    # Oracle "number" type -- figure best MySQL type
    #
    if ( lc $data_type eq 'number' ) {
        # not an integer
        if ( scalar @size > 1 ) {
            $data_type = 'double';
        }
        elsif ( $size[0] && $size[0] >= 12 ) {
            $data_type = 'bigint';
        }
        elsif ( $size[0] && $size[0] <= 1 ) {
            $data_type = 'tinyint';
        }
        else {
            $data_type = 'int';
        }
    }
    #
    # Convert a large Oracle varchar to "text"
    #
    elsif ( $data_type =~ /char/i && $size[0] > 255 ) {
        $data_type = 'text';
        @size      = ();
    }
    elsif ( $data_type =~ /char/i && ! $size[0] ) {
        @size = (255);
    }
    elsif ( $data_type =~ /boolean/i ) {
        $data_type = 'enum';
        $commalist = "'0','1'";
    }
    elsif ( exists $translate{ lc $data_type } ) {
        $data_type = $translate{ lc $data_type };
    }

    @size = () if $data_type =~ /(text|blob)/i;

    if ( $data_type =~ /(double|float)/ && scalar @size == 1 ) {
        push @size, '0';
    }

    $field_def .= " $data_type";

    if ( lc $data_type eq 'enum' ) {
        $field_def .= '(' . $commalist . ')';
    } 
    elsif ( defined $size[0] && $size[0] > 0 ) {
        $field_def .= '(' . join( ', ', @size ) . ')';
    }

    # char sets
    $field_def .= " CHARACTER SET $charset" if $charset;
    $field_def .= " COLLATE $collate" if $collate;

    # MySQL qualifiers
    for my $qual ( qw[ binary unsigned zerofill ] ) {
        my $val = $extra{ $qual } || $extra{ uc $qual } or next;
        $field_def .= " $qual";
    }
    for my $qual ( 'character set', 'collate', 'on update' ) {
        my $val = $extra{ $qual } || $extra{ uc $qual } or next;
        $field_def .= " $qual $val";
    }

    # Null?
    $field_def .= ' NOT NULL' unless $field->is_nullable;

    # Default?  XXX Need better quoting!
    my $default = $field->default_value;
    if ( defined $default ) {
        if ( uc $default eq 'NULL') {
            $field_def .= ' DEFAULT NULL';
        } else {
            $field_def .= " DEFAULT '$default'";
        }
    }

    if ( my $comments = $field->comments ) {
        $field_def .= qq[ comment '$comments'];
    }

    # auto_increment?
    $field_def .= " auto_increment" if $field->is_auto_increment;

    return $field_def;
}

sub alter_create_index
{
    my ($index, $options) = @_;

    my $qt = $options->{quote_table_names} || '';
    my $qf = $options->{quote_field_names} || '';

    return join( ' ',
                 'ALTER TABLE',
                 $qt.$index->table->name.$qt,
                 'ADD',
                 create_index(@_)
                 );
}

sub create_index
{
    my ($index, $options) = @_;

    my $qf = $options->{quote_field_names} || '';

    return join( ' ', 
                 lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
                 $index->name,
                 '(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
                 );

}

sub alter_drop_index
{
    my ($index, $options) = @_;

    my $qt = $options->{quote_table_names} || '';
    my $qf = $options->{quote_field_names} || '';

    return join( ' ', 
                 'ALTER TABLE',
                 $qt.$index->table->name.$qt,
                 'DROP',
                 'INDEX',
                 $index->name || $index->fields
                 );

}

sub alter_drop_constraint
{
    my ($c, $options) = @_;

    my $qt      = $options->{quote_table_names} || '';
    my $qc      = $options->{quote_constraint_names} || '';

    my $out = sprintf('ALTER TABLE %s DROP %s %s',
                      $c->table->name,
                      $c->type,
                      $qc . $c->name . $qc );

    return $out;
}

sub alter_create_constraint
{
    my ($index, $options) = @_;

    my $qt = $options->{quote_table_names} || '';
    return join( ' ',
                 'ALTER TABLE',
                 $qt.$index->table->name.$qt,
                 'ADD',
                 create_constraint(@_) );
}

sub create_constraint
{
    my ($c, $options) = @_;

    my $qf      = $options->{quote_field_names} || '';
    my $qt      = $options->{quote_table_names} || '';
    my $leave_name      = $options->{leave_name} || undef;

    my @fields = $c->fields or next;

    if ( $c->type eq PRIMARY_KEY ) {
        return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
    }
    elsif ( $c->type eq UNIQUE ) {
        return
        'UNIQUE '. 
            (defined $c->name ? $qf.$c->name.$qf.' ' : '').
            '(' . $qf . join("$qf, $qf", @fields). $qf . ')';
    }
    elsif ( $c->type eq FOREIGN_KEY ) {
        #
        # Make sure FK field is indexed or MySQL complains.
        #

        my $table = $c->table;
        my $c_name = $c->name;

        my $def = join(' ', 
                       map { $_ || () } 
                         'CONSTRAINT', 
                         $qt . $c_name . $qt, 
                         'FOREIGN KEY'
                      );


        $def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';

        $def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;

        my @rfields = map { $_ || () } $c->reference_fields;
        unless ( @rfields ) {
            my $rtable_name = $c->reference_table;
            if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
                push @rfields, $ref_table->primary_key;
            }
            else {
                warn "Can't find reference table '$rtable_name' " .
                    "in schema\n" if $options->{show_warnings};
            }
        }

        if ( @rfields ) {
            $def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
        }
        else {
            warn "FK constraint on " . $table->name . '.' .
                join('', @fields) . " has no reference fields\n" 
                if $options->{show_warnings};
        }

        if ( $c->match_type ) {
            $def .= ' MATCH ' . 
                ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
        }

        if ( $c->on_delete ) {
            $def .= ' ON DELETE '.join( ' ', $c->on_delete );
        }

        if ( $c->on_update ) {
            $def .= ' ON UPDATE '.join( ' ', $c->on_update );
        }
        return $def;
    }

    return undef;
}

sub alter_table
{
    my ($to_table, $options) = @_;

    my $qt = $options->{quote_table_name} || '';

    my $table_options = generate_table_options($to_table) || '';
    my $out = sprintf('ALTER TABLE %s%s',
                      $qt . $to_table->name . $qt,
                      $table_options);

    return $out;
}

sub rename_field { alter_field(@_) }
sub alter_field
{
    my ($from_field, $to_field, $options) = @_;

    my $qf = $options->{quote_field_name} || '';
    my $qt = $options->{quote_table_name} || '';

    my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
                      $qt . $to_field->table->name . $qt,
                      $qf . $from_field->name . $qf,
                      create_field($to_field, $options));

    return $out;
}

sub add_field
{
    my ($new_field, $options) = @_;

    my $qt = $options->{quote_table_name} || '';

    my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
                      $qt . $new_field->table->name . $qt,
                      create_field($new_field, $options));

    return $out;

}

sub drop_field
{ 
    my ($old_field, $options) = @_;

    my $qf = $options->{quote_field_name} || '';
    my $qt = $options->{quote_table_name} || '';
    
    my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
                      $qt . $old_field->table->name . $qt,
                      $qf . $old_field->name . $qf);

    return $out;
    
}

sub batch_alter_table {
  my ($table, $diff_hash, $options) = @_;

  my @stmts = map {
    if (@{ $diff_hash->{$_} || [] }) {
      my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
      map { $meth->(ref $_ eq 'ARRAY' ? @$_ : $_) } @{ $diff_hash->{$_} }
    } else { () }
  } qw/alter_drop_constraint
       alter_drop_index
       drop_field
       add_field
       alter_field
       rename_field
       alter_create_index
       alter_create_constraint
       alter_table/;

  return unless @stmts;
  # Just zero or one stmts. return now
  return "@stmts;" unless @stmts > 1;

  # Now strip off the 'ALTER TABLE xyz' of all but the first one

  my $qt = $options->{quote_table_name} || '';
  my $table_name = $qt . $table->name . $qt;

  my $first = shift  @stmts;
  my ($alter_table) = $first =~ /^(ALTER TABLE \Q$table_name\E )/;
  my $re = qr/^$alter_table/;
  my $padd = " " x length($alter_table);

  return join( ",\n", $first, map { s/$re//; $padd . $_ } @stmts) . ';';
}

sub drop_table {
  my ($table) = @_;

  # Drop (foreign key) constraints so table drops cleanly
  my @sql = batch_alter_table($table, { alter_drop_constraint => [ grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints ] });

  return join("\n", @sql, "DROP TABLE $table;");

}

sub next_unused_name {
  my $name       = shift || '';
  if ( !defined($used_names{$name}) ) {
    $used_names{$name} = $name;
    return $name;
  }

  my $i = 1;
  while ( defined($used_names{$name . '_' . $i}) ) {
    ++$i;
  }
  $name .= '_' . $i;
  $used_names{$name} = $name;
  return $name;
}

1;

# -------------------------------------------------------------------

=pod

=head1 SEE ALSO

SQL::Translator, http://www.mysql.com/.

=head1 AUTHORS

darren chamberlain E<lt>darren@cpan.orgE<gt>,
Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.

=cut
Commit	Line	Data
9398955f	1	package SQL::Translator::Producer::MySQL;
9398955f	2
49e1eb70	3	# -------------------------------------------------------------------
866d012e	4	# $Id: MySQL.pm,v 1.54 2007-11-10 03:36:43 mwz444 Exp $
49e1eb70	5	# -------------------------------------------------------------------
977651a5	6	# Copyright (C) 2002-4 SQLFairy Authors
9398955f	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
c855a748	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
5a0c7b43	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
fe0f47d0	62	=item field.binary, field.unsigned, field.zerofill
5a0c7b43	63
	64	Set the MySQL field options of the same name.
	65
4d438549	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
1ded8513	71	=item table.mysql_table_type
5a0c7b43	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
fe0f47d0	77	=item table.mysql_charset, table.mysql_collate
1ded8513	78
	79	Set the tables default charater set and collation order.
	80
fe0f47d0	81	=item field.mysql_charset, field.mysql_collate
1ded8513	82
	83	Set the fields charater set and collation order.
	84
5a0c7b43	85	=back
5a0c7b43	86
c855a748	87	=cut
c855a748	88
9398955f	89	use strict;
cd0ea0fd	90	use warnings;
da5a1bae	91	use vars qw[ $VERSION $DEBUG %used_names ];
866d012e	92	$VERSION = sprintf "%d.%02d", q$Revision: 1.54 $ =~ /(\d+)\.(\d+)/;
5636ed00	93	$DEBUG = 0 unless defined $DEBUG;
9398955f	94
9398955f	95	use Data::Dumper;
1c14e9f1	96	use SQL::Translator::Schema::Constants;
5ee19df8	97	use SQL::Translator::Utils qw(debug header_comment);
9398955f	98
d2344c83	99	#
	100	# Use only lowercase for the keys (e.g. "long" and not "LONG")
	101	#
2620fc1c	102	my %translate = (
	103	#
	104	# Oracle types
	105	#
	106	varchar2 => 'varchar',
	107	long => 'text',
d2344c83	108	clob => 'longtext',
2620fc1c	109
	110	#
	111	# Sybase types
	112	#
	113	int => 'integer',
	114	money => 'float',
	115	real => 'double',
	116	comment => 'text',
	117	bit => 'tinyint',
87779799	118
	119	#
	120	# Access types
	121	#
	122	'long integer' => 'integer',
	123	'text' => 'text',
	124	'datetime' => 'datetime',
2620fc1c	125	);
2620fc1c	126
9ab59f87	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
1c680eb9	170	# Names are only specific to a given schema
	171	local %used_names = ();
	172
9ab59f87	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
1c680eb9	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
9ab59f87	192	for my $meth (qw/table reference_table/) {
1c680eb9	193	my $table = $schema->get_table($c->$meth) \|\| next;
9ab59f87	194	next if $mysql_table_type_to_options->($table);
	195	$table->options( { 'ENGINE' => 'InnoDB' } );
	196	}
	197	}
	198	}
	199	}
	200
9398955f	201	sub produce {
a1d94525	202	my $translator = shift;
a1d94525	203	local $DEBUG = $translator->debug;
da5a1bae	204	local %used_names;
a1d94525	205	my $no_comments = $translator->no_comments;
	206	my $add_drop_table = $translator->add_drop_table;
	207	my $schema = $translator->schema;
2bc23e82	208	my $show_warnings = $translator->show_warnings \|\| 0;
d529894e	209
fe0f47d0	210	my ($qt, $qf) = ('','');
	211	$qt = '`' if $translator->quote_table_names;
	212	$qf = '`' if $translator->quote_field_names;
	213
1a24938d	214	debug("PKG: Beginning production\n");
da5a1bae	215	%used_names = ();
d529894e	216	my $create;
5ee19df8	217	$create .= header_comment unless ($no_comments);
0823773d	218	# \todo Don't set if MySQL 3.x is set on command line
da147d03	219	$create .= "SET foreign_key_checks=0;\n\n";
9398955f	220
9ab59f87	221	__PACKAGE__->preprocess_schema($schema);
5a0c7b43	222
	223	#
	224	# Generate sql
	225	#
cd0ea0fd	226	my @table_defs =();
4d438549	227
1c14e9f1	228	for my $table ( $schema->get_tables ) {
cd0ea0fd	229	# print $table->name, "\n";
0013ee25	230	push @table_defs, create_table($table,
fe0f47d0	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
0013ee25	236	});
0013ee25	237	}
9398955f	238
cd0ea0fd	239	# print "@table_defs\n";
fa94b25f	240	push @table_defs, "SET foreign_key_checks=1;\n\n";
cd0ea0fd	241
fa94b25f	242	return wantarray ? ($create, @table_defs) : $create . join ('', @table_defs);
0013ee25	243	}
9398955f	244
0013ee25	245	sub create_table
	246	{
	247	my ($table, $options) = @_;
2620fc1c	248
fe0f47d0	249	my $qt = $options->{quote_table_names} \|\| '';
	250	my $qf = $options->{quote_field_names} \|\| '';
	251
0013ee25	252	my $table_name = $table->name;
0013ee25	253	debug("PKG: Looking at table '$table_name'\n");
6d3f6379	254
0013ee25	255	#
	256	# Header. Should this look like what mysqldump produces?
	257	#
cd0ea0fd	258	my $create = '';
fa94b25f	259	my $drop;
fe0f47d0	260	$create .= "--\n-- Table: $qt$table_name$qt\n--\n" unless $options->{no_comments};
fa94b25f	261	$drop = qq[DROP TABLE IF EXISTS $qt$table_name$qt;\n] if $options->{add_drop_table};
fe0f47d0	262	$create .= "CREATE TABLE $qt$table_name$qt (\n";
2b695517	263
0013ee25	264	#
	265	# Fields
	266	#
	267	my @field_defs;
	268	for my $field ( $table->get_fields ) {
fe0f47d0	269	push @field_defs, create_field($field, $options);
0013ee25	270	}
1ded8513	271
0013ee25	272	#
	273	# Indices
	274	#
	275	my @index_defs;
	276	my %indexed_fields;
	277	for my $index ( $table->get_indices ) {
fe0f47d0	278	push @index_defs, create_index($index, $options);
0013ee25	279	$indexed_fields{ $_ } = 1 for $index->fields;
0013ee25	280	}
d529894e	281
0013ee25	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 ) {
cd0ea0fd	288	my $constr = create_constraint($c, $options);
cd0ea0fd	289	push @constraint_defs, $constr if($constr);
0013ee25	290
da5a1bae	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	}
0013ee25	295	}
1ded8513	296
0013ee25	297	$create .= join(",\n", map { " $_" }
	298	@field_defs, @index_defs, @constraint_defs
	299	);
9398955f	300
0013ee25	301	#
	302	# Footer
	303	#
	304	$create .= "\n)";
da5a1bae	305	$create .= generate_table_options($table) \|\| '';
0013ee25	306	$create .= ";\n\n";
9398955f	307
fa94b25f	308	return $drop ? ($drop,$create) : $create;
0013ee25	309	}
f8b6e804	310
da5a1bae	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	}
9ab59f87	323
da5a1bae	324	my $mysql_table_type = $table->extra('mysql_table_type');
9ab59f87	325	$create .= " ENGINE=$mysql_table_type"
da5a1bae	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
0013ee25	337	sub create_field
0013ee25	338	{
fe0f47d0	339	my ($field, $options) = @_;
	340
	341	my $qf = $options->{quote_field_names} \|\|= '';
9398955f	342
0013ee25	343	my $field_name = $field->name;
0013ee25	344	debug("PKG: Looking at field '$field_name'\n");
fe0f47d0	345	my $field_def = "$qf$field_name$qf";
0013ee25	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';
d529894e	364	}
0013ee25	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	}
d529894e	398
0013ee25	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
da5a1bae	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
0013ee25	460	sub create_index
0013ee25	461	{
fe0f47d0	462	my ($index, $options) = @_;
	463
	464	my $qf = $options->{quote_field_names} \|\| '';
0013ee25	465
0013ee25	466	return join( ' ',
da5a1bae	467	lc $index->type eq 'normal' ? 'INDEX' : $index->type . ' INDEX',
0013ee25	468	$index->name,
fe0f47d0	469	'(' . $qf . join( "$qf, $qf", $index->fields ) . $qf . ')'
0013ee25	470	);
	471
	472	}
	473
da5a1bae	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
0013ee25	518	sub create_constraint
	519	{
	520	my ($c, $options) = @_;
	521
fb149f81	522	my $qf = $options->{quote_field_names} \|\| '';
fb149f81	523	my $qt = $options->{quote_table_names} \|\| '';
da5a1bae	524	my $leave_name = $options->{leave_name} \|\| undef;
fe0f47d0	525
0013ee25	526	my @fields = $c->fields or next;
	527
	528	if ( $c->type eq PRIMARY_KEY ) {
fe0f47d0	529	return 'PRIMARY KEY (' . $qf . join("$qf, $qf", @fields). $qf . ')';
0013ee25	530	}
	531	elsif ( $c->type eq UNIQUE ) {
	532	return
fe0f47d0	533	'UNIQUE '.
	534	(defined $c->name ? $qf.$c->name.$qf.' ' : '').
	535	'(' . $qf . join("$qf, $qf", @fields). $qf . ')';
0013ee25	536	}
0013ee25	537	elsif ( $c->type eq FOREIGN_KEY ) {
d529894e	538	#
0013ee25	539	# Make sure FK field is indexed or MySQL complains.
5e56da9a	540	#
0013ee25	541
866d012e	542	my $table = $c->table;
da5a1bae	543	my $c_name = $c->name;
866d012e	544
0013ee25	545	my $def = join(' ',
fb149f81	546	map { $_ \|\| () }
fb149f81	547	'CONSTRAINT',
1c680eb9	548	$qt . $c_name . $qt,
fb149f81	549	'FOREIGN KEY'
fb149f81	550	);
0013ee25	551
da5a1bae	552
fe0f47d0	553	$def .= ' ('.$qf . join( "$qf, $qf", @fields ) . $qf . ')';
0013ee25	554
fe0f47d0	555	$def .= ' REFERENCES ' . $qt . $c->reference_table . $qt;
0013ee25	556
	557	my @rfields = map { $_ \|\| () } $c->reference_fields;
	558	unless ( @rfields ) {
	559	my $rtable_name = $c->reference_table;
866d012e	560	if ( my $ref_table = $table->schema->get_table( $rtable_name ) ) {
0013ee25	561	push @rfields, $ref_table->primary_key;
1c14e9f1	562	}
0013ee25	563	else {
	564	warn "Can't find reference table '$rtable_name' " .
	565	"in schema\n" if $options->{show_warnings};
5e56da9a	566	}
	567	}
	568
0013ee25	569	if ( @rfields ) {
fe0f47d0	570	$def .= ' (' . $qf . join( "$qf, $qf", @rfields ) . $qf . ')';
0013ee25	571	}
0013ee25	572	else {
866d012e	573	warn "FK constraint on " . $table->name . '.' .
0013ee25	574	join('', @fields) . " has no reference fields\n"
	575	if $options->{show_warnings};
	576	}
5e56da9a	577
0013ee25	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	}
cd0ea0fd	590	return $def;
9398955f	591	}
9398955f	592
cd0ea0fd	593	return undef;
0013ee25	594	}
0013ee25	595
da5a1bae	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
4d438549	610	sub rename_field { alter_field(@_) }
0013ee25	611	sub alter_field
0013ee25	612	{
fe0f47d0	613	my ($from_field, $to_field, $options) = @_;
	614
	615	my $qf = $options->{quote_field_name} \|\| '';
	616	my $qt = $options->{quote_table_name} \|\| '';
0013ee25	617
0013ee25	618	my $out = sprintf('ALTER TABLE %s CHANGE COLUMN %s %s',
fe0f47d0	619	$qt . $to_field->table->name . $qt,
4d438549	620	$qf . $from_field->name . $qf,
fe0f47d0	621	create_field($to_field, $options));
0013ee25	622
	623	return $out;
	624	}
	625
	626	sub add_field
	627	{
fe0f47d0	628	my ($new_field, $options) = @_;
	629
	630	my $qt = $options->{quote_table_name} \|\| '';
0013ee25	631
0013ee25	632	my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
fe0f47d0	633	$qt . $new_field->table->name . $qt,
fe0f47d0	634	create_field($new_field, $options));
0013ee25	635
	636	return $out;
	637
	638	}
	639
	640	sub drop_field
	641	{
fe0f47d0	642	my ($old_field, $options) = @_;
0013ee25	643
fe0f47d0	644	my $qf = $options->{quote_field_name} \|\| '';
	645	my $qt = $options->{quote_table_name} \|\| '';
	646
0013ee25	647	my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
fe0f47d0	648	$qt . $old_field->table->name . $qt,
fe0f47d0	649	$qf . $old_field->name . $qf);
0013ee25	650
	651	return $out;
	652
9398955f	653	}
9398955f	654
4d438549	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
4d438549	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
da5a1bae	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
9398955f	716	1;
9398955f	717
c855a748	718	# -------------------------------------------------------------------
9398955f	719
c855a748	720	=pod
	721
	722	=head1 SEE ALSO
	723
	724	SQL::Translator, http://www.mysql.com/.
9398955f	725
2d6979da	726	=head1 AUTHORS
9398955f	727
758ab1cd	728	darren chamberlain E<lt>darren@cpan.orgE<gt>,
c855a748	729	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
	730
	731	=cut