Version bumped to 0.03001
[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     my $sth = $dbh->prepare('SHOW CREATE TABLE ?');
34     $sth->execute or die("Cannot get table definition for $table"
35                          . " (execute failed): $DBI::errstr");
36
37     my $table_def_ref = $sth->fetchrow_arrayref
38         or die ("Cannot get table definition for $table (no rows)");
39
40     my $table_def = $table_def_ref->[1] || '';
41     $sth->finish;
42     
43     my (@reldata) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/ig);
44
45     my @rels;
46     while (scalar @reldata > 0) {
47         my $cols = shift @reldata;
48         my $f_table = shift @reldata;
49         my $f_cols = shift @reldata;
50
51         my @cols   = map { s/\Q$self->{_quoter}\E//; lc $_ }
52             split(/\s*,\s*/, $cols);
53
54         my @f_cols = map { s/\Q$self->{_quoter}\E//; lc $_ }
55             split(/\s*,\s*/, $f_cols);
56
57         push(@rels, {
58             local_columns => \@cols,
59             remote_columns => \@f_cols,
60             remote_table => $f_table
61         });
62     }
63
64     return \@rels;
65 }
66
67 # primary and unique info comes from the same sql statement,
68 #   so cache it here for both routines to use
69 sub _mysql_table_get_keys {
70     my ($self, $table) = @_;
71
72     if(!exists($self->{_cache}->{_mysql_keys}->{$table})) {
73         my %keydata;
74         my $dbh = $self->schema->storage->dbh;
75         my $sth = $dbh->prepare("SHOW INDEX FROM $table");
76         $sth->execute;
77         while(my $row = $sth->fetchrow_hashref) {
78             next if $row->{Non_unique};
79             push(@{$keydata{$row->{Key_name}}},
80                 [ $row->{Seq_in_index}, lc $row->{Column_name} ]
81             );
82         }
83         foreach my $keyname (keys %keydata) {
84             my @ordered_cols = map { $_->[1] } sort { $a->[0] <=> $b->[0] }
85                 @{$keydata{$keyname}};
86             $keydata{$keyname} = \@ordered_cols;
87         }
88         $self->{_cache}->{_mysql_keys}->{$table} = \%keydata;
89     }
90
91     return $self->{_cache}->{_mysql_keys}->{$table};
92 }
93
94 sub _table_pk_info {
95     my ( $self, $table ) = @_;
96
97     return $self->_mysql_table_get_keys($table)->{PRIMARY};
98 }
99
100 sub _table_uniq_info {
101     my ( $self, $table ) = @_;
102
103     my @uniqs;
104     my $keydata = $self->_mysql_table_get_keys($table);
105     foreach my $keyname (%$keydata) {
106         next if $keyname eq 'PRIMARY';
107         push(@uniqs, [ $keyname => $keydata->{$keyname} ]);
108     }
109
110     return \@uniqs;
111 }
112
113 =head1 SEE ALSO
114
115 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
116 L<DBIx::Class::Schema::Loader::DBI>
117
118 =cut
119
120 1;