1 package DBIx::Class::Schema::Loader::DBI::mysql;
5 use base 'DBIx::Class::Schema::Loader::DBI';
10 DBIx::Class::Schema::Loader::DBI::mysql - DBIx::Class::Schema::Loader::DBI mysql Implementation.
15 use base qw/DBIx::Class::Schema::Loader/;
17 __PACKAGE__->load_from_connection(
25 See L<DBIx::Class::Schema::Loader::Base>.
30 my ($self, $table) = @_;
32 my $dbh = $self->schema->storage->dbh;
33 my $table_def_ref = $dbh->selectrow_arrayref("SHOW CREATE TABLE $table")
34 or die ("Cannot get table definition for $table");
35 my $table_def = $table_def_ref->[1] || '';
37 my (@reldata) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/ig);
40 while (scalar @reldata > 0) {
41 my $cols = shift @reldata;
42 my $f_table = shift @reldata;
43 my $f_cols = shift @reldata;
45 my @cols = map { s/\Q$self->{_quoter}\E//; lc $_ }
46 split(/\s*,\s*/, $cols);
48 my @f_cols = map { s/\Q$self->{_quoter}\E//; lc $_ }
49 split(/\s*,\s*/, $f_cols);
52 local_columns => \@cols,
53 remote_columns => \@f_cols,
54 remote_table => $f_table
61 # primary and unique info comes from the same sql statement,
62 # so cache it here for both routines to use
63 sub _mysql_table_get_keys {
64 my ($self, $table) = @_;
66 if(!exists($self->{_cache}->{_mysql_keys}->{$table})) {
68 my $dbh = $self->schema->storage->dbh;
69 my $sth = $dbh->prepare("SHOW INDEX FROM $table");
71 while(my $row = $sth->fetchrow_hashref) {
72 next if $row->{Non_unique};
73 push(@{$keydata{$row->{Key_name}}},
74 [ $row->{Seq_in_index}, lc $row->{Column_name} ]
77 foreach my $keyname (keys %keydata) {
78 my @ordered_cols = map { $_->[1] } sort { $a->[0] <=> $b->[0] }
79 @{$keydata{$keyname}};
80 $keydata{$keyname} = \@ordered_cols;
82 $self->{_cache}->{_mysql_keys}->{$table} = \%keydata;
85 return $self->{_cache}->{_mysql_keys}->{$table};
89 my ( $self, $table ) = @_;
91 return $self->_mysql_table_get_keys($table)->{PRIMARY};
94 sub _table_uniq_info {
95 my ( $self, $table ) = @_;
98 my $keydata = $self->_mysql_table_get_keys($table);
99 foreach my $keyname (%$keydata) {
100 next if $keyname eq 'PRIMARY';
101 push(@uniqs, [ $keyname => $keydata->{$keyname} ]);
109 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
110 L<DBIx::Class::Schema::Loader::DBI>