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
}
}
- method produce {
+ method produce {
my $translator = $self->translator;
my $DEBUG = 0;# = $translator->debug;
#local %used_names;
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) = ('','', '');
}
- # 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} || '';
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
#
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';
# 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'];
#
# 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 );
$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 ) ) {
}
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;
}
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;
-}
-
-
}
projects / dbsrgits/SQL-Translator-2.0-ish.git / blobdiff