X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2Fmysql.pm;h=c70ff8d941afca2b58cdbcdada04bf765511b457;hb=04e60ed2698d8c8cf2d817cace84f94827bbbc4f;hp=a4f795a2bef5d64100a6e506b1466f98411cf586;hpb=8fdd52a2c9120bf37c8969959152822e9312413d;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm index a4f795a..c70ff8d 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm @@ -6,7 +6,7 @@ use base 'DBIx::Class::Schema::Loader::DBI'; use Carp::Clan qw/^DBIx::Class/; use Class::C3; -our $VERSION = '0.04999_01'; +our $VERSION = '0.04999_14'; =head1 NAME @@ -27,20 +27,10 @@ See L. =cut -# had to override here because MySQL apparently -# doesn't support '%' syntax. Perhaps the other -# drivers support this syntax also, but I didn't -# want to risk breaking some esoteric DBD::foo version -# in a maint release... sub _tables_list { my $self = shift; - my $dbh = $self->schema->storage->dbh; - my @tables = $dbh->tables(undef, $self->db_schema, undef, undef); - s/\Q$self->{_quoter}\E//g for @tables; - s/^.*\Q$self->{_namesep}\E// for @tables; - - return @tables; + return $self->next::method(undef, undef); } sub _table_fk_info { @@ -50,8 +40,12 @@ sub _table_fk_info { my $table_def_ref = $dbh->selectrow_arrayref("SHOW CREATE TABLE `$table`") or croak ("Cannot get table definition for $table"); my $table_def = $table_def_ref->[1] || ''; - - my (@reldata) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/ig); + + my $qt = qr/["`]/; + + my (@reldata) = ($table_def =~ + /CONSTRAINT $qt.*$qt FOREIGN KEY \($qt(.*)$qt\) REFERENCES $qt(.*)$qt \($qt(.*)$qt\)/ig + ); my @rels; while (scalar @reldata > 0) { @@ -59,10 +53,10 @@ sub _table_fk_info { my $f_table = shift @reldata; my $f_cols = shift @reldata; - my @cols = map { s/\Q$self->{_quoter}\E//; lc $_ } + my @cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; lc $_ } split(/\s*,\s*/, $cols); - my @f_cols = map { s/\Q$self->{_quoter}\E//; lc $_ } + my @f_cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; lc $_ } split(/\s*,\s*/, $f_cols); push(@rels, { @@ -83,7 +77,7 @@ sub _mysql_table_get_keys { if(!exists($self->{_cache}->{_mysql_keys}->{$table})) { my %keydata; my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare("SHOW INDEX FROM `$table`"); + my $sth = $dbh->prepare('SHOW INDEX FROM '.$self->_table_as_sql($table)); $sth->execute; while(my $row = $sth->fetchrow_hashref) { next if $row->{Non_unique}; @@ -121,21 +115,27 @@ sub _table_uniq_info { return \@uniqs; } -sub _column_is_auto_increment { +sub _extra_column_info { + no warnings 'uninitialized'; my ($self, $info) = @_; + my %extra_info; - return $info->{mysql_is_auto_increment}; -} - -sub _column_extra_attr { - my ($self, $info) = @_; - - my $extra_attr; + if ($info->{mysql_is_auto_increment}) { + $extra_info{is_auto_increment} = 1 + } if ($info->{mysql_type_name} =~ /\bunsigned\b/i) { - $extra_attr->{unsigned} = 1; + $extra_info{extra}{unsigned} = 1; + } + if ($info->{mysql_values}) { + $extra_info{extra}{list} = $info->{mysql_values}; + } +# XXX we need to distinguish between DEFAULT CURRENT_TIMESTAMP and DEFAULT 'foo' +# somehow, but DBI column_info doesn't preserve quotes. + if ($info->{COLUMN_DEF} =~ /^CURRENT_TIMESTAMP\z/i) { + $extra_info{default_value} = \'CURRENT_TIMESTAMP'; } - return $extra_attr; + return \%extra_info; } =head1 SEE ALSO @@ -143,6 +143,15 @@ sub _column_extra_attr { L, L, L +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + =cut 1;