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=b83e2d50a1027d1fdd2d96d4969a4c9c707cabe4;hpb=4421d6a300ce7bdd33c1f9a7870b8a2ad2baef53;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 b83e2d5..c70ff8d 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm @@ -3,8 +3,11 @@ package DBIx::Class::Schema::Loader::DBI::mysql; use strict; use warnings; use base 'DBIx::Class::Schema::Loader::DBI'; +use Carp::Clan qw/^DBIx::Class/; use Class::C3; +our $VERSION = '0.04999_14'; + =head1 NAME DBIx::Class::Schema::Loader::DBI::mysql - DBIx::Class::Schema::Loader::DBI mysql Implementation. @@ -14,9 +17,7 @@ DBIx::Class::Schema::Loader::DBI::mysql - DBIx::Class::Schema::Loader::DBI mysql package My::Schema; use base qw/DBIx::Class::Schema::Loader/; - __PACKAGE__->load_from_connection( - relationships => 1, - ); + __PACKAGE__->loader_options( debug => 1 ); 1; @@ -26,15 +27,25 @@ See L. =cut +sub _tables_list { + my $self = shift; + + return $self->next::method(undef, undef); +} + sub _table_fk_info { my ($self, $table) = @_; my $dbh = $self->schema->storage->dbh; - my $table_def_ref = $dbh->selectrow_arrayref("SHOW CREATE TABLE $table") - or die ("Cannot get table definition for $table"); + 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) { @@ -42,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, { @@ -66,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}; @@ -96,7 +107,7 @@ sub _table_uniq_info { my @uniqs; my $keydata = $self->_mysql_table_get_keys($table); - foreach my $keyname (%$keydata) { + foreach my $keyname (keys %$keydata) { next if $keyname eq 'PRIMARY'; push(@uniqs, [ $keyname => $keydata->{$keyname} ]); } @@ -104,11 +115,43 @@ sub _table_uniq_info { return \@uniqs; } +sub _extra_column_info { + no warnings 'uninitialized'; + my ($self, $info) = @_; + my %extra_info; + + if ($info->{mysql_is_auto_increment}) { + $extra_info{is_auto_increment} = 1 + } + if ($info->{mysql_type_name} =~ /\bunsigned\b/i) { + $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_info; +} + =head1 SEE ALSO 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;