From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 10 Sep 2005 18:04:48 +0000 (+0000)
Subject: Fixes to CDBICompat::HasMany mapping method support, with thanks to bricas
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=33ce49d650a60eebc0d9e99d6458239c5e35e70f;p=dbsrgits%2FDBIx-Class-Historic.git

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
--- 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
--- 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
index 0000000..29d0704
--- /dev/null
+++ b/t/cdbi-t/22-self_referential.t
@@ -0,0 +1,20 @@
+use Test::More tests => 2;
+
+use strict;
+
+use lib 't/testlib';
+use Actor;
+use ActorAlias;
+Actor->has_many( aliases => [ 'ActorAlias' => 'alias' ] );
+
+my $first  = Actor->create( { Name => 'First' } );
+my $second = Actor->create( { Name => 'Second' } );
+
+ActorAlias->create( { actor => $first, alias => $second } );
+
+my @aliases = $first->aliases;
+
+is( scalar @aliases, 1, 'proper number of aliases' );
+is( $aliases[ 0 ]->name, 'Second', 'proper alias' );
+
+
diff --git a/t/testlib/ActorAlias.pm b/t/testlib/ActorAlias.pm
new file mode 100644
index 0000000..8dcbcb0
--- /dev/null
+++ b/t/testlib/ActorAlias.pm
@@ -0,0 +1,26 @@
+package ActorAlias;
+
+BEGIN { unshift @INC, './t/testlib'; }
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Test::SQLite';
+
+__PACKAGE__->set_table( 'ActorAlias' );
+
+__PACKAGE__->columns( Primary => 'id' );
+__PACKAGE__->columns( All     => qw/ actor alias / );
+__PACKAGE__->has_a( actor => 'Actor' );
+__PACKAGE__->has_a( alias => 'Actor' );
+
+sub create_sql {
+	return qq{
+		id    INTEGER PRIMARY KEY,
+		actor INTEGER,
+		alias INTEGER
+	}
+}
+
+1;
+