From: Brandon Black <blblack@gmail.com>
Date: Tue, 24 Jan 2006 20:25:06 +0000 (+0000)
Subject: schema-loader does multi-column FKs now, needs a bit of cleanup/refactor work
X-Git-Tag: 0.03000~44
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=708c093939ac32c46f7336a4310a330a11a25717;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

schema-loader does multi-column FKs now, needs a bit of cleanup/refactor work
---

diff --git a/lib/DBIx/Class/Schema/Loader/DB2.pm b/lib/DBIx/Class/Schema/Loader/DB2.pm
index 8a3670e..a6de578 100644
--- a/lib/DBIx/Class/Schema/Loader/DB2.pm
+++ b/lib/DBIx/Class/Schema/Loader/DB2.pm
@@ -103,10 +103,20 @@ SQL
         if ($sth->execute(uc $table)) {
             while(my $res = $sth->fetchrow_arrayref()) {
                 my ($colcount, $other, $other_column, $column) =
-                    map { $_=lc; s/^\s+//; s/\s+$//; $_; } @$res;
-                next if $colcount != 1; # XXX no multi-col FK support yet
-                eval { $class->_belongs_to_many( $table, $column, $other,
-                  $other_column ) };
+                    map { lc } @$res;
+
+                my @self_cols = split(' ',$column);
+                my @other_cols = split(' ',$other_column);
+                if(@self_cols != $colcount || @other_cols != $colcount) {
+                    die "Column count discrepancy while getting rel info";
+                }
+
+                my %cond;
+                for(my $i = 0; $i < @self_cols; $i++) {
+                    $cond{$other_cols[$i]} = $self_cols[$i];
+                }
+
+                eval { $class->_belongs_to_many ($table, $other, \%cond); };
                 warn qq/\# belongs_to_many failed "$@"\n\n/
                   if $@ && $class->debug_loader;
             }
diff --git a/lib/DBIx/Class/Schema/Loader/Generic.pm b/lib/DBIx/Class/Schema/Loader/Generic.pm
index 5925c97..2c175a8 100644
--- a/lib/DBIx/Class/Schema/Loader/Generic.pm
+++ b/lib/DBIx/Class/Schema/Loader/Generic.pm
@@ -167,50 +167,49 @@ sub _db_classes { croak "ABSTRACT METHOD" }
 
 # Setup has_a and has_many relationships
 sub _belongs_to_many {
-    my ( $class, $table, $column, $other, $other_column ) = @_;
+    use Data::Dumper;
+
+    my ( $class, $table, $other, $cond ) = @_;
     my $table_class = $class->_find_table_class($table);
     my $other_class = $class->_find_table_class($other);
 
-    warn qq/\# Belongs_to relationship\n/ if $class->debug_loader;
+    my $table_relname = lc $table;
+    my $other_relname = lc $other;
 
-    if($other_column) {
-        warn qq/$table_class->belongs_to( '$column' => '$other_class',/
-          .  qq/ { "foreign.$other_column" => "self.$column" },/
-          .  qq/ { accessor => 'filter' });\n\n/
-          if $class->debug_loader;
-        $table_class->belongs_to( $column => $other_class, 
-          { "foreign.$other_column" => "self.$column" },
-          { accessor => 'filter' }
-        );
+    if(my $inflections = $class->loader_data->{_inflect}) {
+        $table_relname = $inflections->{$table_relname}
+          if exists $inflections->{$table_relname};
     }
     else {
-        warn qq/$table_class->belongs_to( '$column' => '$other_class' );\n\n/
-          if $class->debug_loader;
-        $table_class->belongs_to( $column => $other_class );
+        $table_relname = Lingua::EN::Inflect::PL($table_relname);
+    }
+
+    # for single-column case, set the relname to the column name,
+    # to make filter accessors work
+    if(scalar keys %$cond == 1) {
+        my ($col) = keys %$cond;
+        $other_relname = $cond->{$col};
     }
 
-    my ($table_class_base) = $table_class =~ /.*::(.+)/;
-    my $plural = Lingua::EN::Inflect::PL( lc $table_class_base );
-    $plural = $class->loader_data->{_inflect}->{ lc $table_class_base }
-      if $class->loader_data->{_inflect}
-      and exists $class->loader_data->{_inflect}->{ lc $table_class_base };
+    my $rev_cond = { reverse %$cond };
+
+    warn qq/\# Belongs_to relationship\n/ if $class->debug_loader;
+
+    warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
+      .  Dumper($cond)
+      .  qq/);\n\n/
+      if $class->debug_loader;
+
+    $table_class->belongs_to( $other_relname => $other_class, $cond);
 
     warn qq/\# Has_many relationship\n/ if $class->debug_loader;
 
-    if($other_column) {
-        warn qq/$other_class->has_many( '$plural' => '$table_class',/
-          .  qq/ { "foreign.$column" => "self.$other_column" } );\n\n/
-          if $class->debug_loader;
-        $other_class->has_many( $plural => $table_class,
-                                { "foreign.$column" => "self.$other_column" }
-                              );
-    }
-    else {
-        warn qq/$other_class->has_many( '$plural' => '$table_class',/
-          .  qq/'$other_column' );\n\n/
-          if $class->debug_loader;
-        $other_class->has_many( $plural => $table_class, $column );
-    }
+    warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
+      .  Dumper($rev_cond)
+      .  qq/);\n\n/
+      if $class->debug_loader;
+
+    $other_class->has_many( $table_relname => $table_class, $rev_cond);
 }
 
 # Load and setup classes
@@ -271,21 +270,27 @@ sub _load_classes {
 sub _relationships {
     my $class = shift;
     my $dbh = $class->storage->dbh;
+    my $quoter = $dbh->get_info(29) || q{"};
     foreach my $table ( $class->tables ) {
-        my $quoter = $dbh->get_info(29) || q{"};
-        if ( my $sth = $dbh->foreign_key_info( '', $class->loader_data->{_db_schema}, '', '', '', $table ) ) {
-            for my $res ( @{ $sth->fetchall_arrayref( {} ) } ) {
-                my $column = lc $res->{FK_COLUMN_NAME};
-                my $other  = lc $res->{UK_TABLE_NAME};
-                my $other_column  = lc $res->{UK_COLUMN_NAME};
-                $column =~ s/$quoter//g;
-                $other =~ s/$quoter//g;
-                $other_column =~ s/$quoter//g;
-                eval { $class->_belongs_to_many( $table, $column, $other,
-                  $other_column ) };
-                warn qq/\# belongs_to_many failed "$@"\n\n/
-                  if $@ && $class->debug_loader;
-            }
+        my $rels = {};
+        my $sth = $dbh->foreign_key_info( '',
+            $class->loader_data->{_db_schema}, '', '', '', $table );
+        next if !$sth;
+        while(my $raw_rel = $sth->fetchrow_hashref) {
+            my $uk_tbl  = lc $raw_rel->{UK_TABLE_NAME};
+            my $uk_col  = lc $raw_rel->{UK_COLUMN_NAME};
+            my $fk_col  = lc $raw_rel->{FK_COLUMN_NAME};
+            $uk_tbl =~ s/$quoter//g;
+            $uk_col =~ s/$quoter//g;
+            $fk_col =~ s/$quoter//g;
+            $rels->{$uk_tbl}->{$uk_col} = $fk_col;
+        }
+
+        foreach my $reltbl (keys %$rels) {
+            my $cond = $rels->{$reltbl};
+            eval { $class->_belongs_to_many( $table, $reltbl, $cond ) };
+              warn qq/\# belongs_to_many failed "$@"\n\n/
+                if $@ && $class->debug_loader;
         }
     }
 }
diff --git a/lib/DBIx/Class/Schema/Loader/SQLite.pm b/lib/DBIx/Class/Schema/Loader/SQLite.pm
index 8983712..a8c675f 100644
--- a/lib/DBIx/Class/Schema/Loader/SQLite.pm
+++ b/lib/DBIx/Class/Schema/Loader/SQLite.pm
@@ -28,6 +28,7 @@ sub _db_classes {
     return qw/DBIx::Class::PK::Auto::SQLite/;
 }
 
+# XXX this really needs a re-factor
 sub _relationships {
     my $class = shift;
     foreach my $table ( $class->tables ) {
@@ -67,19 +68,29 @@ SELECT sql FROM sqlite_master WHERE tbl_name = ?
             # find multi-col fks below
             $col =~ s/\-\-comma\-\-/,/g;
 
-            # CDBI doesn't have built-in support multi-col fks, so ignore them
-            next if $col =~ s/^\s*FOREIGN\s+KEY\s*//i && $col =~ /^\([^,)]+,/;
+            $col =~ s/^\s*FOREIGN\s+KEY\s*//i;
 
             # Strip punctuations around key and table names
-            $col =~ s/[()\[\]'"]/ /g;
+            $col =~ s/[\[\]'"]/ /g;
             $col =~ s/^\s+//gs;
 
             # Grab reference
-            if ( $col =~ /^(\w+).*REFERENCES\s+(\w+)\s*(\w+)?/i ) {
+            if ( $col =~ /^\((.*)\)\s+REFERENCES\s+(\w+)\s*\((.*)\)/i ) {
                 chomp $col;
-                warn qq/\# Found foreign key definition "$col"\n\n/
-                  if $class->debug_loader;
-                eval { $class->_belongs_to_many( $table, $1, $2, $3 ) };
+
+                my ($cols, $f_table, $f_cols) = ($1, $2, $3);
+                my @cols = map { s/\s*//g; $_ } split(/\s*,\s*/,$cols);
+                my @f_cols = map { s/\s*//g; $_ } split(/\s*,\s*/,$f_cols);
+
+                die "Mismatched column count in rel for $table => $f_table"
+                  if @cols != @f_cols;
+            
+                my $cond = {};
+                for(my $i = 0 ; $i < @cols; $i++) {
+                    $cond->{$f_cols[$i]} = $cols[$i];
+                }
+
+                eval { $class->_belongs_to_many( $table, $f_table, $cond ) };
                 warn qq/\# belongs_to_many failed "$@"\n\n/
                   if $@ && $class->debug_loader;
             }
diff --git a/lib/DBIx/Class/Schema/Loader/mysql.pm b/lib/DBIx/Class/Schema/Loader/mysql.pm
index a203eff..9250593 100644
--- a/lib/DBIx/Class/Schema/Loader/mysql.pm
+++ b/lib/DBIx/Class/Schema/Loader/mysql.pm
@@ -29,7 +29,6 @@ sub _db_classes {
     return qw/DBIx::Class::PK::Auto::MySQL/;
 }
 
-# Very experimental and untested!
 sub _relationships {
     my $class   = shift;
     my @tables = $class->tables;
@@ -43,6 +42,8 @@ sub _relationships {
     my $dbname = $conn{database} || $conn{dbname} || $conn{db};
     die("Can't figure out the table name automatically.") if !$dbname;
 
+    my $quoter = $dbh->get_info(29);
+
     foreach my $table (@tables) {
         my $query = "SHOW CREATE TABLE ${dbname}.${table}";
         my $sth   = $dbh->prepare($query)
@@ -50,14 +51,24 @@ sub _relationships {
         $sth->execute;
         my $table_def = $sth->fetchrow_arrayref->[1] || '';
         
-        my (@cols) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/g);
+        my (@reldata) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/g);
+
+        while (scalar @reldata > 0) {
+            my $cols = shift @reldata;
+            my $f_table = shift @reldata;
+            my $f_cols = shift @reldata;
 
-        while (scalar @cols > 0) {
-            my $column = shift @cols;
-            my $remote_table = shift @cols;
-            my $remote_column = shift @cols;
+            my @cols = map { s/$quoter//; $_ } split(/\s*,\s*/,$cols);
+            my @f_cols = map { s/$quoter//; $_ } split(/\s*,\s*/,$f_cols);
+            die "Mismatched column count in rel for $table => $f_table"
+              if @cols != @f_cols;
             
-            eval { $class->_belongs_to_many( $table, $column, $remote_table, $remote_column) };
+            my $cond = {};
+            for(my $i = 0 ; $i < @cols; $i++) {
+                $cond->{$f_cols[$i]} = $cols[$i];
+            }
+
+            eval { $class->_belongs_to_many( $table, $f_table, $cond) };
             warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $class->debug_loader;
         }
         
diff --git a/t/10sqlite_common.t b/t/10sqlite_common.t
index c942bd4..1bbaf05 100644
--- a/t/10sqlite_common.t
+++ b/t/10sqlite_common.t
@@ -12,7 +12,6 @@ my $class = $@ ? 'SQLite2' : 'SQLite';
         dsn             => "dbi:$class:dbname=./t/sqlite_test",
         user            => '',
         password        => '',
-        multi_fk_broken => 1,
     );
 
     $tester->run_tests();
diff --git a/t/11mysql_common.t b/t/11mysql_common.t
index 5acba32..3d49663 100644
--- a/t/11mysql_common.t
+++ b/t/11mysql_common.t
@@ -17,7 +17,6 @@ my $tester = dbixcsl_common_tests->new(
     user            => $user,
     password        => $password,
     skip_rels       => $test_innodb ? 0 : $skip_rels_msg,
-    multi_fk_broken => 1,
 );
 
 if( !$database || !$user ) {
diff --git a/t/dbixcsl_common_tests.pm b/t/dbixcsl_common_tests.pm
index b9c5624..7014df6 100644
--- a/t/dbixcsl_common_tests.pm
+++ b/t/dbixcsl_common_tests.pm
@@ -119,11 +119,7 @@ sub run_tests {
         # mulit-col fk def (works for some, not others...)
         my $obj6 = $rsobj6->find(1);
         isa_ok( $obj6->loader_test2, "$schema_class\::$moniker2" );
-        SKIP: {
-            skip "Multi-column FKs are only half-working for this vendor", 1
-                unless $self->{multi_fk_broken};
-            is( ref( $obj6->id2 ), '' );
-        }
+        is( ref( $obj6->loader_test5 ), "$schema_class\::$moniker5");
 
         # fk that references a non-pk key (UNIQUE)
         my $obj8 = $rsobj8->find(1);
@@ -262,7 +258,7 @@ sub create {
 
         qq{
             CREATE TABLE loader_test6 (
-                id $self->{auto_inc_pk},
+                id INTEGER NOT NULL PRIMARY KEY,
                 id2 INTEGER,
                 loader_test2 INTEGER,
                 dat VARCHAR(8),
@@ -271,8 +267,8 @@ sub create {
             ) $self->{innodb};
         },
 
-        (q{ INSERT INTO loader_test6 (id2,loader_test2,dat) } .
-         q{ VALUES (1,1,'aaa'); }),
+        (q{ INSERT INTO loader_test6 (id, id2,loader_test2,dat) } .
+         q{ VALUES (1, 1,1,'aaa'); }),
 
         qq{
             CREATE TABLE loader_test7 (