add SQL::Abstract to search docs (patch from zamolxes)
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
1 package DBIx::Class::ResultSet;
2
3 use strict;
4 use warnings;
5 use overload
6         '0+'     => \&count,
7         'bool'   => sub { 1; },
8         fallback => 1;
9 use Carp::Clan qw/^DBIx::Class/;
10 use Data::Page;
11 use Storable;
12 use DBIx::Class::ResultSetColumn;
13 use base qw/DBIx::Class/;
14
15 __PACKAGE__->load_components(qw/AccessorGroup/);
16 __PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
17
18 =head1 NAME
19
20 DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
21
22 =head1 SYNOPSIS
23
24   my $rs   = $schema->resultset('User')->search(registered => 1);
25   my @rows = $schema->resultset('CD')->search(year => 2005);
26
27 =head1 DESCRIPTION
28
29 The resultset is also known as an iterator. It is responsible for handling
30 queries that may return an arbitrary number of rows, e.g. via L</search>
31 or a C<has_many> relationship.
32
33 In the examples below, the following table classes are used:
34
35   package MyApp::Schema::Artist;
36   use base qw/DBIx::Class/;
37   __PACKAGE__->load_components(qw/Core/);
38   __PACKAGE__->table('artist');
39   __PACKAGE__->add_columns(qw/artistid name/);
40   __PACKAGE__->set_primary_key('artistid');
41   __PACKAGE__->has_many(cds => 'MyApp::Schema::CD');
42   1;
43
44   package MyApp::Schema::CD;
45   use base qw/DBIx::Class/;
46   __PACKAGE__->load_components(qw/Core/);
47   __PACKAGE__->table('cd');
48   __PACKAGE__->add_columns(qw/cdid artist title year/);
49   __PACKAGE__->set_primary_key('cdid');
50   __PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
51   1;
52
53 =head1 METHODS
54
55 =head2 new
56
57 =over 4
58
59 =item Arguments: $source, \%$attrs
60
61 =item Return Value: $rs
62
63 =back
64
65 The resultset constructor. Takes a source object (usually a
66 L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
67 L</ATTRIBUTES> below).  Does not perform any queries -- these are
68 executed as needed by the other methods.
69
70 Generally you won't need to construct a resultset manually.  You'll
71 automatically get one from e.g. a L</search> called in scalar context:
72
73   my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
74
75 IMPORTANT: If called on an object, proxies to new_result instead so
76
77   my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
78
79 will return a CD object, not a ResultSet.
80
81 =cut
82
83 sub new {
84   my $class = shift;
85   return $class->new_result(@_) if ref $class;
86
87   my ($source, $attrs) = @_;
88   #weaken $source;
89   $attrs = { %{$attrs||{}} };
90
91   if ($attrs->{page}) {
92     $attrs->{rows} ||= 10;
93     $attrs->{offset} ||= 0;
94     $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
95   }
96
97   $attrs->{alias} ||= 'me';
98
99   my $self = {
100     result_source => $source,
101     result_class => $attrs->{result_class} || $source->result_class,
102     cond => $attrs->{where},
103     count => undef,
104     pager => undef,
105     attrs => $attrs
106   };
107
108   bless $self, $class;
109
110   return $self;
111 }
112
113 =head2 search
114
115 =over 4
116
117 =item Arguments: $cond, \%attrs?
118
119 =item Return Value: $resultset (scalar context), @row_objs (list context)
120
121 =back
122
123   my @cds    = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
124   my $new_rs = $cd_rs->search({ year => 2005 });
125
126   my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
127                  # year = 2005 OR year = 2004
128
129 If you need to pass in additional attributes but no additional condition,
130 call it as C<search(undef, \%attrs)>.
131
132   # "SELECT name, artistid FROM $artist_table"
133   my @all_artists = $schema->resultset('Artist')->search(undef, {
134     columns => [qw/name artistid/],
135   });
136
137 For a list of attributes that can be passed to C<search>, see
138 L</ATTRIBUTES>. For more examples of using this function, see
139 L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
140 documentation for the first argument, see L<SQL::Abstract>.
141
142 =cut
143
144 sub search {
145   my $self = shift;
146   my $rs = $self->search_rs( @_ );
147   return (wantarray ? $rs->all : $rs);
148 }
149
150 =head2 search_rs
151
152 =over 4
153
154 =item Arguments: $cond, \%attrs?
155
156 =item Return Value: $resultset
157
158 =back
159
160 This method does the same exact thing as search() except it will
161 always return a resultset, even in list context.
162
163 =cut
164
165 sub search_rs {
166   my $self = shift;
167
168   my $rows;
169
170   unless (@_) {                 # no search, effectively just a clone
171     $rows = $self->get_cache;
172   }
173
174   my $attrs = {};
175   $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
176   my $our_attrs = { %{$self->{attrs}} };
177   my $having = delete $our_attrs->{having};
178   my $where = delete $our_attrs->{where};
179
180   my $new_attrs = { %{$our_attrs}, %{$attrs} };
181
182   # merge new attrs into inherited
183   foreach my $key (qw/join prefetch/) {
184     next unless exists $attrs->{$key};
185     $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
186   }
187
188   my $cond = (@_
189     ? (
190         (@_ == 1 || ref $_[0] eq "HASH")
191           ? (
192               (ref $_[0] eq 'HASH')
193                 ? (
194                     (keys %{ $_[0] }  > 0)
195                       ? shift
196                       : undef
197                    )
198                 :  shift
199              )
200           : (
201               (@_ % 2)
202                 ? $self->throw_exception("Odd number of arguments to search")
203                 : {@_}
204              )
205       )
206     : undef
207   );
208
209   if (defined $where) {
210     $new_attrs->{where} = (
211       defined $new_attrs->{where}
212         ? { '-and' => [
213               map {
214                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
215               } $where, $new_attrs->{where}
216             ]
217           }
218         : $where);
219   }
220
221   if (defined $cond) {
222     $new_attrs->{where} = (
223       defined $new_attrs->{where}
224         ? { '-and' => [
225               map {
226                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
227               } $cond, $new_attrs->{where}
228             ]
229           }
230         : $cond);
231   }
232
233   if (defined $having) {
234     $new_attrs->{having} = (
235       defined $new_attrs->{having}
236         ? { '-and' => [
237               map {
238                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
239               } $having, $new_attrs->{having}
240             ]
241           }
242         : $having);
243   }
244
245   my $rs = (ref $self)->new($self->result_source, $new_attrs);
246   if ($rows) {
247     $rs->set_cache($rows);
248   }
249   return $rs;
250 }
251
252 =head2 search_literal
253
254 =over 4
255
256 =item Arguments: $sql_fragment, @bind_values
257
258 =item Return Value: $resultset (scalar context), @row_objs (list context)
259
260 =back
261
262   my @cds   = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
263   my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
264
265 Pass a literal chunk of SQL to be added to the conditional part of the
266 resultset query.
267
268 =cut
269
270 sub search_literal {
271   my ($self, $cond, @vals) = @_;
272   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
273   $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ];
274   return $self->search(\$cond, $attrs);
275 }
276
277 =head2 find
278
279 =over 4
280
281 =item Arguments: @values | \%cols, \%attrs?
282
283 =item Return Value: $row_object
284
285 =back
286
287 Finds a row based on its primary key or unique constraint. For example, to find
288 a row by its primary key:
289
290   my $cd = $schema->resultset('CD')->find(5);
291
292 You can also find a row by a specific unique constraint using the C<key>
293 attribute. For example:
294
295   my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', {
296     key => 'cd_artist_title'
297   });
298
299 Additionally, you can specify the columns explicitly by name:
300
301   my $cd = $schema->resultset('CD')->find(
302     {
303       artist => 'Massive Attack',
304       title  => 'Mezzanine',
305     },
306     { key => 'cd_artist_title' }
307   );
308
309 If the C<key> is specified as C<primary>, it searches only on the primary key.
310
311 If no C<key> is specified, it searches on all unique constraints defined on the
312 source, including the primary key.
313
314 If your table does not have a primary key, you B<must> provide a value for the
315 C<key> attribute matching one of the unique constraints on the source.
316
317 See also L</find_or_create> and L</update_or_create>. For information on how to
318 declare unique constraints, see
319 L<DBIx::Class::ResultSource/add_unique_constraint>.
320
321 =cut
322
323 sub find {
324   my $self = shift;
325   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
326
327   # Default to the primary key, but allow a specific key
328   my @cols = exists $attrs->{key}
329     ? $self->result_source->unique_constraint_columns($attrs->{key})
330     : $self->result_source->primary_columns;
331   $self->throw_exception(
332     "Can't find unless a primary key is defined or unique constraint is specified"
333   ) unless @cols;
334
335   # Parse out a hashref from input
336   my $input_query;
337   if (ref $_[0] eq 'HASH') {
338     $input_query = { %{$_[0]} };
339   }
340   elsif (@_ == @cols) {
341     $input_query = {};
342     @{$input_query}{@cols} = @_;
343   }
344   else {
345     # Compatibility: Allow e.g. find(id => $value)
346     carp "Find by key => value deprecated; please use a hashref instead";
347     $input_query = {@_};
348   }
349
350   my (%related, $info);
351
352   foreach my $key (keys %$input_query) {
353     if (ref($input_query->{$key})
354         && ($info = $self->result_source->relationship_info($key))) {
355       my $rel_q = $self->result_source->resolve_condition(
356                     $info->{cond}, delete $input_query->{$key}, $key
357                   );
358       die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY';
359       @related{keys %$rel_q} = values %$rel_q;
360     }
361   }
362   if (my @keys = keys %related) {
363     @{$input_query}{@keys} = values %related;
364   }
365
366   my @unique_queries = $self->_unique_queries($input_query, $attrs);
367
368   # Build the final query: Default to the disjunction of the unique queries,
369   # but allow the input query in case the ResultSet defines the query or the
370   # user is abusing find
371   my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
372   my $query = @unique_queries
373     ? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
374     : $self->_add_alias($input_query, $alias);
375
376   # Run the query
377   if (keys %$attrs) {
378     my $rs = $self->search($query, $attrs);
379     return keys %{$rs->_resolved_attrs->{collapse}} ? $rs->next : $rs->single;
380   }
381   else {
382     return keys %{$self->_resolved_attrs->{collapse}}
383       ? $self->search($query)->next
384       : $self->single($query);
385   }
386 }
387
388 # _add_alias
389 #
390 # Add the specified alias to the specified query hash. A copy is made so the
391 # original query is not modified.
392
393 sub _add_alias {
394   my ($self, $query, $alias) = @_;
395
396   my %aliased = %$query;
397   foreach my $col (grep { ! m/\./ } keys %aliased) {
398     $aliased{"$alias.$col"} = delete $aliased{$col};
399   }
400
401   return \%aliased;
402 }
403
404 # _unique_queries
405 #
406 # Build a list of queries which satisfy unique constraints.
407
408 sub _unique_queries {
409   my ($self, $query, $attrs) = @_;
410
411   my @constraint_names = exists $attrs->{key}
412     ? ($attrs->{key})
413     : $self->result_source->unique_constraint_names;
414
415   my $where = $self->_collapse_cond($self->{attrs}{where} || {});
416   my $num_where = scalar keys %$where;
417
418   my @unique_queries;
419   foreach my $name (@constraint_names) {
420     my @unique_cols = $self->result_source->unique_constraint_columns($name);
421     my $unique_query = $self->_build_unique_query($query, \@unique_cols);
422
423     my $num_cols = scalar @unique_cols;
424     my $num_query = scalar keys %$unique_query;
425
426     my $total = $num_query + $num_where;
427     if ($num_query && ($num_query == $num_cols || $total == $num_cols)) {
428       # The query is either unique on its own or is unique in combination with
429       # the existing where clause
430       push @unique_queries, $unique_query;
431     }
432   }
433
434   return @unique_queries;
435 }
436
437 # _build_unique_query
438 #
439 # Constrain the specified query hash based on the specified column names.
440
441 sub _build_unique_query {
442   my ($self, $query, $unique_cols) = @_;
443
444   return {
445     map  { $_ => $query->{$_} }
446     grep { exists $query->{$_} }
447       @$unique_cols
448   };
449 }
450
451 =head2 search_related
452
453 =over 4
454
455 =item Arguments: $rel, $cond, \%attrs?
456
457 =item Return Value: $new_resultset
458
459 =back
460
461   $new_rs = $cd_rs->search_related('artist', {
462     name => 'Emo-R-Us',
463   });
464
465 Searches the specified relationship, optionally specifying a condition and
466 attributes for matching records. See L</ATTRIBUTES> for more information.
467
468 =cut
469
470 sub search_related {
471   return shift->related_resultset(shift)->search(@_);
472 }
473
474 =head2 cursor
475
476 =over 4
477
478 =item Arguments: none
479
480 =item Return Value: $cursor
481
482 =back
483
484 Returns a storage-driven cursor to the given resultset. See
485 L<DBIx::Class::Cursor> for more information.
486
487 =cut
488
489 sub cursor {
490   my ($self) = @_;
491
492   my $attrs = { %{$self->_resolved_attrs} };
493   return $self->{cursor}
494     ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
495           $attrs->{where},$attrs);
496 }
497
498 =head2 single
499
500 =over 4
501
502 =item Arguments: $cond?
503
504 =item Return Value: $row_object?
505
506 =back
507
508   my $cd = $schema->resultset('CD')->single({ year => 2001 });
509
510 Inflates the first result without creating a cursor if the resultset has
511 any records in it; if not returns nothing. Used by L</find> as an optimisation.
512
513 Can optionally take an additional condition *only* - this is a fast-code-path
514 method; if you need to add extra joins or similar call ->search and then
515 ->single without a condition on the $rs returned from that.
516
517 =cut
518
519 sub single {
520   my ($self, $where) = @_;
521   my $attrs = { %{$self->_resolved_attrs} };
522   if ($where) {
523     if (defined $attrs->{where}) {
524       $attrs->{where} = {
525         '-and' =>
526             [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
527                $where, delete $attrs->{where} ]
528       };
529     } else {
530       $attrs->{where} = $where;
531     }
532   }
533
534 #  XXX: Disabled since it doesn't infer uniqueness in all cases
535 #  unless ($self->_is_unique_query($attrs->{where})) {
536 #    carp "Query not guaranteed to return a single row"
537 #      . "; please declare your unique constraints or use search instead";
538 #  }
539
540   my @data = $self->result_source->storage->select_single(
541     $attrs->{from}, $attrs->{select},
542     $attrs->{where}, $attrs
543   );
544
545   return (@data ? ($self->_construct_object(@data))[0] : ());
546 }
547
548 # _is_unique_query
549 #
550 # Try to determine if the specified query is guaranteed to be unique, based on
551 # the declared unique constraints.
552
553 sub _is_unique_query {
554   my ($self, $query) = @_;
555
556   my $collapsed = $self->_collapse_query($query);
557   my $alias = $self->{attrs}{alias};
558
559   foreach my $name ($self->result_source->unique_constraint_names) {
560     my @unique_cols = map {
561       "$alias.$_"
562     } $self->result_source->unique_constraint_columns($name);
563
564     # Count the values for each unique column
565     my %seen = map { $_ => 0 } @unique_cols;
566
567     foreach my $key (keys %$collapsed) {
568       my $aliased = $key =~ /\./ ? $key : "$alias.$key";
569       next unless exists $seen{$aliased};  # Additional constraints are okay
570       $seen{$aliased} = scalar keys %{ $collapsed->{$key} };
571     }
572
573     # If we get 0 or more than 1 value for a column, it's not necessarily unique
574     return 1 unless grep { $_ != 1 } values %seen;
575   }
576
577   return 0;
578 }
579
580 # _collapse_query
581 #
582 # Recursively collapse the query, accumulating values for each column.
583
584 sub _collapse_query {
585   my ($self, $query, $collapsed) = @_;
586
587   $collapsed ||= {};
588
589   if (ref $query eq 'ARRAY') {
590     foreach my $subquery (@$query) {
591       next unless ref $subquery;  # -or
592 #      warn "ARRAY: " . Dumper $subquery;
593       $collapsed = $self->_collapse_query($subquery, $collapsed);
594     }
595   }
596   elsif (ref $query eq 'HASH') {
597     if (keys %$query and (keys %$query)[0] eq '-and') {
598       foreach my $subquery (@{$query->{-and}}) {
599 #        warn "HASH: " . Dumper $subquery;
600         $collapsed = $self->_collapse_query($subquery, $collapsed);
601       }
602     }
603     else {
604 #      warn "LEAF: " . Dumper $query;
605       foreach my $col (keys %$query) {
606         my $value = $query->{$col};
607         $collapsed->{$col}{$value}++;
608       }
609     }
610   }
611
612   return $collapsed;
613 }
614
615 =head2 get_column
616
617 =over 4
618
619 =item Arguments: $cond?
620
621 =item Return Value: $resultsetcolumn
622
623 =back
624
625   my $max_length = $rs->get_column('length')->max;
626
627 Returns a L<DBIx::Class::ResultSetColumn> instance for a column of the ResultSet.
628
629 =cut
630
631 sub get_column {
632   my ($self, $column) = @_;
633   my $new = DBIx::Class::ResultSetColumn->new($self, $column);
634   return $new;
635 }
636
637 =head2 search_like
638
639 =over 4
640
641 =item Arguments: $cond, \%attrs?
642
643 =item Return Value: $resultset (scalar context), @row_objs (list context)
644
645 =back
646
647   # WHERE title LIKE '%blue%'
648   $cd_rs = $rs->search_like({ title => '%blue%'});
649
650 Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
651 that this is simply a convenience method. You most likely want to use
652 L</search> with specific operators.
653
654 For more information, see L<DBIx::Class::Manual::Cookbook>.
655
656 =cut
657
658 sub search_like {
659   my $class = shift;
660   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
661   my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
662   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
663   return $class->search($query, { %$attrs });
664 }
665
666 =head2 slice
667
668 =over 4
669
670 =item Arguments: $first, $last
671
672 =item Return Value: $resultset (scalar context), @row_objs (list context)
673
674 =back
675
676 Returns a resultset or object list representing a subset of elements from the
677 resultset slice is called on. Indexes are from 0, i.e., to get the first
678 three records, call:
679
680   my ($one, $two, $three) = $rs->slice(0, 2);
681
682 =cut
683
684 sub slice {
685   my ($self, $min, $max) = @_;
686   my $attrs = {}; # = { %{ $self->{attrs} || {} } };
687   $attrs->{offset} = $self->{attrs}{offset} || 0;
688   $attrs->{offset} += $min;
689   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
690   return $self->search(undef(), $attrs);
691   #my $slice = (ref $self)->new($self->result_source, $attrs);
692   #return (wantarray ? $slice->all : $slice);
693 }
694
695 =head2 next
696
697 =over 4
698
699 =item Arguments: none
700
701 =item Return Value: $result?
702
703 =back
704
705 Returns the next element in the resultset (C<undef> is there is none).
706
707 Can be used to efficiently iterate over records in the resultset:
708
709   my $rs = $schema->resultset('CD')->search;
710   while (my $cd = $rs->next) {
711     print $cd->title;
712   }
713
714 Note that you need to store the resultset object, and call C<next> on it.
715 Calling C<< resultset('Table')->next >> repeatedly will always return the
716 first record from the resultset.
717
718 =cut
719
720 sub next {
721   my ($self) = @_;
722   if (my $cache = $self->get_cache) {
723     $self->{all_cache_position} ||= 0;
724     return $cache->[$self->{all_cache_position}++];
725   }
726   if ($self->{attrs}{cache}) {
727     $self->{all_cache_position} = 1;
728     return ($self->all)[0];
729   }
730   if ($self->{stashed_objects}) {
731     my $obj = shift(@{$self->{stashed_objects}});
732     delete $self->{stashed_objects} unless @{$self->{stashed_objects}};
733     return $obj;
734   }
735   my @row = (
736     exists $self->{stashed_row}
737       ? @{delete $self->{stashed_row}}
738       : $self->cursor->next
739   );
740   return unless (@row);
741   my ($row, @more) = $self->_construct_object(@row);
742   $self->{stashed_objects} = \@more if @more;
743   return $row;
744 }
745
746 sub _construct_object {
747   my ($self, @row) = @_;
748   my $info = $self->_collapse_result($self->{_attrs}{as}, \@row);
749   my @new = $self->result_class->inflate_result($self->result_source, @$info);
750   @new = $self->{_attrs}{record_filter}->(@new)
751     if exists $self->{_attrs}{record_filter};
752   return @new;
753 }
754
755 sub _collapse_result {
756   my ($self, $as, $row, $prefix) = @_;
757
758   my %const;
759   my @copy = @$row;
760   
761   foreach my $this_as (@$as) {
762     my $val = shift @copy;
763     if (defined $prefix) {
764       if ($this_as =~ m/^\Q${prefix}.\E(.+)$/) {
765         my $remain = $1;
766         $remain =~ /^(?:(.*)\.)?([^.]+)$/;
767         $const{$1||''}{$2} = $val;
768       }
769     } else {
770       $this_as =~ /^(?:(.*)\.)?([^.]+)$/;
771       $const{$1||''}{$2} = $val;
772     }
773   }
774
775   my $alias = $self->{attrs}{alias};
776   my $info = [ {}, {} ];
777   foreach my $key (keys %const) {
778     if (length $key && $key ne $alias) {
779       my $target = $info;
780       my @parts = split(/\./, $key);
781       foreach my $p (@parts) {
782         $target = $target->[1]->{$p} ||= [];
783       }
784       $target->[0] = $const{$key};
785     } else {
786       $info->[0] = $const{$key};
787     }
788   }
789   
790   my @collapse;
791   if (defined $prefix) {
792     @collapse = map {
793         m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
794     } keys %{$self->{_attrs}{collapse}}
795   } else {
796     @collapse = keys %{$self->{_attrs}{collapse}};
797   };
798
799   if (@collapse) {
800     my ($c) = sort { length $a <=> length $b } @collapse;
801     my $target = $info;
802     foreach my $p (split(/\./, $c)) {
803       $target = $target->[1]->{$p} ||= [];
804     }
805     my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c);
806     my @co_key = @{$self->{_attrs}{collapse}{$c_prefix}};
807     my $tree = $self->_collapse_result($as, $row, $c_prefix);
808     my %co_check = map { ($_, $tree->[0]->{$_}); } @co_key;
809     my (@final, @raw);
810
811     while (
812       !(
813         grep {
814           !defined($tree->[0]->{$_}) || $co_check{$_} ne $tree->[0]->{$_}
815         } @co_key
816         )
817     ) {
818       push(@final, $tree);
819       last unless (@raw = $self->cursor->next);
820       $row = $self->{stashed_row} = \@raw;
821       $tree = $self->_collapse_result($as, $row, $c_prefix);
822     }
823     @$target = (@final ? @final : [ {}, {} ]);
824       # single empty result to indicate an empty prefetched has_many
825   }
826
827   #print "final info: " . Dumper($info);
828   return $info;
829 }
830
831 =head2 result_source
832
833 =over 4
834
835 =item Arguments: $result_source?
836
837 =item Return Value: $result_source
838
839 =back
840
841 An accessor for the primary ResultSource object from which this ResultSet
842 is derived.
843
844 =head2 result_class
845
846 =over 4
847
848 =item Arguments: $result_class?
849
850 =item Return Value: $result_class
851
852 =back
853
854 An accessor for the class to use when creating row objects. Defaults to 
855 C<< result_source->result_class >> - which in most cases is the name of the 
856 L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
857
858 =cut
859
860
861 =head2 count
862
863 =over 4
864
865 =item Arguments: $cond, \%attrs??
866
867 =item Return Value: $count
868
869 =back
870
871 Performs an SQL C<COUNT> with the same query as the resultset was built
872 with to find the number of elements. If passed arguments, does a search
873 on the resultset and counts the results of that.
874
875 Note: When using C<count> with C<group_by>, L<DBIX::Class> emulates C<GROUP BY>
876 using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
877 not support C<DISTINCT> with multiple columns. If you are using such a
878 database, you should only use columns from the main table in your C<group_by>
879 clause.
880
881 =cut
882
883 sub count {
884   my $self = shift;
885   return $self->search(@_)->count if @_ and defined $_[0];
886   return scalar @{ $self->get_cache } if $self->get_cache;
887   my $count = $self->_count;
888   return 0 unless $count;
889
890   $count -= $self->{attrs}{offset} if $self->{attrs}{offset};
891   $count = $self->{attrs}{rows} if
892     $self->{attrs}{rows} and $self->{attrs}{rows} < $count;
893   return $count;
894 }
895
896 sub _count { # Separated out so pager can get the full count
897   my $self = shift;
898   my $select = { count => '*' };
899
900   my $attrs = { %{$self->_resolved_attrs} };
901   if (my $group_by = delete $attrs->{group_by}) {
902     delete $attrs->{having};
903     my @distinct = (ref $group_by ?  @$group_by : ($group_by));
904     # todo: try CONCAT for multi-column pk
905     my @pk = $self->result_source->primary_columns;
906     if (@pk == 1) {
907       my $alias = $attrs->{alias};
908       foreach my $column (@distinct) {
909         if ($column =~ qr/^(?:\Q${alias}.\E)?$pk[0]$/) {
910           @distinct = ($column);
911           last;
912         }
913       }
914     }
915
916     $select = { count => { distinct => \@distinct } };
917   }
918
919   $attrs->{select} = $select;
920   $attrs->{as} = [qw/count/];
921
922   # offset, order by and page are not needed to count. record_filter is cdbi
923   delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
924
925   my $tmp_rs = (ref $self)->new($self->result_source, $attrs);
926   my ($count) = $tmp_rs->cursor->next;
927   return $count;
928 }
929
930 =head2 count_literal
931
932 =over 4
933
934 =item Arguments: $sql_fragment, @bind_values
935
936 =item Return Value: $count
937
938 =back
939
940 Counts the results in a literal query. Equivalent to calling L</search_literal>
941 with the passed arguments, then L</count>.
942
943 =cut
944
945 sub count_literal { shift->search_literal(@_)->count; }
946
947 =head2 all
948
949 =over 4
950
951 =item Arguments: none
952
953 =item Return Value: @objects
954
955 =back
956
957 Returns all elements in the resultset. Called implicitly if the resultset
958 is returned in list context.
959
960 =cut
961
962 sub all {
963   my ($self) = @_;
964   return @{ $self->get_cache } if $self->get_cache;
965
966   my @obj;
967
968   # TODO: don't call resolve here
969   if (keys %{$self->_resolved_attrs->{collapse}}) {
970 #  if ($self->{attrs}{prefetch}) {
971       # Using $self->cursor->all is really just an optimisation.
972       # If we're collapsing has_many prefetches it probably makes
973       # very little difference, and this is cleaner than hacking
974       # _construct_object to survive the approach
975     my @row = $self->cursor->next;
976     while (@row) {
977       push(@obj, $self->_construct_object(@row));
978       @row = (exists $self->{stashed_row}
979                ? @{delete $self->{stashed_row}}
980                : $self->cursor->next);
981     }
982   } else {
983     @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
984   }
985
986   $self->set_cache(\@obj) if $self->{attrs}{cache};
987   return @obj;
988 }
989
990 =head2 reset
991
992 =over 4
993
994 =item Arguments: none
995
996 =item Return Value: $self
997
998 =back
999
1000 Resets the resultset's cursor, so you can iterate through the elements again.
1001
1002 =cut
1003
1004 sub reset {
1005   my ($self) = @_;
1006   delete $self->{_attrs} if exists $self->{_attrs};
1007   $self->{all_cache_position} = 0;
1008   $self->cursor->reset;
1009   return $self;
1010 }
1011
1012 =head2 first
1013
1014 =over 4
1015
1016 =item Arguments: none
1017
1018 =item Return Value: $object?
1019
1020 =back
1021
1022 Resets the resultset and returns an object for the first result (if the
1023 resultset returns anything).
1024
1025 =cut
1026
1027 sub first {
1028   return $_[0]->reset->next;
1029 }
1030
1031 # _cond_for_update_delete
1032 #
1033 # update/delete require the condition to be modified to handle
1034 # the differing SQL syntax available.  This transforms the $self->{cond}
1035 # appropriately, returning the new condition.
1036
1037 sub _cond_for_update_delete {
1038   my ($self, $full_cond) = @_;
1039   my $cond = {};
1040
1041   $full_cond ||= $self->{cond};
1042   # No-op. No condition, we're updating/deleting everything
1043   return $cond unless ref $full_cond;
1044
1045   if (ref $full_cond eq 'ARRAY') {
1046     $cond = [
1047       map {
1048         my %hash;
1049         foreach my $key (keys %{$_}) {
1050           $key =~ /([^.]+)$/;
1051           $hash{$1} = $_->{$key};
1052         }
1053         \%hash;
1054       } @{$full_cond}
1055     ];
1056   }
1057   elsif (ref $full_cond eq 'HASH') {
1058     if ((keys %{$full_cond})[0] eq '-and') {
1059       $cond->{-and} = [];
1060
1061       my @cond = @{$full_cond->{-and}};
1062       for (my $i = 0; $i < @cond; $i++) {
1063         my $entry = $cond[$i];
1064
1065         my $hash;
1066         if (ref $entry eq 'HASH') {
1067           $hash = $self->_cond_for_update_delete($entry);
1068         }
1069         else {
1070           $entry =~ /([^.]+)$/;
1071           $hash->{$1} = $cond[++$i];
1072         }
1073
1074         push @{$cond->{-and}}, $hash;
1075       }
1076     }
1077     else {
1078       foreach my $key (keys %{$full_cond}) {
1079         $key =~ /([^.]+)$/;
1080         $cond->{$1} = $full_cond->{$key};
1081       }
1082     }
1083   }
1084   else {
1085     $self->throw_exception(
1086       "Can't update/delete on resultset with condition unless hash or array"
1087     );
1088   }
1089
1090   return $cond;
1091 }
1092
1093
1094 =head2 update
1095
1096 =over 4
1097
1098 =item Arguments: \%values
1099
1100 =item Return Value: $storage_rv
1101
1102 =back
1103
1104 Sets the specified columns in the resultset to the supplied values in a
1105 single query. Return value will be true if the update succeeded or false
1106 if no records were updated; exact type of success value is storage-dependent.
1107
1108 =cut
1109
1110 sub update {
1111   my ($self, $values) = @_;
1112   $self->throw_exception("Values for update must be a hash")
1113     unless ref $values eq 'HASH';
1114
1115   my $cond = $self->_cond_for_update_delete;
1116
1117   return $self->result_source->storage->update(
1118     $self->result_source->from, $values, $cond
1119   );
1120 }
1121
1122 =head2 update_all
1123
1124 =over 4
1125
1126 =item Arguments: \%values
1127
1128 =item Return Value: 1
1129
1130 =back
1131
1132 Fetches all objects and updates them one at a time. Note that C<update_all>
1133 will run DBIC cascade triggers, while L</update> will not.
1134
1135 =cut
1136
1137 sub update_all {
1138   my ($self, $values) = @_;
1139   $self->throw_exception("Values for update must be a hash")
1140     unless ref $values eq 'HASH';
1141   foreach my $obj ($self->all) {
1142     $obj->set_columns($values)->update;
1143   }
1144   return 1;
1145 }
1146
1147 =head2 delete
1148
1149 =over 4
1150
1151 =item Arguments: none
1152
1153 =item Return Value: 1
1154
1155 =back
1156
1157 Deletes the contents of the resultset from its result source. Note that this
1158 will not run DBIC cascade triggers. See L</delete_all> if you need triggers
1159 to run. See also L<DBIx::Class::Row/delete>.
1160
1161 =cut
1162
1163 sub delete {
1164   my ($self) = @_;
1165
1166   my $cond = $self->_cond_for_update_delete;
1167
1168   $self->result_source->storage->delete($self->result_source->from, $cond);
1169   return 1;
1170 }
1171
1172 =head2 delete_all
1173
1174 =over 4
1175
1176 =item Arguments: none
1177
1178 =item Return Value: 1
1179
1180 =back
1181
1182 Fetches all objects and deletes them one at a time. Note that C<delete_all>
1183 will run DBIC cascade triggers, while L</delete> will not.
1184
1185 =cut
1186
1187 sub delete_all {
1188   my ($self) = @_;
1189   $_->delete for $self->all;
1190   return 1;
1191 }
1192
1193 =head2 pager
1194
1195 =over 4
1196
1197 =item Arguments: none
1198
1199 =item Return Value: $pager
1200
1201 =back
1202
1203 Return Value a L<Data::Page> object for the current resultset. Only makes
1204 sense for queries with a C<page> attribute.
1205
1206 =cut
1207
1208 sub pager {
1209   my ($self) = @_;
1210   my $attrs = $self->{attrs};
1211   $self->throw_exception("Can't create pager for non-paged rs")
1212     unless $self->{attrs}{page};
1213   $attrs->{rows} ||= 10;
1214   return $self->{pager} ||= Data::Page->new(
1215     $self->_count, $attrs->{rows}, $self->{attrs}{page});
1216 }
1217
1218 =head2 page
1219
1220 =over 4
1221
1222 =item Arguments: $page_number
1223
1224 =item Return Value: $rs
1225
1226 =back
1227
1228 Returns a resultset for the $page_number page of the resultset on which page
1229 is called, where each page contains a number of rows equal to the 'rows'
1230 attribute set on the resultset (10 by default).
1231
1232 =cut
1233
1234 sub page {
1235   my ($self, $page) = @_;
1236   return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
1237 }
1238
1239 =head2 new_result
1240
1241 =over 4
1242
1243 =item Arguments: \%vals
1244
1245 =item Return Value: $object
1246
1247 =back
1248
1249 Creates an object in the resultset's result class and returns it.
1250
1251 =cut
1252
1253 sub new_result {
1254   my ($self, $values) = @_;
1255   $self->throw_exception( "new_result needs a hash" )
1256     unless (ref $values eq 'HASH');
1257   $self->throw_exception(
1258     "Can't abstract implicit construct, condition not a hash"
1259   ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
1260
1261   my $alias = $self->{attrs}{alias};
1262   my $collapsed_cond = $self->{cond} ? $self->_collapse_cond($self->{cond}) : {};
1263   my %new = (
1264     %{ $self->_remove_alias($values, $alias) },
1265     %{ $self->_remove_alias($collapsed_cond, $alias) },
1266     -result_source => $self->result_source,
1267   );
1268
1269   my $obj = $self->result_class->new(\%new);
1270   return $obj;
1271 }
1272
1273 # _collapse_cond
1274 #
1275 # Recursively collapse the condition.
1276
1277 sub _collapse_cond {
1278   my ($self, $cond, $collapsed) = @_;
1279
1280   $collapsed ||= {};
1281
1282   if (ref $cond eq 'ARRAY') {
1283     foreach my $subcond (@$cond) {
1284       next unless ref $subcond;  # -or
1285 #      warn "ARRAY: " . Dumper $subcond;
1286       $collapsed = $self->_collapse_cond($subcond, $collapsed);
1287     }
1288   }
1289   elsif (ref $cond eq 'HASH') {
1290     if (keys %$cond and (keys %$cond)[0] eq '-and') {
1291       foreach my $subcond (@{$cond->{-and}}) {
1292 #        warn "HASH: " . Dumper $subcond;
1293         $collapsed = $self->_collapse_cond($subcond, $collapsed);
1294       }
1295     }
1296     else {
1297 #      warn "LEAF: " . Dumper $cond;
1298       foreach my $col (keys %$cond) {
1299         my $value = $cond->{$col};
1300         $collapsed->{$col} = $value;
1301       }
1302     }
1303   }
1304
1305   return $collapsed;
1306 }
1307
1308 # _remove_alias
1309 #
1310 # Remove the specified alias from the specified query hash. A copy is made so
1311 # the original query is not modified.
1312
1313 sub _remove_alias {
1314   my ($self, $query, $alias) = @_;
1315
1316   my %orig = %{ $query || {} };
1317   my %unaliased;
1318
1319   foreach my $key (keys %orig) {
1320     if ($key !~ /\./) {
1321       $unaliased{$key} = $orig{$key};
1322       next;
1323     }
1324     $unaliased{$1} = $orig{$key}
1325       if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
1326   }
1327
1328   return \%unaliased;
1329 }
1330
1331 =head2 find_or_new
1332
1333 =over 4
1334
1335 =item Arguments: \%vals, \%attrs?
1336
1337 =item Return Value: $object
1338
1339 =back
1340
1341 Find an existing record from this resultset. If none exists, instantiate a new
1342 result object and return it. The object will not be saved into your storage
1343 until you call L<DBIx::Class::Row/insert> on it.
1344
1345 If you want objects to be saved immediately, use L</find_or_create> instead.
1346
1347 =cut
1348
1349 sub find_or_new {
1350   my $self     = shift;
1351   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1352   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
1353   my $exists   = $self->find($hash, $attrs);
1354   return defined $exists ? $exists : $self->new_result($hash);
1355 }
1356
1357 =head2 create
1358
1359 =over 4
1360
1361 =item Arguments: \%vals
1362
1363 =item Return Value: $object
1364
1365 =back
1366
1367 Inserts a record into the resultset and returns the object representing it.
1368
1369 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
1370
1371 =cut
1372
1373 sub create {
1374   my ($self, $attrs) = @_;
1375   $self->throw_exception( "create needs a hashref" )
1376     unless ref $attrs eq 'HASH';
1377   return $self->new_result($attrs)->insert;
1378 }
1379
1380 =head2 find_or_create
1381
1382 =over 4
1383
1384 =item Arguments: \%vals, \%attrs?
1385
1386 =item Return Value: $object
1387
1388 =back
1389
1390   $class->find_or_create({ key => $val, ... });
1391
1392 Tries to find a record based on its primary key or unique constraint; if none
1393 is found, creates one and returns that instead.
1394
1395   my $cd = $schema->resultset('CD')->find_or_create({
1396     cdid   => 5,
1397     artist => 'Massive Attack',
1398     title  => 'Mezzanine',
1399     year   => 2005,
1400   });
1401
1402 Also takes an optional C<key> attribute, to search by a specific key or unique
1403 constraint. For example:
1404
1405   my $cd = $schema->resultset('CD')->find_or_create(
1406     {
1407       artist => 'Massive Attack',
1408       title  => 'Mezzanine',
1409     },
1410     { key => 'cd_artist_title' }
1411   );
1412
1413 See also L</find> and L</update_or_create>. For information on how to declare
1414 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
1415
1416 =cut
1417
1418 sub find_or_create {
1419   my $self     = shift;
1420   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1421   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
1422   my $exists   = $self->find($hash, $attrs);
1423   return defined $exists ? $exists : $self->create($hash);
1424 }
1425
1426 =head2 update_or_create
1427
1428 =over 4
1429
1430 =item Arguments: \%col_values, { key => $unique_constraint }?
1431
1432 =item Return Value: $object
1433
1434 =back
1435
1436   $class->update_or_create({ col => $val, ... });
1437
1438 First, searches for an existing row matching one of the unique constraints
1439 (including the primary key) on the source of this resultset. If a row is
1440 found, updates it with the other given column values. Otherwise, creates a new
1441 row.
1442
1443 Takes an optional C<key> attribute to search on a specific unique constraint.
1444 For example:
1445
1446   # In your application
1447   my $cd = $schema->resultset('CD')->update_or_create(
1448     {
1449       artist => 'Massive Attack',
1450       title  => 'Mezzanine',
1451       year   => 1998,
1452     },
1453     { key => 'cd_artist_title' }
1454   );
1455
1456 If no C<key> is specified, it searches on all unique constraints defined on the
1457 source, including the primary key.
1458
1459 If the C<key> is specified as C<primary>, it searches only on the primary key.
1460
1461 See also L</find> and L</find_or_create>. For information on how to declare
1462 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
1463
1464 =cut
1465
1466 sub update_or_create {
1467   my $self = shift;
1468   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1469   my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
1470
1471   my $row = $self->find($cond, $attrs);
1472   if (defined $row) {
1473     $row->update($cond);
1474     return $row;
1475   }
1476
1477   return $self->create($cond);
1478 }
1479
1480 =head2 get_cache
1481
1482 =over 4
1483
1484 =item Arguments: none
1485
1486 =item Return Value: \@cache_objects?
1487
1488 =back
1489
1490 Gets the contents of the cache for the resultset, if the cache is set.
1491
1492 =cut
1493
1494 sub get_cache {
1495   shift->{all_cache};
1496 }
1497
1498 =head2 set_cache
1499
1500 =over 4
1501
1502 =item Arguments: \@cache_objects
1503
1504 =item Return Value: \@cache_objects
1505
1506 =back
1507
1508 Sets the contents of the cache for the resultset. Expects an arrayref
1509 of objects of the same class as those produced by the resultset. Note that
1510 if the cache is set the resultset will return the cached objects rather
1511 than re-querying the database even if the cache attr is not set.
1512
1513 =cut
1514
1515 sub set_cache {
1516   my ( $self, $data ) = @_;
1517   $self->throw_exception("set_cache requires an arrayref")
1518       if defined($data) && (ref $data ne 'ARRAY');
1519   $self->{all_cache} = $data;
1520 }
1521
1522 =head2 clear_cache
1523
1524 =over 4
1525
1526 =item Arguments: none
1527
1528 =item Return Value: []
1529
1530 =back
1531
1532 Clears the cache for the resultset.
1533
1534 =cut
1535
1536 sub clear_cache {
1537   shift->set_cache(undef);
1538 }
1539
1540 =head2 related_resultset
1541
1542 =over 4
1543
1544 =item Arguments: $relationship_name
1545
1546 =item Return Value: $resultset
1547
1548 =back
1549
1550 Returns a related resultset for the supplied relationship name.
1551
1552   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
1553
1554 =cut
1555
1556 sub related_resultset {
1557   my ($self, $rel) = @_;
1558
1559   $self->{related_resultsets} ||= {};
1560   return $self->{related_resultsets}{$rel} ||= do {
1561     my $rel_obj = $self->result_source->relationship_info($rel);
1562
1563     $self->throw_exception(
1564       "search_related: result source '" . $self->result_source->name .
1565         "' has no such relationship $rel")
1566       unless $rel_obj;
1567     
1568     my ($from,$seen) = $self->_resolve_from($rel);
1569
1570     my $join_count = $seen->{$rel};
1571     my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
1572
1573     $self->result_source->schema->resultset($rel_obj->{class})->search_rs(
1574       undef, {
1575         %{$self->{attrs}||{}},
1576         join => undef,
1577         prefetch => undef,
1578         select => undef,
1579         as => undef,
1580         alias => $alias,
1581         where => $self->{cond},
1582         seen_join => $seen,
1583         from => $from,
1584     });
1585   };
1586 }
1587
1588 sub _resolve_from {
1589   my ($self, $extra_join) = @_;
1590   my $source = $self->result_source;
1591   my $attrs = $self->{attrs};
1592   
1593   my $from = $attrs->{from}
1594     || [ { $attrs->{alias} => $source->from } ];
1595     
1596   my $seen = { %{$attrs->{seen_join}||{}} };
1597
1598   my $join = ($attrs->{join}
1599                ? [ $attrs->{join}, $extra_join ]
1600                : $extra_join);
1601   $from = [
1602     @$from,
1603     ($join ? $source->resolve_join($join, $attrs->{alias}, $seen) : ()),
1604   ];
1605
1606   return ($from,$seen);
1607 }
1608
1609 sub _resolved_attrs {
1610   my $self = shift;
1611   return $self->{_attrs} if $self->{_attrs};
1612
1613   my $attrs = { %{$self->{attrs}||{}} };
1614   my $source = $self->{result_source};
1615   my $alias = $attrs->{alias};
1616
1617   $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols};
1618   if ($attrs->{columns}) {
1619     delete $attrs->{as};
1620   } elsif (!$attrs->{select}) {
1621     $attrs->{columns} = [ $source->columns ];
1622   }
1623  
1624   $attrs->{select} = 
1625     ($attrs->{select}
1626       ? (ref $attrs->{select} eq 'ARRAY'
1627           ? [ @{$attrs->{select}} ]
1628           : [ $attrs->{select} ])
1629       : [ map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}} ]
1630     );
1631   $attrs->{as} =
1632     ($attrs->{as}
1633       ? (ref $attrs->{as} eq 'ARRAY'
1634           ? [ @{$attrs->{as}} ]
1635           : [ $attrs->{as} ])
1636       : [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}} ]
1637     );
1638   
1639   my $adds;
1640   if ($adds = delete $attrs->{include_columns}) {
1641     $adds = [$adds] unless ref $adds eq 'ARRAY';
1642     push(@{$attrs->{select}}, @$adds);
1643     push(@{$attrs->{as}}, map { m/([^.]+)$/; $1 } @$adds);
1644   }
1645   if ($adds = delete $attrs->{'+select'}) {
1646     $adds = [$adds] unless ref $adds eq 'ARRAY';
1647     push(@{$attrs->{select}},
1648            map { /\./ || ref $_ ? $_ : "${alias}.$_" } @$adds);
1649   }
1650   if (my $adds = delete $attrs->{'+as'}) {
1651     $adds = [$adds] unless ref $adds eq 'ARRAY';
1652     push(@{$attrs->{as}}, @$adds);
1653   }
1654
1655   $attrs->{from} ||= [ { 'me' => $source->from } ];
1656
1657   if (exists $attrs->{join} || exists $attrs->{prefetch}) {
1658     my $join = delete $attrs->{join} || {};
1659
1660     if (defined $attrs->{prefetch}) {
1661       $join = $self->_merge_attr(
1662         $join, $attrs->{prefetch}
1663       );
1664     }
1665
1666     $attrs->{from} =   # have to copy here to avoid corrupting the original
1667       [
1668         @{$attrs->{from}}, 
1669         $source->resolve_join($join, $alias, { %{$attrs->{seen_join}||{}} })
1670       ];
1671   }
1672
1673   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
1674   if ($attrs->{order_by}) {
1675     $attrs->{order_by} = (ref($attrs->{order_by}) eq 'ARRAY'
1676                            ? [ @{$attrs->{order_by}} ]
1677                            : [ $attrs->{order_by} ]);
1678   } else {
1679     $attrs->{order_by} = [];    
1680   }
1681
1682   my $collapse = $attrs->{collapse} || {};
1683   if (my $prefetch = delete $attrs->{prefetch}) {
1684     $prefetch = $self->_merge_attr({}, $prefetch);
1685     my @pre_order;
1686     my $seen = $attrs->{seen_join} || {};
1687     foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
1688       # bring joins back to level of current class
1689       my @prefetch = $source->resolve_prefetch(
1690         $p, $alias, $seen, \@pre_order, $collapse
1691       );
1692       push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
1693       push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
1694     }
1695     push(@{$attrs->{order_by}}, @pre_order);
1696   }
1697   $attrs->{collapse} = $collapse;
1698
1699   return $self->{_attrs} = $attrs;
1700 }
1701
1702 sub _merge_attr {
1703   my ($self, $a, $b) = @_;
1704   return $b unless defined($a);
1705   return $a unless defined($b);
1706   
1707   if (ref $b eq 'HASH' && ref $a eq 'HASH') {
1708     foreach my $key (keys %{$b}) {
1709       if (exists $a->{$key}) {
1710         $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key});
1711       } else {
1712         $a->{$key} = $b->{$key};
1713       }
1714     }
1715     return $a;
1716   } else {
1717     $a = [$a] unless ref $a eq 'ARRAY';
1718     $b = [$b] unless ref $b eq 'ARRAY';
1719
1720     my $hash = {};
1721     my @array;
1722     foreach my $x ($a, $b) {
1723       foreach my $element (@{$x}) {
1724         if (ref $element eq 'HASH') {
1725           $hash = $self->_merge_attr($hash, $element);
1726         } elsif (ref $element eq 'ARRAY') {
1727           push(@array, @{$element});
1728         } else {
1729           push(@array, $element) unless $b == $x
1730             && grep { $_ eq $element } @array;
1731         }
1732       }
1733     }
1734     
1735     @array = grep { !exists $hash->{$_} } @array;
1736
1737     return keys %{$hash}
1738       ? ( scalar(@array)
1739             ? [$hash, @array]
1740             : $hash
1741         )
1742       : \@array;
1743   }
1744 }
1745
1746 =head2 throw_exception
1747
1748 See L<DBIx::Class::Schema/throw_exception> for details.
1749
1750 =cut
1751
1752 sub throw_exception {
1753   my $self=shift;
1754   $self->result_source->schema->throw_exception(@_);
1755 }
1756
1757 # XXX: FIXME: Attributes docs need clearing up
1758
1759 =head1 ATTRIBUTES
1760
1761 The resultset takes various attributes that modify its behavior. Here's an
1762 overview of them:
1763
1764 =head2 order_by
1765
1766 =over 4
1767
1768 =item Value: ($order_by | \@order_by)
1769
1770 =back
1771
1772 Which column(s) to order the results by. This is currently passed
1773 through directly to SQL, so you can give e.g. C<year DESC> for a
1774 descending order on the column `year'.
1775
1776 Please note that if you have quoting enabled (see
1777 L<DBIx::Class::Storage/quote_char>) you will need to do C<\'year DESC' > to
1778 specify an order. (The scalar ref causes it to be passed as raw sql to the DB,
1779 so you will need to manually quote things as appropriate.)
1780
1781 =head2 columns
1782
1783 =over 4
1784
1785 =item Value: \@columns
1786
1787 =back
1788
1789 Shortcut to request a particular set of columns to be retrieved.  Adds
1790 C<me.> onto the start of any column without a C<.> in it and sets C<select>
1791 from that, then auto-populates C<as> from C<select> as normal. (You may also
1792 use the C<cols> attribute, as in earlier versions of DBIC.)
1793
1794 =head2 include_columns
1795
1796 =over 4
1797
1798 =item Value: \@columns
1799
1800 =back
1801
1802 Shortcut to include additional columns in the returned results - for example
1803
1804   $schema->resultset('CD')->search(undef, {
1805     include_columns => ['artist.name'],
1806     join => ['artist']
1807   });
1808
1809 would return all CDs and include a 'name' column to the information
1810 passed to object inflation. Note that the 'artist' is the name of the
1811 column (or relationship) accessor, and 'name' is the name of the column
1812 accessor in the related table.
1813
1814 =head2 select
1815
1816 =over 4
1817
1818 =item Value: \@select_columns
1819
1820 =back
1821
1822 Indicates which columns should be selected from the storage. You can use
1823 column names, or in the case of RDBMS back ends, function or stored procedure
1824 names:
1825
1826   $rs = $schema->resultset('Employee')->search(undef, {
1827     select => [
1828       'name',
1829       { count => 'employeeid' },
1830       { sum => 'salary' }
1831     ]
1832   });
1833
1834 When you use function/stored procedure names and do not supply an C<as>
1835 attribute, the column names returned are storage-dependent. E.g. MySQL would
1836 return a column named C<count(employeeid)> in the above example.
1837
1838 =head2 +select
1839
1840 =over 4
1841
1842 Indicates additional columns to be selected from storage.  Works the same as
1843 L<select> but adds columns to the selection.
1844
1845 =back
1846
1847 =head2 +as
1848
1849 =over 4
1850
1851 Indicates additional column names for those added via L<+select>.
1852
1853 =back
1854
1855 =head2 as
1856
1857 =over 4
1858
1859 =item Value: \@inflation_names
1860
1861 =back
1862
1863 Indicates column names for object inflation. That is, c< as >
1864 indicates the name that the column can be accessed as via the
1865 C<get_column> method (or via the object accessor, B<if one already
1866 exists>).  It has nothing to do with the SQL code C< SELECT foo AS bar
1867 >.
1868
1869 The C< as > attribute is used in conjunction with C<select>,
1870 usually when C<select> contains one or more function or stored
1871 procedure names:
1872
1873   $rs = $schema->resultset('Employee')->search(undef, {
1874     select => [
1875       'name',
1876       { count => 'employeeid' }
1877     ],
1878     as => ['name', 'employee_count'],
1879   });
1880
1881   my $employee = $rs->first(); # get the first Employee
1882
1883 If the object against which the search is performed already has an accessor
1884 matching a column name specified in C<as>, the value can be retrieved using
1885 the accessor as normal:
1886
1887   my $name = $employee->name();
1888
1889 If on the other hand an accessor does not exist in the object, you need to
1890 use C<get_column> instead:
1891
1892   my $employee_count = $employee->get_column('employee_count');
1893
1894 You can create your own accessors if required - see
1895 L<DBIx::Class::Manual::Cookbook> for details.
1896
1897 Please note: This will NOT insert an C<AS employee_count> into the SQL
1898 statement produced, it is used for internal access only. Thus
1899 attempting to use the accessor in an C<order_by> clause or similar
1900 will fail miserably.
1901
1902 To get around this limitation, you can supply literal SQL to your
1903 C<select> attibute that contains the C<AS alias> text, eg:
1904
1905   select => [\'myfield AS alias']
1906
1907 =head2 join
1908
1909 =over 4
1910
1911 =item Value: ($rel_name | \@rel_names | \%rel_names)
1912
1913 =back
1914
1915 Contains a list of relationships that should be joined for this query.  For
1916 example:
1917
1918   # Get CDs by Nine Inch Nails
1919   my $rs = $schema->resultset('CD')->search(
1920     { 'artist.name' => 'Nine Inch Nails' },
1921     { join => 'artist' }
1922   );
1923
1924 Can also contain a hash reference to refer to the other relation's relations.
1925 For example:
1926
1927   package MyApp::Schema::Track;
1928   use base qw/DBIx::Class/;
1929   __PACKAGE__->table('track');
1930   __PACKAGE__->add_columns(qw/trackid cd position title/);
1931   __PACKAGE__->set_primary_key('trackid');
1932   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
1933   1;
1934
1935   # In your application
1936   my $rs = $schema->resultset('Artist')->search(
1937     { 'track.title' => 'Teardrop' },
1938     {
1939       join     => { cd => 'track' },
1940       order_by => 'artist.name',
1941     }
1942   );
1943
1944 You need to use the relationship (not the table) name in  conditions, 
1945 because they are aliased as such. The current table is aliased as "me", so 
1946 you need to use me.column_name in order to avoid ambiguity. For example:
1947
1948   # Get CDs from 1984 with a 'Foo' track 
1949   my $rs = $schema->resultset('CD')->search(
1950     { 
1951       'me.year' => 1984,
1952       'tracks.name' => 'Foo'
1953     },
1954     { join => 'tracks' }
1955   );
1956   
1957 If the same join is supplied twice, it will be aliased to <rel>_2 (and
1958 similarly for a third time). For e.g.
1959
1960   my $rs = $schema->resultset('Artist')->search({
1961     'cds.title'   => 'Down to Earth',
1962     'cds_2.title' => 'Popular',
1963   }, {
1964     join => [ qw/cds cds/ ],
1965   });
1966
1967 will return a set of all artists that have both a cd with title 'Down
1968 to Earth' and a cd with title 'Popular'.
1969
1970 If you want to fetch related objects from other tables as well, see C<prefetch>
1971 below.
1972
1973 =head2 prefetch
1974
1975 =over 4
1976
1977 =item Value: ($rel_name | \@rel_names | \%rel_names)
1978
1979 =back
1980
1981 Contains one or more relationships that should be fetched along with the main
1982 query (when they are accessed afterwards they will have already been
1983 "prefetched").  This is useful for when you know you will need the related
1984 objects, because it saves at least one query:
1985
1986   my $rs = $schema->resultset('Tag')->search(
1987     undef,
1988     {
1989       prefetch => {
1990         cd => 'artist'
1991       }
1992     }
1993   );
1994
1995 The initial search results in SQL like the following:
1996
1997   SELECT tag.*, cd.*, artist.* FROM tag
1998   JOIN cd ON tag.cd = cd.cdid
1999   JOIN artist ON cd.artist = artist.artistid
2000
2001 L<DBIx::Class> has no need to go back to the database when we access the
2002 C<cd> or C<artist> relationships, which saves us two SQL statements in this
2003 case.
2004
2005 Simple prefetches will be joined automatically, so there is no need
2006 for a C<join> attribute in the above search. If you're prefetching to
2007 depth (e.g. { cd => { artist => 'label' } or similar), you'll need to
2008 specify the join as well.
2009
2010 C<prefetch> can be used with the following relationship types: C<belongs_to>,
2011 C<has_one> (or if you're using C<add_relationship>, any relationship declared
2012 with an accessor type of 'single' or 'filter').
2013
2014 =head2 page
2015
2016 =over 4
2017
2018 =item Value: $page
2019
2020 =back
2021
2022 Makes the resultset paged and specifies the page to retrieve. Effectively
2023 identical to creating a non-pages resultset and then calling ->page($page)
2024 on it.
2025
2026 If L<rows> attribute is not specified it defualts to 10 rows per page.
2027
2028 =head2 rows
2029
2030 =over 4
2031
2032 =item Value: $rows
2033
2034 =back
2035
2036 Specifes the maximum number of rows for direct retrieval or the number of
2037 rows per page if the page attribute or method is used.
2038
2039 =head2 offset
2040
2041 =over 4
2042
2043 =item Value: $offset
2044
2045 =back
2046
2047 Specifies the (zero-based) row number for the  first row to be returned, or the
2048 of the first row of the first page if paging is used.
2049
2050 =head2 group_by
2051
2052 =over 4
2053
2054 =item Value: \@columns
2055
2056 =back
2057
2058 A arrayref of columns to group by. Can include columns of joined tables.
2059
2060   group_by => [qw/ column1 column2 ... /]
2061
2062 =head2 having
2063
2064 =over 4
2065
2066 =item Value: $condition
2067
2068 =back
2069
2070 HAVING is a select statement attribute that is applied between GROUP BY and
2071 ORDER BY. It is applied to the after the grouping calculations have been
2072 done.
2073
2074   having => { 'count(employee)' => { '>=', 100 } }
2075
2076 =head2 distinct
2077
2078 =over 4
2079
2080 =item Value: (0 | 1)
2081
2082 =back
2083
2084 Set to 1 to group by all columns.
2085
2086 =head2 where
2087
2088 =over 4
2089
2090 Adds to the WHERE clause.
2091
2092   # only return rows WHERE deleted IS NULL for all searches
2093   __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
2094
2095 Can be overridden by passing C<{ where => undef }> as an attribute
2096 to a resulset.
2097
2098 =back
2099
2100 =head2 cache
2101
2102 Set to 1 to cache search results. This prevents extra SQL queries if you
2103 revisit rows in your ResultSet:
2104
2105   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
2106
2107   while( my $artist = $resultset->next ) {
2108     ... do stuff ...
2109   }
2110
2111   $rs->first; # without cache, this would issue a query
2112
2113 By default, searches are not cached.
2114
2115 For more examples of using these attributes, see
2116 L<DBIx::Class::Manual::Cookbook>.
2117
2118 =head2 from
2119
2120 =over 4
2121
2122 =item Value: \@from_clause
2123
2124 =back
2125
2126 The C<from> attribute gives you manual control over the C<FROM> clause of SQL
2127 statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
2128 clauses.
2129
2130 NOTE: Use this on your own risk.  This allows you to shoot off your foot!
2131
2132 C<join> will usually do what you need and it is strongly recommended that you
2133 avoid using C<from> unless you cannot achieve the desired result using C<join>.
2134 And we really do mean "cannot", not just tried and failed. Attempting to use
2135 this because you're having problems with C<join> is like trying to use x86
2136 ASM because you've got a syntax error in your C. Trust us on this.
2137
2138 Now, if you're still really, really sure you need to use this (and if you're
2139 not 100% sure, ask the mailing list first), here's an explanation of how this
2140 works.
2141
2142 The syntax is as follows -
2143
2144   [
2145     { <alias1> => <table1> },
2146     [
2147       { <alias2> => <table2>, -join_type => 'inner|left|right' },
2148       [], # nested JOIN (optional)
2149       { <table1.column1> => <table2.column2>, ... (more conditions) },
2150     ],
2151     # More of the above [ ] may follow for additional joins
2152   ]
2153
2154   <table1> <alias1>
2155   JOIN
2156     <table2> <alias2>
2157     [JOIN ...]
2158   ON <table1.column1> = <table2.column2>
2159   <more joins may follow>
2160
2161 An easy way to follow the examples below is to remember the following:
2162
2163     Anything inside "[]" is a JOIN
2164     Anything inside "{}" is a condition for the enclosing JOIN
2165
2166 The following examples utilize a "person" table in a family tree application.
2167 In order to express parent->child relationships, this table is self-joined:
2168
2169     # Person->belongs_to('father' => 'Person');
2170     # Person->belongs_to('mother' => 'Person');
2171
2172 C<from> can be used to nest joins. Here we return all children with a father,
2173 then search against all mothers of those children:
2174
2175   $rs = $schema->resultset('Person')->search(
2176       undef,
2177       {
2178           alias => 'mother', # alias columns in accordance with "from"
2179           from => [
2180               { mother => 'person' },
2181               [
2182                   [
2183                       { child => 'person' },
2184                       [
2185                           { father => 'person' },
2186                           { 'father.person_id' => 'child.father_id' }
2187                       ]
2188                   ],
2189                   { 'mother.person_id' => 'child.mother_id' }
2190               ],
2191           ]
2192       },
2193   );
2194
2195   # Equivalent SQL:
2196   # SELECT mother.* FROM person mother
2197   # JOIN (
2198   #   person child
2199   #   JOIN person father
2200   #   ON ( father.person_id = child.father_id )
2201   # )
2202   # ON ( mother.person_id = child.mother_id )
2203
2204 The type of any join can be controlled manually. To search against only people
2205 with a father in the person table, we could explicitly use C<INNER JOIN>:
2206
2207     $rs = $schema->resultset('Person')->search(
2208         undef,
2209         {
2210             alias => 'child', # alias columns in accordance with "from"
2211             from => [
2212                 { child => 'person' },
2213                 [
2214                     { father => 'person', -join_type => 'inner' },
2215                     { 'father.id' => 'child.father_id' }
2216                 ],
2217             ]
2218         },
2219     );
2220
2221     # Equivalent SQL:
2222     # SELECT child.* FROM person child
2223     # INNER JOIN person father ON child.father_id = father.id
2224
2225 =cut
2226
2227 1;