X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FSQL%2FMySQL.pm;h=01e9c40d8752f34e382cb0f31b3c9960c0980136;hb=f77b076abfde2eaea012e7aa72ef70788eda94cb;hp=47a56e865b282fcec777e35cf575a8081c47b54b;hpb=24e6a53aca215269c9c0c6251f5d551e72098a09;p=dbsrgits%2FSQL-Translator-2.0-ish.git diff --git a/lib/SQL/Translator/Producer/SQL/MySQL.pm b/lib/SQL/Translator/Producer/SQL/MySQL.pm index 47a56e8..01e9c40 100644 --- a/lib/SQL/Translator/Producer/SQL/MySQL.pm +++ b/lib/SQL/Translator/Producer/SQL/MySQL.pm @@ -131,8 +131,8 @@ role SQL::Translator::Producer::SQL::MySQL { for my $meth (qw/table reference_table/) { my $table = $schema->get_table($c->$meth) || next; # This normalizes the types to ENGINE and returns the value if its there - next if $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE']); - $table->options( { 'ENGINE' => 'InnoDB' } ); + next if $extra_to_options->($table, 'mysql_table_type', ['ENGINE', 'TYPE']); +# $table->options( [ { ENGINE => 'InnoDB' } ] ); } } # foreach constraints @@ -152,7 +152,7 @@ role SQL::Translator::Producer::SQL::MySQL { } } - method produce { + method produce { my $translator = $self->translator; my $DEBUG = 0;# = $translator->debug; #local %used_names; @@ -161,7 +161,7 @@ role SQL::Translator::Producer::SQL::MySQL { my $schema = $translator->schema; my $show_warnings = $translator->show_warnings || 0; my $producer_args = $translator->producer_args; - my $mysql_version = $self->parse_mysql_version ($producer_args->{mysql_version}, 'perl') || 0; + my $mysql_version = $translator->engine_version ($producer_args->{mysql_version}, 'perl') || 0; my $max_id_length = $producer_args->{mysql_max_id_length} || $DEFAULT_MAX_ID_LENGTH; my ($qt, $qf, $qc) = ('','', ''); @@ -210,14 +210,12 @@ role SQL::Translator::Producer::SQL::MySQL { } - # print "@table_defs\n"; + #warn "@table_defs\n"; push @table_defs, "SET foreign_key_checks=1"; - return wantarray ? ($create ? $create : (), @create, @table_defs) : ($create . join('', map { $_ ? "$_;\n\n" : () } (@create, @table_defs))); } method create_view($view, $options) { -# my ($view, $options) = @_; my $qt = $options->{quote_table_names} || ''; my $qf = $options->{quote_field_names} || ''; @@ -301,19 +299,20 @@ role SQL::Translator::Producer::SQL::MySQL { my @constraint_defs; my @constraints = $table->get_constraints; for my $c ( @constraints ) { - my $constr = $self->create_constraint($c, $options); - push @constraint_defs, $constr if($constr); + my $constr = $self->create_constraint($c, $options); + push @constraint_defs, $constr if($constr); #use Data::Dumper; warn Dumper($c->columns) if $constr =~ /^CONSTRAINT/; # unless $c->fields; next unless $c->fields; + 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 # @@ -338,7 +337,8 @@ role SQL::Translator::Producer::SQL::MySQL { my $charset = $table->extra->{'mysql_charset'}; my $collate = $table->extra->{'mysql_collate'}; my $union = undef; - for my $t1_option_ref ( $table->options ) { + + 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'; @@ -463,17 +463,16 @@ role SQL::Translator::Producer::SQL::MySQL { # Default? XXX Need better quoting! my $default = $field->default_value; -=cut - if ( defined $default ) { - SQL::Translator::Producer->_apply_default_value( - \$field_def, - $default, - [ - 'NULL' => \'NULL', - ], - ); - } -=cut + +# if ( defined $default ) { +# SQL::Translator::Producer->_apply_default_value( +# \$field_def, +# $default, +# [ +# 'NULL' => \'NULL', +# ], +# ); +# } if ( my $comments = $field->comments ) { $field_def .= qq[ comment '$comments']; @@ -573,7 +572,6 @@ role SQL::Translator::Producer::SQL::MySQL { # # Make sure FK field is indexed or MySQL complains. # - my $table = $c->table; my $c_name = $self->truncate_id_uniquely( $c->name, $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH ); @@ -586,10 +584,10 @@ role SQL::Translator::Producer::SQL::MySQL { $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 ) ) { @@ -611,17 +609,16 @@ role SQL::Translator::Producer::SQL::MySQL { } if ( $c->match_type ) { - $def .= ' MATCH ' . - ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL'; - } - - if ( $c->on_delete ) { - $def .= ' ON DELETE '.join( ' ', $c->on_delete ); + $def .= ' MATCH '; + $def .= ( $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 ); - } +# if ( $c->on_update ) { +# $def .= ' ON UPDATE '.join( ' ', $c->on_update ); +# } return $def; } @@ -805,62 +802,23 @@ HEADER_COMMENT return $header_comment; } - method parse_mysql_version($v?, $target?) { - return undef unless $v; + use constant COLLISION_TAG_LENGTH => 8; - $target ||= 'perl'; + method truncate_id_uniquely(Str $desired_name, Int $max_symbol_length) { + use Digest::SHA1 qw(sha1_hex); + return $desired_name + unless defined $desired_name && length $desired_name > $max_symbol_length; - my @vers; + my $truncated_name = substr $desired_name, 0, + $max_symbol_length - COLLISION_TAG_LENGTH - 1; - # X.Y.Z style - if ( $v =~ / ^ (\d+) \. (\d{1,3}) (?: \. (\d{1,3}) )? $ /x ) { - push @vers, $1, $2, $3; - } - - # XYYZZ (mysql) style - elsif ( $v =~ / ^ (\d) (\d{2}) (\d{2}) $ /x ) { - push @vers, $1, $2, $3; - } + # Hex isn't the most space-efficient, but it skirts around allowed + # charset issues + my $digest = sha1_hex($desired_name); + my $collision_tag = substr $digest, 0, COLLISION_TAG_LENGTH; - # XX.YYYZZZ (perl) style or simply X - elsif ( $v =~ / ^ (\d+) (?: \. (\d{3}) (\d{3}) )? $ /x ) { - push @vers, $1, $2, $3; - } - else { - #how do I croak sanely here? - die "Unparseable MySQL version '$v'"; - } - - if ($target eq 'perl') { - return sprintf ('%d.%03d%03d', map { $_ || 0 } (@vers) ); - } - elsif ($target eq 'mysql') { - return sprintf ('%d%02d%02d', map { $_ || 0 } (@vers) ); - } - else { - #how do I croak sanely here? - die "Unknown version target '$target'"; - } + return $truncated_name + . '_' + . $collision_tag; } - -use constant COLLISION_TAG_LENGTH => 8; - -method truncate_id_uniquely(Str $desired_name, Int $max_symbol_length) { - return $desired_name - unless defined $desired_name && length $desired_name > $max_symbol_length; - - my $truncated_name = substr $desired_name, 0, - $max_symbol_length - COLLISION_TAG_LENGTH - 1; - - # Hex isn't the most space-efficient, but it skirts around allowed - # charset issues - my $digest = sha1_hex($desired_name); - my $collision_tag = substr $digest, 0, COLLISION_TAG_LENGTH; - - return $truncated_name - . '_' - . $collision_tag; -} - - }