existing Loader patchwork for Schema support, module not fully renamed yet
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / mysql.pm
1 package DBIx::Class::Schema::Loader::mysql;
2
3 use strict;
4 use base 'DBIx::Class::Schema::Loader::Generic';
5 use DBI;
6 use Carp;
7
8 =head1 NAME
9
10 DBIx::Class::Schema::Loader::mysql - DBIx::Schema::Class::Loader mysql Implementation.
11
12 =head1 SYNOPSIS
13
14   use DBIx::Class::Schema::Loader;
15
16   # $loader is a DBIx::Class::Schema::Loader::mysql
17   my $loader = DBIx::Class::Schema::Loader->new(
18     dsn       => "dbi:mysql:dbname",
19     user      => "root",
20     password  => "",
21     namespace => "Data",
22   );
23
24 =head1 DESCRIPTION
25
26 See L<DBIx::Class::Schema::Loader>.
27
28 =cut
29
30 sub _db_classes {
31     return qw/DBIx::Class::PK::Auto::MySQL/;
32 }
33
34 # Very experimental and untested!
35 sub _relationships {
36     my $self   = shift;
37     my @tables = $self->tables;
38     my $dbh    = $self->{_storage}->dbh;
39     my $dsn    = $self->{_datasource}[0];
40     my %conn   =
41       $dsn =~ m/\Adbi:\w+(?:\(.*?\))?:(.+)\z/i
42       && index( $1, '=' ) >= 0
43       ? split( /[=;]/, $1 )
44       : ( database => $1 );
45     my $dbname = $conn{database} || $conn{dbname} || $conn{db};
46     die("Can't figure out the table name automatically.") if !$dbname;
47
48     foreach my $table (@tables) {
49         my $query = "SHOW CREATE TABLE ${dbname}.${table}";
50         my $sth   = $dbh->prepare($query)
51           or die("Cannot get table definition: $table");
52         $sth->execute;
53         my $table_def = $sth->fetchrow_arrayref->[1] || '';
54         
55         my (@cols) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/g);
56
57         while (scalar @cols > 0) {
58             my $column = shift @cols;
59             my $remote_table = shift @cols;
60             my $remote_column = shift @cols;
61             
62             eval { $self->_belongs_to_many( $table, $column, $remote_table, $remote_column) };
63             warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $self->debug;
64         }
65         
66         $sth->finish;
67     }
68 }
69
70 sub _tables {
71     my $self = shift;
72     my $dbh    = $self->{_storage}->dbh;
73     my @tables;
74     foreach my $table ( $dbh->tables ) {
75         my $quoter = $dbh->get_info(29);
76         $table =~ s/$quoter//g if ($quoter);
77         push @tables, $1
78           if $table =~ /\A(\w+)\z/;
79     }
80     return @tables;
81 }
82
83 sub _table_info {
84     my ( $self, $table ) = @_;
85     my $dbh    = $self->{_storage}->dbh;
86
87     # MySQL 4.x doesn't support quoted tables
88     my $query = "DESCRIBE $table";
89     my $sth = $dbh->prepare($query) or die("Cannot get table status: $table");
90     $sth->execute;
91     my ( @cols, @pri );
92     while ( my $hash = $sth->fetchrow_hashref ) {
93         my ($col) = $hash->{Field} =~ /(\w+)/;
94         push @cols, $col;
95         push @pri, $col if $hash->{Key} eq "PRI";
96     }
97
98     return ( \@cols, \@pri );
99 }
100
101 =head1 SEE ALSO
102
103 L<DBIx::Class::Schema::Loader>
104
105 =cut
106
107 1;