a few last minute fixes, and release for 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 $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] || '';
36     
37     my (@reldata) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/ig);
38
39     my @rels;
40     while (scalar @reldata > 0) {
41         my $cols = shift @reldata;
42         my $f_table = shift @reldata;
43         my $f_cols = shift @reldata;
44
45         my @cols   = map { s/\Q$self->{_quoter}\E//; lc $_ }
46             split(/\s*,\s*/, $cols);
47
48         my @f_cols = map { s/\Q$self->{_quoter}\E//; lc $_ }
49             split(/\s*,\s*/, $f_cols);
50
51         push(@rels, {
52             local_columns => \@cols,
53             remote_columns => \@f_cols,
54             remote_table => $f_table
55         });
56     }
57
58     return \@rels;
59 }
60
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) = @_;
65
66     if(!exists($self->{_cache}->{_mysql_keys}->{$table})) {
67         my %keydata;
68         my $dbh = $self->schema->storage->dbh;
69         my $sth = $dbh->prepare("SHOW INDEX FROM $table");
70         $sth->execute;
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} ]
75             );
76         }
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;
81         }
82         $self->{_cache}->{_mysql_keys}->{$table} = \%keydata;
83     }
84
85     return $self->{_cache}->{_mysql_keys}->{$table};
86 }
87
88 sub _table_pk_info {
89     my ( $self, $table ) = @_;
90
91     return $self->_mysql_table_get_keys($table)->{PRIMARY};
92 }
93
94 sub _table_uniq_info {
95     my ( $self, $table ) = @_;
96
97     my @uniqs;
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} ]);
102     }
103
104     return \@uniqs;
105 }
106
107 =head1 SEE ALSO
108
109 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
110 L<DBIx::Class::Schema::Loader::DBI>
111
112 =cut
113
114 1;