DBIx-Class-Loader/lib/DBIx/Class/Loader/mysql.pm

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