[Dbix-class] Re: Problem with non-PK FK's [patch]

[Brandon Black]

On 12/13/05, Brandon Black <blblack at gmail.com> wrote:
> On 12/13/05, Brandon Black <blblack at gmail.com> wrote:
> > I'll see if I can't find the exact source of the issue (or maybe even
> > a fix for it) this evening, but in the meantime I thought I'd report
> > that it exists.
>
> I'm just a little
> unsure of exactly how to implement it and not disturb the rest of the
> surrounding design too much yet.  I may yet come up with a sane-ish
> patch tonight though.
>
> -- Brandon
>

Ok, it wasn't as hard as I thought.  This patch is completely
untested, other than that it passes the normal t/* tests on my box and
seems to solve my problem.  In particular, the mysql part of the patch
is utter unknowing guesswork:

******** svn diff output: *************
Index: lib/DBIx/Class/Loader/mysql.pm
===================================================================
--- lib/DBIx/Class/Loader/mysql.pm      (revision 388)
+++ lib/DBIx/Class/Loader/mysql.pm      (working copy)
@@ -55,9 +55,9 @@
         $sth->execute;
         my $comment = $sth->fetchrow_hashref->{comment} || '';
         $comment =~ s/$quoter//g if ($quoter);
-        while ( $comment =~
m!\(`?(\w+)`?\)\sREFER\s`?\w+/(\w+)`?\(`?\w+`?\)!g )
+        while ( $comment =~
m!\(`?(\w+)`?\)\sREFER\s`?\w+/(\w+)`?\(`?(\w+)`?\)!g )
         {
-            eval { $self->_belongs_to_many( $table, $1, $2 ) };
+            eval { $self->_belongs_to_many( $table, $1, $2, $3 ) };
             warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $self->debug;
         }
         $sth->finish;
Index: lib/DBIx/Class/Loader/Generic.pm
===================================================================
--- lib/DBIx/Class/Loader/Generic.pm    (revision 388)
+++ lib/DBIx/Class/Loader/Generic.pm    (working copy)
@@ -162,13 +162,22 @@

 # Setup has_a and has_many relationships
 sub _belongs_to_many {
-    my ( $self, $table, $column, $other ) = @_;
+    my ( $self, $table, $column, $other, $other_column ) = @_;
     my $table_class = $self->find_class($table);
     my $other_class = $self->find_class($other);
     warn qq/\# Belongs_to relationship\n/ if $self->debug;
-    warn qq/$table_class->belongs_to( '$column' => '$other_class' );\n\n/
-      if $self->debug;
-    $table_class->belongs_to( $column => $other_class );
+    if($other_column) {
+        warn qq/$table_class->belongs_to( '$column' => '$other_class',/
+          .  qq/ { "foreign.$other_column" => "self.$column" } );\n\n/
+          if $self->debug;
+        $table_class->belongs_to( $column => $other_class,
+          { "foreign.$other_column" => "self.$column" } );
+    }
+    else {
+        warn qq/$table_class->belongs_to( '$column' => '$other_class' );\n\n/
+          if $self->debug;
+        $table_class->belongs_to( $column => $other_class );
+    }
     my ($table_class_base) = $table_class =~ /.*::(.+)/;
     my $plural = Lingua::EN::Inflect::PL( lc $table_class_base );
     $plural = $self->{_inflect}->{ lc $table_class_base }
@@ -239,9 +248,10 @@
             for my $res ( @{ $sth->fetchall_arrayref( {} ) } ) {
                 my $column = $res->{FK_COLUMN_NAME};
                 my $other  = $res->{UK_TABLE_NAME};
+                my $other_column  = $res->{UK_COLUMN_NAME};
                 $column =~ s/"//g;
                 $other =~ s/"//g;
-                eval { $self->_belongs_to_many( $table, $column, $other ) };
+                eval { $self->_belongs_to_many( $table, $column,
$other, $other_column ) };
                 warn qq/\# belongs_to_many failed "$@"\n\n/
                   if $@ && $self->debug;
             }
Index: lib/DBIx/Class/Loader/SQLite.pm
===================================================================
--- lib/DBIx/Class/Loader/SQLite.pm     (revision 388)
+++ lib/DBIx/Class/Loader/SQLite.pm     (working copy)
@@ -79,11 +79,11 @@
             $col =~ s/^\s+//gs;

             # Grab reference
-            if ( $col =~ /^(\w+).*REFERENCES\s+(\w+)/i ) {
+            if ( $col =~ /^(\w+).*REFERENCES\s+(\w+)\s*(\w+)?/i ) {
                 chomp $col;
                 warn qq/\# Found foreign key definition "$col"\n\n/
                   if $self->debug;
-                eval { $self->_belongs_to_many( $table, $1, $2 ) };
+                eval { $self->_belongs_to_many( $table, $1, $2, $3 ) };
                 warn qq/\# belongs_to_many failed "$@"\n\n/
                   if $@ && $self->debug;
             }
******** cut here *************

-- Brandon