Fixes to CDBICompat::HasMany mapping method support, with thanks to bricas

diff --git a/lib/DBIx/Class/CDBICompat/HasMany.pm b/lib/DBIx/Class/CDBICompat/HasMany.pm
index 56c044d..acc7041 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/HasMany.pm
+++ b/lib/DBIx/Class/CDBICompat/HasMany.pm
@@ -6,18 +6,16 @@ use warnings;
 sub has_many {
   my ($class, $rel, $f_class, $f_key, $args) = @_;
 
-  my $self_key;
+  my @f_method;
 
   if (ref $f_class eq 'ARRAY') {
-    ($f_class, $self_key) = @$f_class;
+    ($f_class, @f_method) = @$f_class;
   }
 
-  if (!$self_key || $self_key eq 'id') {
-    my ($pri, $too_many) = keys %{ $class->_primaries };
-    $class->throw( "has_many only works with a single primary key; ${class} has more" )
+  my ($pri, $too_many) = keys %{ $class->_primaries };
+  $class->throw( "has_many only works with a single primary key; ${class} has more" )
       if $too_many;
-    $self_key = $pri;
-  }
+  my $self_key = $pri;
     
   eval "require $f_class";
 
@@ -41,13 +39,26 @@ sub has_many {
     unless $f_class->_columns->{$f_key};
   $args ||= {};
   my $cascade = not (ref $args eq 'HASH' && delete $args->{no_cascade_delete});
-  $class->add_relationship($rel, $f_class,
+
+ $class->add_relationship($rel, $f_class,
                             { "foreign.${f_key}" => "self.${self_key}" },
                             { accessor => 'multi',
                               join_type => 'LEFT',
                               ($cascade ? ('cascade_delete' => 1) : ()),
                               %$args } );
-  return 1;
+  if (@f_method) {
+    no strict 'refs';
+    no warnings 'redefine';
+    my $post_proc = sub { my $o = shift; $o = $o->$_ for @f_method; $o; };
+    *{"${class}::${rel}"} =
+      sub {
+        my $rs = shift->search_related($rel => @_);
+        $rs->{attrs}{record_filter} = $post_proc;
+        return (wantarray ? $rs->all : $rs);
+      };
+    return 1;
+  }
+
 }
 
 1;

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index af6cf02..6480ea6 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -78,11 +78,12 @@ sub next {
 sub _construct_object {
   my ($self, @row) = @_;
   my @cols = $self->{class}->_select_columns;
+  my $new;
   unless ($self->{attrs}{prefetch}) {
-    return $self->{class}->_row_to_object(\@cols, \@row);
+    $new = $self->{class}->_row_to_object(\@cols, \@row);
   } else {
     my @main = splice(@row, 0, scalar @cols);
-    my $new = $self->{class}->_row_to_object(\@cols, \@main);
+    $new = $self->{class}->_row_to_object(\@cols, \@main);
     PRE: foreach my $pre (@{$self->{attrs}{prefetch}}) {
       my $rel_obj = $self->{class}->_relationships->{$pre};
       my @pre_cols = $rel_obj->{class}->columns;
@@ -101,8 +102,10 @@ sub _construct_object {
         $self->{class}->throw("Don't know to to store prefetched $pre");
       }
     }
-    return $new;
   }
+  $new = $self->{attrs}{record_filter}->($new)
+    if exists $self->{attrs}{record_filter};
+  return $new;
 }
 
 sub count {

diff --git a/t/cdbi-t/22-self_referential.t b/t/cdbi-t/22-self_referential.t
new file mode 100644 (file)
index 0000000..29d0704
--- /dev/null
+++ b/t/cdbi-t/22-self_referential.t
@@ -0,0 +1,20 @@
+use Test::More tests => 2;\r
+\r
+use strict;\r
+\r
+use lib 't/testlib';\r
+use Actor;\r
+use ActorAlias;\r
+Actor->has_many( aliases => [ 'ActorAlias' => 'alias' ] );\r
+\r
+my $first  = Actor->create( { Name => 'First' } );\r
+my $second = Actor->create( { Name => 'Second' } );\r
+\r
+ActorAlias->create( { actor => $first, alias => $second } );\r
+\r
+my @aliases = $first->aliases;\r
+\r
+is( scalar @aliases, 1, 'proper number of aliases' );\r
+is( $aliases[ 0 ]->name, 'Second', 'proper alias' );\r
+\r
+\r

diff --git a/t/testlib/ActorAlias.pm b/t/testlib/ActorAlias.pm
new file mode 100644 (file)
index 0000000..8dcbcb0
--- /dev/null
+++ b/t/testlib/ActorAlias.pm
@@ -0,0 +1,26 @@
+package ActorAlias;\r
+\r
+BEGIN { unshift @INC, './t/testlib'; }\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use base 'DBIx::Class::Test::SQLite';\r
+\r
+__PACKAGE__->set_table( 'ActorAlias' );\r
+\r
+__PACKAGE__->columns( Primary => 'id' );\r
+__PACKAGE__->columns( All     => qw/ actor alias / );\r
+__PACKAGE__->has_a( actor => 'Actor' );\r
+__PACKAGE__->has_a( alias => 'Actor' );\r
+\r
+sub create_sql {\r
+       return qq{\r
+               id    INTEGER PRIMARY KEY,\r
+               actor INTEGER,\r
+               alias INTEGER\r
+       }\r
+}\r
+\r
+1;\r
+\r