From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 20 May 2009 10:51:05 +0000 (+0000)
Subject: Bring back the old code from resolve_prefetch so ash's code can work
X-Git-Tag: v0.08103~55
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3bb4eb8f;p=dbsrgits%2FDBIx-Class.git

Bring back the old code from resolve_prefetch so ash's code can work
Add tests to make sure we throw it away in 09
---

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 1ef8dce..4a6eaa8 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -1226,10 +1226,77 @@ sub _resolve_condition {
   }
 }
 
+# Legacy code, needs to go entirely away (fully replaced by _resolve_prefetch)
 sub resolve_prefetch {
   carp 'resolve_prefetch is a private method, stop calling it';
-  my $self = shift;
-  $self->_resolve_prefetch (@_);
+
+  my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
+  $seen ||= {};
+  if( ref $pre eq 'ARRAY' ) {
+    return
+      map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
+        @$pre;
+  }
+  elsif( ref $pre eq 'HASH' ) {
+    my @ret =
+    map {
+      $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
+      $self->related_source($_)->resolve_prefetch(
+               $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
+    } keys %$pre;
+    return @ret;
+  }
+  elsif( ref $pre ) {
+    $self->throw_exception(
+      "don't know how to resolve prefetch reftype ".ref($pre));
+  }
+  else {
+    my $count = ++$seen->{$pre};
+    my $as = ($count > 1 ? "${pre}_${count}" : $pre);
+    my $rel_info = $self->relationship_info( $pre );
+    $self->throw_exception( $self->name . " has no such relationship '$pre'" )
+      unless $rel_info;
+    my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
+    my $rel_source = $self->related_source($pre);
+
+    if (exists $rel_info->{attrs}{accessor}
+         && $rel_info->{attrs}{accessor} eq 'multi') {
+      $self->throw_exception(
+        "Can't prefetch has_many ${pre} (join cond too complex)")
+        unless ref($rel_info->{cond}) eq 'HASH';
+      my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
+      if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
+                         keys %{$collapse}) {
+        my ($last) = ($fail =~ /([^\.]+)$/);
+        carp (
+          "Prefetching multiple has_many rels ${last} and ${pre} "
+          .(length($as_prefix)
+            ? "at the same level (${as_prefix}) "
+            : "at top level "
+          )
+          . 'will currently disrupt both the functionality of $rs->count(), '
+          . 'and the amount of objects retrievable via $rs->next(). '
+          . 'Use at your own risk.'
+        );
+      }
+      #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
+      #              values %{$rel_info->{cond}};
+      $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
+        # action at a distance. prepending the '.' allows simpler code
+        # in ResultSet->_collapse_result
+      my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
+                    keys %{$rel_info->{cond}};
+      my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
+                   ? @{$rel_info->{attrs}{order_by}}
+                   : (defined $rel_info->{attrs}{order_by}
+                       ? ($rel_info->{attrs}{order_by})
+                       : ()));
+      push(@$order, map { "${as}.$_" } (@key, @ord));
+    }
+
+    return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
+      $rel_source->columns;
+  }
 }
 
 # Accepts one or more relationships for the current source and returns an
diff --git a/t/60core.t b/t/60core.t
index 042d543..6a710dc 100644
--- a/t/60core.t
+++ b/t/60core.t
@@ -8,7 +8,7 @@ use DBICTest;
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 98;
+plan tests => 103;
 
 eval { require DateTime::Format::MySQL };
 my $NO_DTFM = $@ ? 1 : 0;
@@ -398,3 +398,12 @@ SKIP: {
   $en_row->insert;
   is($en_row->encoded, 'amliw', 'insert does not encode again');
 }
+
+# make sure we got rid of the compat shims
+SKIP: {
+    skip "Remove in 0.09", 5 if $DBIx::Class::VERSION < 0.09;
+
+    for (qw/compare_relationship_keys pk_depends_on resolve_condition resolve_join resolve_prefetch/) {
+      ok (! DBIx::Class::ResultSource->can ($_), "$_ no longer provided by DBIx::Class::ResultSource");
+    }
+}