b93669c18ab0ea531a92c367e9525a5f6e80d342
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / DBI / mysql.pm
1 package DBIx::Class::Schema::Loader::DBI::mysql;
2
3 use strict;
4 use warnings;
5 use base 'DBIx::Class::Schema::Loader::DBI';
6 use Class::C3;
7
8 =head1 NAME
9
10 DBIx::Class::Schema::Loader::DBI::mysql - DBIx::Class::Schema::Loader::DBI mysql Implementation.
11
12 =head1 SYNOPSIS
13
14   package My::Schema;
15   use base qw/DBIx::Class::Schema::Loader/;
16
17   __PACKAGE__->load_from_connection(
18     relationships => 1,
19   );
20
21   1;
22
23 =head1 DESCRIPTION
24
25 See L<DBIx::Class::Schema::Loader::Base>.
26
27 =cut
28
29 sub _table_fk_info {
30     my ($self, $table) = @_;
31
32     my $dbh    = $self->schema->storage->dbh;
33
34     my $query = "SHOW CREATE TABLE ${table}";
35     my $sth   = $dbh->prepare($query)
36       or die("Cannot get table definition: $table");
37     $sth->execute;
38     my $table_def = $sth->fetchrow_arrayref->[1] || '';
39     $sth->finish;
40     
41     my (@reldata) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/ig);
42
43     my @rels;
44     while (scalar @reldata > 0) {
45         my $cols = shift @reldata;
46         my $f_table = shift @reldata;
47         my $f_cols = shift @reldata;
48
49         my @cols = map { s/\Q$self->{_quoter}\E//; lc $_ } split(/\s*,\s*/,$cols);
50         my @f_cols = map { s/\Q$self->{_quoter}\E//; lc $_ } split(/\s*,\s*/,$f_cols);
51
52         push(@rels, {
53             local_columns => \@cols,
54             remote_columns => \@f_cols,
55             remote_table => $f_table
56         });
57     }
58
59     return \@rels;
60 }
61
62 # primary and unique info comes from the same sql statement,
63 #   so cache it here for both routines to use
64 sub _mysql_table_get_keys {
65     my ($self, $table) = @_;
66
67     if(!exists($self->{_mysql_keys}->{$table})) {
68         my %keydata;
69         my $dbh = $self->schema->storage->dbh;
70         my $sth = $dbh->prepare("SHOW INDEX FROM $table");
71         $sth->execute;
72         while(my $row = $sth->fetchrow_hashref) {
73             next if $row->{Non_unique};
74             push(@{$keydata{$row->{Key_name}}},
75                 [ $row->{Seq_in_index}, lc $row->{Column_name} ]
76             );
77         }
78         foreach my $keyname (keys %keydata) {
79             my @ordered_cols = map { $_->[1] } sort { $a->[0] <=> $b->[0] }
80                 @{$keydata{$keyname}};
81             $keydata{$keyname} = \@ordered_cols;
82         }
83         $self->{_mysql_keys}->{$table} = \%keydata;
84     }
85
86     return $self->{_mysql_keys}->{$table};
87 }
88
89 sub _table_pk_info {
90     my ( $self, $table ) = @_;
91
92     return $self->_mysql_table_get_keys($table)->{PRIMARY};
93 }
94
95 sub _table_uniq_info {
96     my ( $self, $table ) = @_;
97
98     my @uniqs;
99     my $keydata = $self->_mysql_table_get_keys($table);
100     foreach my $keyname (%$keydata) {
101         next if $keyname eq 'PRIMARY';
102         push(@uniqs, [ $keyname => $keydata->{$keyname} ]);
103     }
104
105     return \@uniqs;
106 }
107
108 =head1 SEE ALSO
109
110 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
111 L<DBIx::Class::Schema::Loader::DBI>
112
113 =cut
114
115 1;