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