0.04003 changes, version bumps
[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 Carp::Clan qw/^DBIx::Class/;
7 use Class::C3;
8
9 our $VERSION = '0.04003';
10
11 =head1 NAME
12
13 DBIx::Class::Schema::Loader::DBI::mysql - DBIx::Class::Schema::Loader::DBI mysql Implementation.
14
15 =head1 SYNOPSIS
16
17   package My::Schema;
18   use base qw/DBIx::Class::Schema::Loader/;
19
20   __PACKAGE__->loader_options( debug => 1 );
21
22   1;
23
24 =head1 DESCRIPTION
25
26 See L<DBIx::Class::Schema::Loader::Base>.
27
28 =cut
29
30 # had to override here because MySQL apparently
31 #  doesn't support '%' syntax.  Perhaps the other
32 #  drivers support this syntax also, but I didn't
33 #  want to risk breaking some esoteric DBD::foo version
34 #  in a maint release...
35 sub _tables_list { 
36     my $self = shift;
37
38     my $dbh = $self->schema->storage->dbh;
39     my @tables = $dbh->tables(undef, $self->db_schema, undef, undef);
40     s/\Q$self->{_quoter}\E//g for @tables;
41     s/^.*\Q$self->{_namesep}\E// for @tables;
42
43     return @tables;
44 }
45
46 sub _table_fk_info {
47     my ($self, $table) = @_;
48
49     my $dbh = $self->schema->storage->dbh;
50     my $table_def_ref = $dbh->selectrow_arrayref("SHOW CREATE TABLE `$table`")
51         or croak ("Cannot get table definition for $table");
52     my $table_def = $table_def_ref->[1] || '';
53     
54     my (@reldata) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/ig);
55
56     my @rels;
57     while (scalar @reldata > 0) {
58         my $cols = shift @reldata;
59         my $f_table = shift @reldata;
60         my $f_cols = shift @reldata;
61
62         my @cols   = map { s/\Q$self->{_quoter}\E//; lc $_ }
63             split(/\s*,\s*/, $cols);
64
65         my @f_cols = map { s/\Q$self->{_quoter}\E//; lc $_ }
66             split(/\s*,\s*/, $f_cols);
67
68         push(@rels, {
69             local_columns => \@cols,
70             remote_columns => \@f_cols,
71             remote_table => $f_table
72         });
73     }
74
75     return \@rels;
76 }
77
78 # primary and unique info comes from the same sql statement,
79 #   so cache it here for both routines to use
80 sub _mysql_table_get_keys {
81     my ($self, $table) = @_;
82
83     if(!exists($self->{_cache}->{_mysql_keys}->{$table})) {
84         my %keydata;
85         my $dbh = $self->schema->storage->dbh;
86         my $sth = $dbh->prepare("SHOW INDEX FROM `$table`");
87         $sth->execute;
88         while(my $row = $sth->fetchrow_hashref) {
89             next if $row->{Non_unique};
90             push(@{$keydata{$row->{Key_name}}},
91                 [ $row->{Seq_in_index}, lc $row->{Column_name} ]
92             );
93         }
94         foreach my $keyname (keys %keydata) {
95             my @ordered_cols = map { $_->[1] } sort { $a->[0] <=> $b->[0] }
96                 @{$keydata{$keyname}};
97             $keydata{$keyname} = \@ordered_cols;
98         }
99         $self->{_cache}->{_mysql_keys}->{$table} = \%keydata;
100     }
101
102     return $self->{_cache}->{_mysql_keys}->{$table};
103 }
104
105 sub _table_pk_info {
106     my ( $self, $table ) = @_;
107
108     return $self->_mysql_table_get_keys($table)->{PRIMARY};
109 }
110
111 sub _table_uniq_info {
112     my ( $self, $table ) = @_;
113
114     my @uniqs;
115     my $keydata = $self->_mysql_table_get_keys($table);
116     foreach my $keyname (keys %$keydata) {
117         next if $keyname eq 'PRIMARY';
118         push(@uniqs, [ $keyname => $keydata->{$keyname} ]);
119     }
120
121     return \@uniqs;
122 }
123
124 =head1 SEE ALSO
125
126 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
127 L<DBIx::Class::Schema::Loader::DBI>
128
129 =cut
130
131 1;