X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=aa76a6d36683e9e1048890c8ada2304a9755e257;hb=6a588797;hp=8263f11e0ea038bc2e6b081097553e3b199878fc;hpb=e6a0e17c94104d62c791cbf077e090e318617af6;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 8263f11..aa76a6d 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -86,68 +86,6 @@ sub new {
   
   my ($source, $attrs) = @_;
   weaken $source;
-  $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
-  #use Data::Dumper; warn Dumper($attrs);
-  my $alias = ($attrs->{alias} ||= 'me');
-  
-  $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
-  delete $attrs->{as} if $attrs->{columns};
-  $attrs->{columns} ||= [ $source->columns ] unless $attrs->{select};
-  $attrs->{select} = [
-    map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}}
-  ] if $attrs->{columns};
-  $attrs->{as} ||= [
-    map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
-  ];
-  if (my $include = delete $attrs->{include_columns}) {
-    push(@{$attrs->{select}}, @$include);
-    push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include);
-  }
-  #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
-
-  $attrs->{from} ||= [ { $alias => $source->from } ];
-  $attrs->{seen_join} ||= {};
-  my %seen;
-  if (my $join = delete $attrs->{join}) {
-    foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) {
-      if (ref $j eq 'HASH') {
-        $seen{$_} = 1 foreach keys %$j;
-      } else {
-        $seen{$j} = 1;
-      }
-    }
-    push(@{$attrs->{from}}, $source->resolve_join(
-      $join, $attrs->{alias}, $attrs->{seen_join})
-    );
-  }
-  
-  $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
-  $attrs->{order_by} = [ $attrs->{order_by} ] if
-    $attrs->{order_by} and !ref($attrs->{order_by});
-  $attrs->{order_by} ||= [];
-
-  my $collapse = $attrs->{collapse} || {};
-  if (my $prefetch = delete $attrs->{prefetch}) {
-    my @pre_order;
-    foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
-      if ( ref $p eq 'HASH' ) {
-        foreach my $key (keys %$p) {
-          push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
-            unless $seen{$key};
-        }
-      } else {
-        push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
-            unless $seen{$p};
-      }
-      my @prefetch = $source->resolve_prefetch(
-           $p, $attrs->{alias}, {}, \@pre_order, $collapse);
-      push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
-      push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
-    }
-    push(@{$attrs->{order_by}}, @pre_order);
-  }
-  $attrs->{collapse} = $collapse;
-#  use Data::Dumper; warn Dumper($collapse) if keys %{$collapse};
 
   if ($attrs->{page}) {
     $attrs->{rows} ||= 10;
@@ -155,12 +93,14 @@ sub new {
     $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
   }
 
+  $attrs->{alias} ||= 'me';
+
   bless {
     result_source => $source,
     result_class => $attrs->{result_class} || $source->result_class,
     cond => $attrs->{where},
-    from => $attrs->{from},
-    collapse => $collapse,
+#    from => $attrs->{from},
+#    collapse => $collapse,
     count => undef,
     page => delete $attrs->{page},
     pager => undef,
@@ -196,44 +136,45 @@ call it as C<search(undef, \%attrs)>.
 
 sub search {
   my $self = shift;
-
-  my $rs;
-  if( @_ ) {
     
-    my $attrs = { %{$self->{attrs}} };
-    my $having = delete $attrs->{having};
-    $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
-
-    my $where = (@_
-                  ? ((@_ == 1 || ref $_[0] eq "HASH")
-                      ? shift
-                      : ((@_ % 2)
-                          ? $self->throw_exception(
-                              "Odd number of arguments to search")
-                          : {@_}))
-                  : undef());
-    if (defined $where) {
-      $attrs->{where} = (defined $attrs->{where}
-                ? { '-and' =>
-                    [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
-                        $where, $attrs->{where} ] }
-                : $where);
-    }
-
-    if (defined $having) {
-      $attrs->{having} = (defined $attrs->{having}
-                ? { '-and' =>
-                    [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
-                        $having, $attrs->{having} ] }
-                : $having);
-    }
+  my $attrs = { %{$self->{attrs}} };
+  my $having = delete $attrs->{having};
+  $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
+
+  my $where = (@_
+                ? ((@_ == 1 || ref $_[0] eq "HASH")
+                    ? shift
+                    : ((@_ % 2)
+                        ? $self->throw_exception(
+                            "Odd number of arguments to search")
+                        : {@_}))
+                : undef());
+  if (defined $where) {
+    $attrs->{where} = (defined $attrs->{where}
+              ? { '-and' =>
+                  [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
+                      $where, $attrs->{where} ] }
+              : $where);
+  }
 
-    $rs = (ref $self)->new($self->result_source, $attrs);
+  if (defined $having) {
+    $attrs->{having} = (defined $attrs->{having}
+              ? { '-and' =>
+                  [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
+                      $having, $attrs->{having} ] }
+              : $having);
   }
-  else {
-    $rs = $self;
-    $rs->reset;
+
+  my $rs = (ref $self)->new($self->result_source, $attrs);
+  $rs->{_parent_rs} = $self->{_parent_rs} if ($self->{_parent_rs}); #XXX - hack to pass through parent of related resultsets
+
+  unless (@_) { # no search, effectively just a clone
+    my $rows = $self->get_cache;
+    if( @{$rows} ) {
+      $rs->set_cache($rows);
+    }
   }
+  
   return (wantarray ? $rs->all : $rs);
 }
 
@@ -255,6 +196,7 @@ resultset query.
 
 =cut
 
+# TODO: needs fixing
 sub search_literal {
   my ($self, $cond, @vals) = @_;
   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
@@ -277,8 +219,8 @@ a row by its primary key:
 
   my $cd = $schema->resultset('CD')->find(5);
 
-You can also find a row by a specific key or unique constraint by specifying
-the C<key> attribute. For example:
+You can also find a row by a specific unique constraint using the C<key>
+attribute. For example:
 
   my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', { key => 'artist_title' });
 
@@ -304,90 +246,79 @@ L<DBIx::Class::ResultSource/add_unique_constraint>.
 =cut
 
 sub find {
-  my ($self, @vals) = @_;
-  my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
-
-  # Build a list of queries
-  my @unique_hashes;
-
-  if (ref $vals[0] eq 'HASH') {
-    my @constraint_names = exists $attrs->{key}
-      ? ($attrs->{key})
-      : $self->result_source->unique_constraint_names;
-    $self->throw_exception(
-      "Can't find by explicitly named columns unless a primary key or unique constraint is defined"
-    ) unless @constraint_names;
+  my $self = shift;
+  my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 
-    foreach my $name (@constraint_names) {
-      my @unique_cols = $self->result_source->unique_constraint_columns($name);
-      my $unique_hash = $self->_unique_hash($vals[0], \@unique_cols);
+  # Parse out a hash from input
+  my @cols = exists $attrs->{key}
+    ? $self->result_source->unique_constraint_columns($attrs->{key})
+    : $self->result_source->primary_columns;
 
-      # TODO: Check that the ResultSet defines the rest of the query
-      push @unique_hashes, $unique_hash
-        if scalar keys %$unique_hash;# == scalar @unique_cols;
-    }
+  my $hash;
+  if (ref $_[0] eq 'HASH') {
+    $hash = { %{$_[0]} };
+  }
+  elsif (@_ == @cols) {
+    $hash = {};
+    @{$hash}{@cols} = @_;
   }
   else {
-    my @unique_cols = exists $attrs->{key}
-      ? $self->result_source->unique_constraint_columns($attrs->{key})
-      : $self->result_source->primary_columns;
     $self->throw_exception(
-      "Can't find unless a primary key is defined or a unique constraint is specified"
-    ) unless @unique_cols;
-
-    if (@vals == @unique_cols) {
-      my %unique_hash;
-      @unique_hash{@unique_cols} = @vals;
-      push @unique_hashes, \%unique_hash;
-    }
-    else {
-      # Hack for CDBI queries
-      my %hash = @vals;
-      push @unique_hashes, \%hash;
-    }
+      "Arguments to find must be a hashref or match the number of columns in the "
+        . exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key"
+    );
   }
 
-  # Add the ResultSet's alias
-  foreach my $unique_hash (@unique_hashes) {
-    foreach my $key (grep { ! m/\./ } keys %$unique_hash) {
-      $unique_hash->{"$self->{attrs}{alias}.$key"} = delete $unique_hash->{$key};
+  # Check the hash we just parsed against our source's unique constraints
+  my @constraint_names = exists $attrs->{key}
+    ? ($attrs->{key})
+    : $self->result_source->unique_constraint_names;
+  $self->throw_exception(
+    "Can't find unless a primary key or unique constraint is defined"
+  ) unless @constraint_names;
+
+  my @unique_queries;
+  foreach my $name (@constraint_names) {
+    my @unique_cols = $self->result_source->unique_constraint_columns($name);
+    my $unique_query = $self->_build_unique_query($hash, \@unique_cols);
+
+    # Add the ResultSet's alias
+    foreach my $key (grep { ! m/\./ } keys %$unique_query) {
+      my $alias = $self->{attrs}->{alias};
+      $unique_query->{"$alias.$key"} = delete $unique_query->{$key};
     }
+
+    push @unique_queries, $unique_query if %$unique_query;
   }
 
   # Handle cases where the ResultSet already defines the query
-  my $query = @unique_hashes ? \@unique_hashes : undef;
+  my $query = @unique_queries ? \@unique_queries : undef;
 
+  # Run the query
   if (keys %$attrs) {
     my $rs = $self->search($query, $attrs);
-    return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
+    return $rs->{attrs}->{prefetch} ? $rs->next : $rs->single;
   }
   else {
-    return keys %{$self->{collapse}}
+    return ($self->{attrs}->{prefetch})
       ? $self->search($query)->next
       : $self->single($query);
   }
 }
 
-# _unique_hash
+# _build_unique_query
 #
-# Constrain the specified hash based on the specific column names.
+# Constrain the specified query hash based on the specified column names.
 
-sub _unique_hash {
-  my ($self, $hash, $unique_cols) = @_;
+sub _build_unique_query {
+  my ($self, $query, $unique_cols) = @_;
 
-  # Ugh, CDBI lowercases column names
-  if (exists $INC{'DBIx/Class/CDBICompat/ColumnCase.pm'}) {
-    foreach my $key (keys %$hash) {
-      $hash->{lc $key} = delete $hash->{$key};
-    }
-  }
-
-  my %unique_hash =
-    map  { $_ => $hash->{$_} }
-    grep { exists $hash->{$_} }
+  my %unique_query =
+    map  { $_ => $query->{$_} }
+    grep { exists $query->{$_} }
     @$unique_cols;
 
-  return \%unique_hash;
+  return \%unique_query;
 }
 
 =head2 search_related
@@ -430,9 +361,11 @@ L<DBIx::Class::Cursor> for more information.
 
 sub cursor {
   my ($self) = @_;
-  my $attrs = { %{$self->{attrs}} };
+
+  $self->_resolve;
+  my $attrs = { %{$self->{_attrs}} };
   return $self->{cursor}
-    ||= $self->result_source->storage->select($self->{from}, $attrs->{select},
+    ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
           $attrs->{where},$attrs);
 }
 
@@ -455,7 +388,8 @@ any records in it; if not returns nothing. Used by L</find> as an optimisation.
 
 sub single {
   my ($self, $where) = @_;
-  my $attrs = { %{$self->{attrs}} };
+  $self->_resolve;
+  my $attrs = { %{$self->{_attrs}} };
   if ($where) {
     if (defined $attrs->{where}) {
       $attrs->{where} = {
@@ -467,8 +401,9 @@ sub single {
       $attrs->{where} = $where;
     }
   }
+
   my @data = $self->result_source->storage->select_single(
-          $self->{from}, $attrs->{select},
+          $attrs->{from}, $attrs->{select},
           $attrs->{where},$attrs);
   return (@data ? $self->_construct_object(@data) : ());
 }
@@ -593,27 +528,100 @@ sub next {
                @{delete $self->{stashed_row}} :
                $self->cursor->next
   );
-#  warn Dumper(\@row); use Data::Dumper;
   return unless (@row);
   return $self->_construct_object(@row);
 }
 
+# XXX - this is essentially just the old new(). rewrite / tidy up?
+sub _resolve {
+  my $self = shift;
+
+  return if(exists $self->{_attrs}); #return if _resolve has already been called
+
+  my $attrs = $self->{attrs};  
+  my $source = ($self->{_parent_rs}) ? $self->{_parent_rs} : $self->{result_source};
+
+  # XXX - this is a hack to prevent dclone dieing because of the code ref, get's put back in $attrs afterwards
+  my $record_filter = delete $attrs->{record_filter} if (defined $attrs->{record_filter});
+  $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
+  my $alias = $attrs->{alias};
+ 
+  $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
+  delete $attrs->{as} if $attrs->{columns};
+  $attrs->{columns} ||= [ $self->{result_source}->columns ] unless $attrs->{select};
+  my $select_alias = ($self->{_parent_rs}) ? $self->{attrs}->{_live_join} : $alias;
+  $attrs->{select} = [
+		      map { m/\./ ? $_ : "${select_alias}.$_" } @{delete $attrs->{columns}}
+		      ] if $attrs->{columns};
+  $attrs->{as} ||= [
+		    map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
+		    ];
+  if (my $include = delete $attrs->{include_columns}) {
+      push(@{$attrs->{select}}, @$include);
+      push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include);
+  }
+  #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
+
+  $attrs->{from} ||= [ { $alias => $source->from } ];
+  $attrs->{seen_join} ||= {};
+  my %seen;
+  if (my $join = delete $attrs->{join}) {
+      foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) {
+	  if (ref $j eq 'HASH') {
+	      $seen{$_} = 1 foreach keys %$j;
+	  } else {
+	      $seen{$j} = 1;
+	  }
+      }
+
+      push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join}));
+  }
+  
+  $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
+  $attrs->{order_by} = [ $attrs->{order_by} ] if
+      $attrs->{order_by} and !ref($attrs->{order_by});
+  $attrs->{order_by} ||= [];
+  
+  my $collapse = $attrs->{collapse} || {};
+  if (my $prefetch = delete $attrs->{prefetch}) {
+      my @pre_order;
+      foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
+	  if ( ref $p eq 'HASH' ) {
+	      foreach my $key (keys %$p) {
+		  push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
+		      unless $seen{$key};
+	      }
+	  } else {
+	      push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
+		  unless $seen{$p};
+	  }
+	  my @prefetch = $source->resolve_prefetch(
+						   $p, $attrs->{alias}, {}, \@pre_order, $collapse);
+	  push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
+	  push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
+      }
+      push(@{$attrs->{order_by}}, @pre_order);
+  }
+  $attrs->{collapse} = $collapse;
+  $attrs->{record_filter} = $record_filter if ($record_filter);
+  $self->{_attrs} = $attrs;
+}
+
 sub _construct_object {
   my ($self, @row) = @_;
-  my @as = @{ $self->{attrs}{as} };
-  
+  my @as = @{ $self->{_attrs}{as} };
+
   my $info = $self->_collapse_result(\@as, \@row);
-  
-  my $new = $self->result_class->inflate_result($self->result_source, @$info);
-  
-  $new = $self->{attrs}{record_filter}->($new)
-    if exists $self->{attrs}{record_filter};
+  my $new = $self->result_class->inflate_result($self->result_source, @$info, $self->{_parent_rs});
+  $new = $self->{_attrs}{record_filter}->($new)
+    if exists $self->{_attrs}{record_filter};
   return $new;
 }
 
 sub _collapse_result {
   my ($self, $as, $row, $prefix) = @_;
 
+  my $live_join = $self->{attrs}->{_live_join} ||="";
   my %const;
 
   my @copy = @$row;
@@ -633,7 +641,7 @@ sub _collapse_result {
 
   my $info = [ {}, {} ];
   foreach my $key (keys %const) {
-    if (length $key) {
+    if (length $key && $key ne $live_join) {
       my $target = $info;
       my @parts = split(/\./, $key);
       foreach my $p (@parts) {
@@ -649,9 +657,9 @@ sub _collapse_result {
   if (defined $prefix) {
     @collapse = map {
         m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
-    } keys %{$self->{collapse}}
+    } keys %{$self->{_attrs}->{collapse}}
   } else {
-    @collapse = keys %{$self->{collapse}};
+    @collapse = keys %{$self->{_attrs}->{collapse}};
   };
 
   if (@collapse) {
@@ -661,7 +669,7 @@ sub _collapse_result {
       $target = $target->[1]->{$p} ||= [];
     }
     my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c);
-    my @co_key = @{$self->{collapse}{$c_prefix}};
+    my @co_key = @{$self->{_attrs}->{collapse}{$c_prefix}};
     my %co_check = map { ($_, $target->[0]->{$_}); } @co_key;
     my $tree = $self->_collapse_result($as, $row, $c_prefix);
     my (@final, @raw);
@@ -673,11 +681,9 @@ sub _collapse_result {
       last unless (@raw = $self->cursor->next);
       $row = $self->{stashed_row} = \@raw;
       $tree = $self->_collapse_result($as, $row, $c_prefix);
-      #warn Data::Dumper::Dumper($tree, $row);
     }
     @$target = @final;
   }
-
   return $info;
 }
 
@@ -736,7 +742,9 @@ sub count {
 sub _count { # Separated out so pager can get the full count
   my $self = shift;
   my $select = { count => '*' };
-  my $attrs = { %{ $self->{attrs} } };
+  
+  $self->_resolve;
+  my $attrs = { %{ $self->{_attrs} } };
   if (my $group_by = delete $attrs->{group_by}) {
     delete $attrs->{having};
     my @distinct = (ref $group_by ?  @$group_by : ($group_by));
@@ -760,7 +768,7 @@ sub _count { # Separated out so pager can get the full count
 
   # offset, order by and page are not needed to count. record_filter is cdbi
   delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
-        
+       
   my ($count) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
   return $count;
 }
@@ -803,12 +811,14 @@ sub all {
 
   my @obj;
 
-  if (keys %{$self->{collapse}}) {
+  # XXX used to be 'if (keys %{$self->{collapse}})' 
+  # XXX replaced by this as it seemed to do roughly the same thing 
+  # XXX could be bad as never really understood exactly what collapse did
+  if ($self->{attrs}->{prefetch}) {
       # Using $self->cursor->all is really just an optimisation.
       # If we're collapsing has_many prefetches it probably makes
       # very little difference, and this is cleaner than hacking
       # _construct_object to survive the approach
-    $self->cursor->reset;
     my @row = $self->cursor->next;
     while (@row) {
       push(@obj, $self->_construct_object(@row));
@@ -840,6 +850,8 @@ Resets the resultset's cursor, so you can iterate through the elements again.
 
 sub reset {
   my ($self) = @_;
+  delete $self->{_attrs} if (exists $self->{_attrs});
+
   $self->{all_cache_position} = 0;
   $self->cursor->reset;
   return $self;
@@ -1342,28 +1354,28 @@ Returns a related resultset for the supplied relationship name.
 
 sub related_resultset {
   my ( $self, $rel ) = @_;
+
   $self->{related_resultsets} ||= {};
   return $self->{related_resultsets}{$rel} ||= do {
-      #warn "fetching related resultset for rel '$rel'";
+      #warn "fetching related resultset for rel '$rel' " . $self->result_source->{name};
       my $rel_obj = $self->result_source->relationship_info($rel);
       $self->throw_exception(
         "search_related: result source '" . $self->result_source->name .
         "' has no such relationship ${rel}")
         unless $rel_obj; #die Dumper $self->{attrs};
 
-      my $rs = $self->search(undef, { join => $rel });
-      my $alias = defined $rs->{attrs}{seen_join}{$rel}
-                    && $rs->{attrs}{seen_join}{$rel} > 1
-                  ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
-                  : $rel;
-
-      $self->result_source->schema->resultset($rel_obj->{class}
+      my $rs = $self->result_source->schema->resultset($rel_obj->{class}
            )->search( undef,
-             { %{$rs->{attrs}},
-               alias => $alias,
+             { %{$self->{attrs}},
                select => undef,
-               as => undef }
+               as => undef,
+	       join => $rel,
+	       _live_join => $rel }
            );
+
+      # keep reference of the original resultset
+      $rs->{_parent_rs} = $self->result_source;
+      return $rs;
   };
 }