Fix update/delete on prefetching resultsets
[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'   => "_bool",
8         fallback => 1;
9 use Carp::Clan qw/^DBIx::Class/;
10 use DBIx::Class::Exception;
11 use Data::Page;
12 use Storable;
13 use DBIx::Class::ResultSetColumn;
14 use DBIx::Class::ResultSourceHandle;
15 use List::Util ();
16 use Scalar::Util ();
17 use base qw/DBIx::Class/;
18
19 __PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/);
20
21 =head1 NAME
22
23 DBIx::Class::ResultSet - Represents a query used for fetching a set of results.
24
25 =head1 SYNOPSIS
26
27   my $users_rs   = $schema->resultset('User');
28   while( $user = $users_rs->next) {
29     print $user->username;
30   }
31
32   my $registered_users_rs   = $schema->resultset('User')->search({ registered => 1 });
33   my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all();
34
35 =head1 DESCRIPTION
36
37 A ResultSet is an object which stores a set of conditions representing
38 a query. It is the backbone of DBIx::Class (i.e. the really
39 important/useful bit).
40
41 No SQL is executed on the database when a ResultSet is created, it
42 just stores all the conditions needed to create the query.
43
44 A basic ResultSet representing the data of an entire table is returned
45 by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
46 L<Source|DBIx::Class::Manual::Glossary/Source> name.
47
48   my $users_rs = $schema->resultset('User');
49
50 A new ResultSet is returned from calling L</search> on an existing
51 ResultSet. The new one will contain all the conditions of the
52 original, plus any new conditions added in the C<search> call.
53
54 A ResultSet also incorporates an implicit iterator. L</next> and L</reset>
55 can be used to walk through all the L<DBIx::Class::Row>s the ResultSet
56 represents.
57
58 The query that the ResultSet represents is B<only> executed against
59 the database when these methods are called:
60 L</find>, L</next>, L</all>, L</first>, L</single>, L</count>.
61
62 If a resultset is used in a numeric context it returns the L</count>.
63 However, if it is used in a boolean context it is B<always> true.  So if
64 you want to check if a resultset has any results, you must use C<if $rs
65 != 0>.
66
67 =head1 EXAMPLES
68
69 =head2 Chaining resultsets
70
71 Let's say you've got a query that needs to be run to return some data
72 to the user. But, you have an authorization system in place that
73 prevents certain users from seeing certain information. So, you want
74 to construct the basic query in one method, but add constraints to it in
75 another.
76
77   sub get_data {
78     my $self = shift;
79     my $request = $self->get_request; # Get a request object somehow.
80     my $schema = $self->get_schema;   # Get the DBIC schema object somehow.
81
82     my $cd_rs = $schema->resultset('CD')->search({
83       title => $request->param('title'),
84       year => $request->param('year'),
85     });
86
87     $self->apply_security_policy( $cd_rs );
88
89     return $cd_rs->all();
90   }
91
92   sub apply_security_policy {
93     my $self = shift;
94     my ($rs) = @_;
95
96     return $rs->search({
97       subversive => 0,
98     });
99   }
100
101 =head3 Resolving conditions and attributes
102
103 When a resultset is chained from another resultset, conditions and
104 attributes with the same keys need resolving.
105
106 L</join>, L</prefetch>, L</+select>, L</+as> attributes are merged
107 into the existing ones from the original resultset.
108
109 The L</where> and L</having> attributes, and any search conditions, are
110 merged with an SQL C<AND> to the existing condition from the original
111 resultset.
112
113 All other attributes are overridden by any new ones supplied in the
114 search attributes.
115
116 =head2 Multiple queries
117
118 Since a resultset just defines a query, you can do all sorts of
119 things with it with the same object.
120
121   # Don't hit the DB yet.
122   my $cd_rs = $schema->resultset('CD')->search({
123     title => 'something',
124     year => 2009,
125   });
126
127   # Each of these hits the DB individually.
128   my $count = $cd_rs->count;
129   my $most_recent = $cd_rs->get_column('date_released')->max();
130   my @records = $cd_rs->all;
131
132 And it's not just limited to SELECT statements.
133
134   $cd_rs->delete();
135
136 This is even cooler:
137
138   $cd_rs->create({ artist => 'Fred' });
139
140 Which is the same as:
141
142   $schema->resultset('CD')->create({
143     title => 'something',
144     year => 2009,
145     artist => 'Fred'
146   });
147
148 See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
149
150 =head1 METHODS
151
152 =head2 new
153
154 =over 4
155
156 =item Arguments: $source, \%$attrs
157
158 =item Return Value: $rs
159
160 =back
161
162 The resultset constructor. Takes a source object (usually a
163 L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
164 L</ATTRIBUTES> below).  Does not perform any queries -- these are
165 executed as needed by the other methods.
166
167 Generally you won't need to construct a resultset manually.  You'll
168 automatically get one from e.g. a L</search> called in scalar context:
169
170   my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
171
172 IMPORTANT: If called on an object, proxies to new_result instead so
173
174   my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
175
176 will return a CD object, not a ResultSet.
177
178 =cut
179
180 sub new {
181   my $class = shift;
182   return $class->new_result(@_) if ref $class;
183
184   my ($source, $attrs) = @_;
185   $source = $source->handle
186     unless $source->isa('DBIx::Class::ResultSourceHandle');
187   $attrs = { %{$attrs||{}} };
188
189   if ($attrs->{page}) {
190     $attrs->{rows} ||= 10;
191   }
192
193   $attrs->{alias} ||= 'me';
194
195   # Creation of {} and bless separated to mitigate RH perl bug
196   # see https://bugzilla.redhat.com/show_bug.cgi?id=196836
197   my $self = {
198     _source_handle => $source,
199     cond => $attrs->{where},
200     pager => undef,
201     attrs => $attrs
202   };
203
204   bless $self, $class;
205
206   $self->result_class(
207     $attrs->{result_class} || $source->resolve->result_class
208   );
209
210   return $self;
211 }
212
213 =head2 search
214
215 =over 4
216
217 =item Arguments: $cond, \%attrs?
218
219 =item Return Value: $resultset (scalar context), @row_objs (list context)
220
221 =back
222
223   my @cds    = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
224   my $new_rs = $cd_rs->search({ year => 2005 });
225
226   my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
227                  # year = 2005 OR year = 2004
228
229 If you need to pass in additional attributes but no additional condition,
230 call it as C<search(undef, \%attrs)>.
231
232   # "SELECT name, artistid FROM $artist_table"
233   my @all_artists = $schema->resultset('Artist')->search(undef, {
234     columns => [qw/name artistid/],
235   });
236
237 For a list of attributes that can be passed to C<search>, see
238 L</ATTRIBUTES>. For more examples of using this function, see
239 L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
240 documentation for the first argument, see L<SQL::Abstract>.
241
242 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
243
244 =cut
245
246 sub search {
247   my $self = shift;
248   my $rs = $self->search_rs( @_ );
249   return (wantarray ? $rs->all : $rs);
250 }
251
252 =head2 search_rs
253
254 =over 4
255
256 =item Arguments: $cond, \%attrs?
257
258 =item Return Value: $resultset
259
260 =back
261
262 This method does the same exact thing as search() except it will
263 always return a resultset, even in list context.
264
265 =cut
266
267 sub search_rs {
268   my $self = shift;
269
270   # Special-case handling for (undef, undef).
271   if ( @_ == 2 && !defined $_[1] && !defined $_[0] ) {
272     pop(@_); pop(@_);
273   }
274
275   my $attrs = {};
276   $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
277   my $our_attrs = { %{$self->{attrs}} };
278   my $having = delete $our_attrs->{having};
279   my $where = delete $our_attrs->{where};
280
281   my $rows;
282
283   my %safe = (alias => 1, cache => 1);
284
285   unless (
286     (@_ && defined($_[0])) # @_ == () or (undef)
287     ||
288     (keys %$attrs # empty attrs or only 'safe' attrs
289     && List::Util::first { !$safe{$_} } keys %$attrs)
290   ) {
291     # no search, effectively just a clone
292     $rows = $self->get_cache;
293   }
294
295   # reset the selector list
296   if (List::Util::first { exists $attrs->{$_} } qw{columns select as}) {
297      delete @{$our_attrs}{qw{select as columns +select +as +columns include_columns}};
298   }
299
300   my $new_attrs = { %{$our_attrs}, %{$attrs} };
301
302   # merge new attrs into inherited
303   foreach my $key (qw/join prefetch +select +as +columns include_columns bind/) {
304     next unless exists $attrs->{$key};
305     $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
306   }
307
308   my $cond = (@_
309     ? (
310         (@_ == 1 || ref $_[0] eq "HASH")
311           ? (
312               (ref $_[0] eq 'HASH')
313                 ? (
314                     (keys %{ $_[0] }  > 0)
315                       ? shift
316                       : undef
317                    )
318                 :  shift
319              )
320           : (
321               (@_ % 2)
322                 ? $self->throw_exception("Odd number of arguments to search")
323                 : {@_}
324              )
325       )
326     : undef
327   );
328
329   if (defined $where) {
330     $new_attrs->{where} = (
331       defined $new_attrs->{where}
332         ? { '-and' => [
333               map {
334                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
335               } $where, $new_attrs->{where}
336             ]
337           }
338         : $where);
339   }
340
341   if (defined $cond) {
342     $new_attrs->{where} = (
343       defined $new_attrs->{where}
344         ? { '-and' => [
345               map {
346                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
347               } $cond, $new_attrs->{where}
348             ]
349           }
350         : $cond);
351   }
352
353   if (defined $having) {
354     $new_attrs->{having} = (
355       defined $new_attrs->{having}
356         ? { '-and' => [
357               map {
358                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
359               } $having, $new_attrs->{having}
360             ]
361           }
362         : $having);
363   }
364
365   my $rs = (ref $self)->new($self->result_source, $new_attrs);
366
367   $rs->set_cache($rows) if ($rows);
368
369   return $rs;
370 }
371
372 =head2 search_literal
373
374 =over 4
375
376 =item Arguments: $sql_fragment, @bind_values
377
378 =item Return Value: $resultset (scalar context), @row_objs (list context)
379
380 =back
381
382   my @cds   = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
383   my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
384
385 Pass a literal chunk of SQL to be added to the conditional part of the
386 resultset query.
387
388 CAVEAT: C<search_literal> is provided for Class::DBI compatibility and should
389 only be used in that context. C<search_literal> is a convenience method.
390 It is equivalent to calling $schema->search(\[]), but if you want to ensure
391 columns are bound correctly, use C<search>.
392
393 Example of how to use C<search> instead of C<search_literal>
394
395   my @cds = $cd_rs->search_literal('cdid = ? AND (artist = ? OR artist = ?)', (2, 1, 2));
396   my @cds = $cd_rs->search(\[ 'cdid = ? AND (artist = ? OR artist = ?)', [ 'cdid', 2 ], [ 'artist', 1 ], [ 'artist', 2 ] ]);
397
398
399 See L<DBIx::Class::Manual::Cookbook/Searching> and
400 L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
401 require C<search_literal>.
402
403 =cut
404
405 sub search_literal {
406   my ($self, $sql, @bind) = @_;
407   my $attr;
408   if ( @bind && ref($bind[-1]) eq 'HASH' ) {
409     $attr = pop @bind;
410   }
411   return $self->search(\[ $sql, map [ __DUMMY__ => $_ ], @bind ], ($attr || () ));
412 }
413
414 =head2 find
415
416 =over 4
417
418 =item Arguments: @values | \%cols, \%attrs?
419
420 =item Return Value: $row_object | undef
421
422 =back
423
424 Finds a row based on its primary key or unique constraint. For example, to find
425 a row by its primary key:
426
427   my $cd = $schema->resultset('CD')->find(5);
428
429 You can also find a row by a specific unique constraint using the C<key>
430 attribute. For example:
431
432   my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', {
433     key => 'cd_artist_title'
434   });
435
436 Additionally, you can specify the columns explicitly by name:
437
438   my $cd = $schema->resultset('CD')->find(
439     {
440       artist => 'Massive Attack',
441       title  => 'Mezzanine',
442     },
443     { key => 'cd_artist_title' }
444   );
445
446 If the C<key> is specified as C<primary>, it searches only on the primary key.
447
448 If no C<key> is specified, it searches on all unique constraints defined on the
449 source for which column data is provided, including the primary key.
450
451 If your table does not have a primary key, you B<must> provide a value for the
452 C<key> attribute matching one of the unique constraints on the source.
453
454 In addition to C<key>, L</find> recognizes and applies standard
455 L<resultset attributes|/ATTRIBUTES> in the same way as L</search> does.
456
457 Note: If your query does not return only one row, a warning is generated:
458
459   Query returned more than one row
460
461 See also L</find_or_create> and L</update_or_create>. For information on how to
462 declare unique constraints, see
463 L<DBIx::Class::ResultSource/add_unique_constraint>.
464
465 =cut
466
467 sub find {
468   my $self = shift;
469   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
470
471   # Default to the primary key, but allow a specific key
472   my @cols = exists $attrs->{key}
473     ? $self->result_source->unique_constraint_columns($attrs->{key})
474     : $self->result_source->primary_columns;
475   $self->throw_exception(
476     "Can't find unless a primary key is defined or unique constraint is specified"
477   ) unless @cols;
478
479   # Parse out a hashref from input
480   my $input_query;
481   if (ref $_[0] eq 'HASH') {
482     $input_query = { %{$_[0]} };
483   }
484   elsif (@_ == @cols) {
485     $input_query = {};
486     @{$input_query}{@cols} = @_;
487   }
488   else {
489     # Compatibility: Allow e.g. find(id => $value)
490     carp "Find by key => value deprecated; please use a hashref instead";
491     $input_query = {@_};
492   }
493
494   my (%related, $info);
495
496   KEY: foreach my $key (keys %$input_query) {
497     if (ref($input_query->{$key})
498         && ($info = $self->result_source->relationship_info($key))) {
499       my $val = delete $input_query->{$key};
500       next KEY if (ref($val) eq 'ARRAY'); # has_many for multi_create
501       my $rel_q = $self->result_source->_resolve_condition(
502                     $info->{cond}, $val, $key
503                   );
504       die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY';
505       @related{keys %$rel_q} = values %$rel_q;
506     }
507   }
508   if (my @keys = keys %related) {
509     @{$input_query}{@keys} = values %related;
510   }
511
512
513   # Build the final query: Default to the disjunction of the unique queries,
514   # but allow the input query in case the ResultSet defines the query or the
515   # user is abusing find
516   my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
517   my $query;
518   if (exists $attrs->{key}) {
519     my @unique_cols = $self->result_source->unique_constraint_columns($attrs->{key});
520     my $unique_query = $self->_build_unique_query($input_query, \@unique_cols);
521     $query = $self->_add_alias($unique_query, $alias);
522   }
523   elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') {
524     # This means that we got here after a merger of relationship conditions
525     # in ::Relationship::Base::search_related (the row method), and furthermore
526     # the relationship is of the 'single' type. This means that the condition
527     # provided by the relationship (already attached to $self) is sufficient,
528     # as there can be only one row in the database that would satisfy the
529     # relationship
530   }
531   else {
532     my @unique_queries = $self->_unique_queries($input_query, $attrs);
533     $query = @unique_queries
534       ? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
535       : $self->_add_alias($input_query, $alias);
536   }
537
538   # Run the query, passing the result_class since it should propagate for find
539   my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs});
540   if (keys %{$rs->_resolved_attrs->{collapse}}) {
541     my $row = $rs->next;
542     carp "Query returned more than one row" if $rs->next;
543     return $row;
544   }
545   else {
546     return $rs->single;
547   }
548 }
549
550 # _add_alias
551 #
552 # Add the specified alias to the specified query hash. A copy is made so the
553 # original query is not modified.
554
555 sub _add_alias {
556   my ($self, $query, $alias) = @_;
557
558   my %aliased = %$query;
559   foreach my $col (grep { ! m/\./ } keys %aliased) {
560     $aliased{"$alias.$col"} = delete $aliased{$col};
561   }
562
563   return \%aliased;
564 }
565
566 # _unique_queries
567 #
568 # Build a list of queries which satisfy unique constraints.
569
570 sub _unique_queries {
571   my ($self, $query, $attrs) = @_;
572
573   my @constraint_names = exists $attrs->{key}
574     ? ($attrs->{key})
575     : $self->result_source->unique_constraint_names;
576
577   my $where = $self->_collapse_cond($self->{attrs}{where} || {});
578   my $num_where = scalar keys %$where;
579
580   my (@unique_queries, %seen_column_combinations);
581   foreach my $name (@constraint_names) {
582     my @constraint_cols = $self->result_source->unique_constraint_columns($name);
583
584     my $constraint_sig = join "\x00", sort @constraint_cols;
585     next if $seen_column_combinations{$constraint_sig}++;
586
587     my $unique_query = $self->_build_unique_query($query, \@constraint_cols);
588
589     my $num_cols = scalar @constraint_cols;
590     my $num_query = scalar keys %$unique_query;
591
592     my $total = $num_query + $num_where;
593     if ($num_query && ($num_query == $num_cols || $total == $num_cols)) {
594       # The query is either unique on its own or is unique in combination with
595       # the existing where clause
596       push @unique_queries, $unique_query;
597     }
598   }
599
600   return @unique_queries;
601 }
602
603 # _build_unique_query
604 #
605 # Constrain the specified query hash based on the specified column names.
606
607 sub _build_unique_query {
608   my ($self, $query, $unique_cols) = @_;
609
610   return {
611     map  { $_ => $query->{$_} }
612     grep { exists $query->{$_} }
613       @$unique_cols
614   };
615 }
616
617 =head2 search_related
618
619 =over 4
620
621 =item Arguments: $rel, $cond, \%attrs?
622
623 =item Return Value: $new_resultset
624
625 =back
626
627   $new_rs = $cd_rs->search_related('artist', {
628     name => 'Emo-R-Us',
629   });
630
631 Searches the specified relationship, optionally specifying a condition and
632 attributes for matching records. See L</ATTRIBUTES> for more information.
633
634 =cut
635
636 sub search_related {
637   return shift->related_resultset(shift)->search(@_);
638 }
639
640 =head2 search_related_rs
641
642 This method works exactly the same as search_related, except that
643 it guarantees a resultset, even in list context.
644
645 =cut
646
647 sub search_related_rs {
648   return shift->related_resultset(shift)->search_rs(@_);
649 }
650
651 =head2 cursor
652
653 =over 4
654
655 =item Arguments: none
656
657 =item Return Value: $cursor
658
659 =back
660
661 Returns a storage-driven cursor to the given resultset. See
662 L<DBIx::Class::Cursor> for more information.
663
664 =cut
665
666 sub cursor {
667   my ($self) = @_;
668
669   my $attrs = $self->_resolved_attrs_copy;
670
671   return $self->{cursor}
672     ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
673           $attrs->{where},$attrs);
674 }
675
676 =head2 single
677
678 =over 4
679
680 =item Arguments: $cond?
681
682 =item Return Value: $row_object?
683
684 =back
685
686   my $cd = $schema->resultset('CD')->single({ year => 2001 });
687
688 Inflates the first result without creating a cursor if the resultset has
689 any records in it; if not returns nothing. Used by L</find> as a lean version of
690 L</search>.
691
692 While this method can take an optional search condition (just like L</search>)
693 being a fast-code-path it does not recognize search attributes. If you need to
694 add extra joins or similar, call L</search> and then chain-call L</single> on the
695 L<DBIx::Class::ResultSet> returned.
696
697 =over
698
699 =item B<Note>
700
701 As of 0.08100, this method enforces the assumption that the preceding
702 query returns only one row. If more than one row is returned, you will receive
703 a warning:
704
705   Query returned more than one row
706
707 In this case, you should be using L</next> or L</find> instead, or if you really
708 know what you are doing, use the L</rows> attribute to explicitly limit the size
709 of the resultset.
710
711 This method will also throw an exception if it is called on a resultset prefetching
712 has_many, as such a prefetch implies fetching multiple rows from the database in
713 order to assemble the resulting object.
714
715 =back
716
717 =cut
718
719 sub single {
720   my ($self, $where) = @_;
721   if(@_ > 2) {
722       $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()');
723   }
724
725   my $attrs = $self->_resolved_attrs_copy;
726
727   if (keys %{$attrs->{collapse}}) {
728     $self->throw_exception(
729       'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead'
730     );
731   }
732
733   if ($where) {
734     if (defined $attrs->{where}) {
735       $attrs->{where} = {
736         '-and' =>
737             [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
738                $where, delete $attrs->{where} ]
739       };
740     } else {
741       $attrs->{where} = $where;
742     }
743   }
744
745 #  XXX: Disabled since it doesn't infer uniqueness in all cases
746 #  unless ($self->_is_unique_query($attrs->{where})) {
747 #    carp "Query not guaranteed to return a single row"
748 #      . "; please declare your unique constraints or use search instead";
749 #  }
750
751   my @data = $self->result_source->storage->select_single(
752     $attrs->{from}, $attrs->{select},
753     $attrs->{where}, $attrs
754   );
755
756   return (@data ? ($self->_construct_object(@data))[0] : undef);
757 }
758
759
760 # _is_unique_query
761 #
762 # Try to determine if the specified query is guaranteed to be unique, based on
763 # the declared unique constraints.
764
765 sub _is_unique_query {
766   my ($self, $query) = @_;
767
768   my $collapsed = $self->_collapse_query($query);
769   my $alias = $self->{attrs}{alias};
770
771   foreach my $name ($self->result_source->unique_constraint_names) {
772     my @unique_cols = map {
773       "$alias.$_"
774     } $self->result_source->unique_constraint_columns($name);
775
776     # Count the values for each unique column
777     my %seen = map { $_ => 0 } @unique_cols;
778
779     foreach my $key (keys %$collapsed) {
780       my $aliased = $key =~ /\./ ? $key : "$alias.$key";
781       next unless exists $seen{$aliased};  # Additional constraints are okay
782       $seen{$aliased} = scalar keys %{ $collapsed->{$key} };
783     }
784
785     # If we get 0 or more than 1 value for a column, it's not necessarily unique
786     return 1 unless grep { $_ != 1 } values %seen;
787   }
788
789   return 0;
790 }
791
792 # _collapse_query
793 #
794 # Recursively collapse the query, accumulating values for each column.
795
796 sub _collapse_query {
797   my ($self, $query, $collapsed) = @_;
798
799   $collapsed ||= {};
800
801   if (ref $query eq 'ARRAY') {
802     foreach my $subquery (@$query) {
803       next unless ref $subquery;  # -or
804       $collapsed = $self->_collapse_query($subquery, $collapsed);
805     }
806   }
807   elsif (ref $query eq 'HASH') {
808     if (keys %$query and (keys %$query)[0] eq '-and') {
809       foreach my $subquery (@{$query->{-and}}) {
810         $collapsed = $self->_collapse_query($subquery, $collapsed);
811       }
812     }
813     else {
814       foreach my $col (keys %$query) {
815         my $value = $query->{$col};
816         $collapsed->{$col}{$value}++;
817       }
818     }
819   }
820
821   return $collapsed;
822 }
823
824 =head2 get_column
825
826 =over 4
827
828 =item Arguments: $cond?
829
830 =item Return Value: $resultsetcolumn
831
832 =back
833
834   my $max_length = $rs->get_column('length')->max;
835
836 Returns a L<DBIx::Class::ResultSetColumn> instance for a column of the ResultSet.
837
838 =cut
839
840 sub get_column {
841   my ($self, $column) = @_;
842   my $new = DBIx::Class::ResultSetColumn->new($self, $column);
843   return $new;
844 }
845
846 =head2 search_like
847
848 =over 4
849
850 =item Arguments: $cond, \%attrs?
851
852 =item Return Value: $resultset (scalar context), @row_objs (list context)
853
854 =back
855
856   # WHERE title LIKE '%blue%'
857   $cd_rs = $rs->search_like({ title => '%blue%'});
858
859 Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
860 that this is simply a convenience method retained for ex Class::DBI users.
861 You most likely want to use L</search> with specific operators.
862
863 For more information, see L<DBIx::Class::Manual::Cookbook>.
864
865 This method is deprecated and will be removed in 0.09. Use L</search()>
866 instead. An example conversion is:
867
868   ->search_like({ foo => 'bar' });
869
870   # Becomes
871
872   ->search({ foo => { like => 'bar' } });
873
874 =cut
875
876 sub search_like {
877   my $class = shift;
878   carp (
879     'search_like() is deprecated and will be removed in DBIC version 0.09.'
880    .' Instead use ->search({ x => { -like => "y%" } })'
881    .' (note the outer pair of {}s - they are important!)'
882   );
883   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
884   my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
885   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
886   return $class->search($query, { %$attrs });
887 }
888
889 =head2 slice
890
891 =over 4
892
893 =item Arguments: $first, $last
894
895 =item Return Value: $resultset (scalar context), @row_objs (list context)
896
897 =back
898
899 Returns a resultset or object list representing a subset of elements from the
900 resultset slice is called on. Indexes are from 0, i.e., to get the first
901 three records, call:
902
903   my ($one, $two, $three) = $rs->slice(0, 2);
904
905 =cut
906
907 sub slice {
908   my ($self, $min, $max) = @_;
909   my $attrs = {}; # = { %{ $self->{attrs} || {} } };
910   $attrs->{offset} = $self->{attrs}{offset} || 0;
911   $attrs->{offset} += $min;
912   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
913   return $self->search(undef(), $attrs);
914   #my $slice = (ref $self)->new($self->result_source, $attrs);
915   #return (wantarray ? $slice->all : $slice);
916 }
917
918 =head2 next
919
920 =over 4
921
922 =item Arguments: none
923
924 =item Return Value: $result?
925
926 =back
927
928 Returns the next element in the resultset (C<undef> is there is none).
929
930 Can be used to efficiently iterate over records in the resultset:
931
932   my $rs = $schema->resultset('CD')->search;
933   while (my $cd = $rs->next) {
934     print $cd->title;
935   }
936
937 Note that you need to store the resultset object, and call C<next> on it.
938 Calling C<< resultset('Table')->next >> repeatedly will always return the
939 first record from the resultset.
940
941 =cut
942
943 sub next {
944   my ($self) = @_;
945   if (my $cache = $self->get_cache) {
946     $self->{all_cache_position} ||= 0;
947     return $cache->[$self->{all_cache_position}++];
948   }
949   if ($self->{attrs}{cache}) {
950     $self->{all_cache_position} = 1;
951     return ($self->all)[0];
952   }
953   if ($self->{stashed_objects}) {
954     my $obj = shift(@{$self->{stashed_objects}});
955     delete $self->{stashed_objects} unless @{$self->{stashed_objects}};
956     return $obj;
957   }
958   my @row = (
959     exists $self->{stashed_row}
960       ? @{delete $self->{stashed_row}}
961       : $self->cursor->next
962   );
963   return undef unless (@row);
964   my ($row, @more) = $self->_construct_object(@row);
965   $self->{stashed_objects} = \@more if @more;
966   return $row;
967 }
968
969 sub _construct_object {
970   my ($self, @row) = @_;
971
972   my $info = $self->_collapse_result($self->{_attrs}{as}, \@row)
973     or return ();
974   my @new = $self->result_class->inflate_result($self->result_source, @$info);
975   @new = $self->{_attrs}{record_filter}->(@new)
976     if exists $self->{_attrs}{record_filter};
977   return @new;
978 }
979
980 sub _collapse_result {
981   my ($self, $as_proto, $row) = @_;
982
983   my @copy = @$row;
984
985   # 'foo'         => [ undef, 'foo' ]
986   # 'foo.bar'     => [ 'foo', 'bar' ]
987   # 'foo.bar.baz' => [ 'foo.bar', 'baz' ]
988
989   my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto;
990
991   my %collapse = %{$self->{_attrs}{collapse}||{}};
992
993   my @pri_index;
994
995   # if we're doing collapsing (has_many prefetch) we need to grab records
996   # until the PK changes, so fill @pri_index. if not, we leave it empty so
997   # we know we don't have to bother.
998
999   # the reason for not using the collapse stuff directly is because if you
1000   # had for e.g. two artists in a row with no cds, the collapse info for
1001   # both would be NULL (undef) so you'd lose the second artist
1002
1003   # store just the index so we can check the array positions from the row
1004   # without having to contruct the full hash
1005
1006   if (keys %collapse) {
1007     my %pri = map { ($_ => 1) } $self->result_source->_pri_cols;
1008     foreach my $i (0 .. $#construct_as) {
1009       next if defined($construct_as[$i][0]); # only self table
1010       if (delete $pri{$construct_as[$i][1]}) {
1011         push(@pri_index, $i);
1012       }
1013       last unless keys %pri; # short circuit (Johnny Five Is Alive!)
1014     }
1015   }
1016
1017   # no need to do an if, it'll be empty if @pri_index is empty anyway
1018
1019   my %pri_vals = map { ($_ => $copy[$_]) } @pri_index;
1020
1021   my @const_rows;
1022
1023   do { # no need to check anything at the front, we always want the first row
1024
1025     my %const;
1026
1027     foreach my $this_as (@construct_as) {
1028       $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy);
1029     }
1030
1031     push(@const_rows, \%const);
1032
1033   } until ( # no pri_index => no collapse => drop straight out
1034       !@pri_index
1035     or
1036       do { # get another row, stash it, drop out if different PK
1037
1038         @copy = $self->cursor->next;
1039         $self->{stashed_row} = \@copy;
1040
1041         # last thing in do block, counts as true if anything doesn't match
1042
1043         # check xor defined first for NULL vs. NOT NULL then if one is
1044         # defined the other must be so check string equality
1045
1046         grep {
1047           (defined $pri_vals{$_} ^ defined $copy[$_])
1048           || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_]))
1049         } @pri_index;
1050       }
1051   );
1052
1053   my $alias = $self->{attrs}{alias};
1054   my $info = [];
1055
1056   my %collapse_pos;
1057
1058   my @const_keys;
1059
1060   foreach my $const (@const_rows) {
1061     scalar @const_keys or do {
1062       @const_keys = sort { length($a) <=> length($b) } keys %$const;
1063     };
1064     foreach my $key (@const_keys) {
1065       if (length $key) {
1066         my $target = $info;
1067         my @parts = split(/\./, $key);
1068         my $cur = '';
1069         my $data = $const->{$key};
1070         foreach my $p (@parts) {
1071           $target = $target->[1]->{$p} ||= [];
1072           $cur .= ".${p}";
1073           if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) {
1074             # collapsing at this point and on final part
1075             my $pos = $collapse_pos{$cur};
1076             CK: foreach my $ck (@ckey) {
1077               if (!defined $pos->{$ck} || $pos->{$ck} ne $data->{$ck}) {
1078                 $collapse_pos{$cur} = $data;
1079                 delete @collapse_pos{ # clear all positioning for sub-entries
1080                   grep { m/^\Q${cur}.\E/ } keys %collapse_pos
1081                 };
1082                 push(@$target, []);
1083                 last CK;
1084               }
1085             }
1086           }
1087           if (exists $collapse{$cur}) {
1088             $target = $target->[-1];
1089           }
1090         }
1091         $target->[0] = $data;
1092       } else {
1093         $info->[0] = $const->{$key};
1094       }
1095     }
1096   }
1097
1098   return $info;
1099 }
1100
1101 =head2 result_source
1102
1103 =over 4
1104
1105 =item Arguments: $result_source?
1106
1107 =item Return Value: $result_source
1108
1109 =back
1110
1111 An accessor for the primary ResultSource object from which this ResultSet
1112 is derived.
1113
1114 =head2 result_class
1115
1116 =over 4
1117
1118 =item Arguments: $result_class?
1119
1120 =item Return Value: $result_class
1121
1122 =back
1123
1124 An accessor for the class to use when creating row objects. Defaults to
1125 C<< result_source->result_class >> - which in most cases is the name of the
1126 L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
1127
1128 Note that changing the result_class will also remove any components
1129 that were originally loaded in the source class via
1130 L<DBIx::Class::ResultSource/load_components>. Any overloaded methods
1131 in the original source class will not run.
1132
1133 =cut
1134
1135 sub result_class {
1136   my ($self, $result_class) = @_;
1137   if ($result_class) {
1138     unless (ref $result_class) { # don't fire this for an object
1139       $self->ensure_class_loaded($result_class);
1140     }
1141     $self->_result_class($result_class);
1142     # THIS LINE WOULD BE A BUG - this accessor specifically exists to
1143     # permit the user to set result class on one result set only; it only
1144     # chains if provided to search()
1145     #$self->{attrs}{result_class} = $result_class if ref $self;
1146   }
1147   $self->_result_class;
1148 }
1149
1150 =head2 count
1151
1152 =over 4
1153
1154 =item Arguments: $cond, \%attrs??
1155
1156 =item Return Value: $count
1157
1158 =back
1159
1160 Performs an SQL C<COUNT> with the same query as the resultset was built
1161 with to find the number of elements. Passing arguments is equivalent to
1162 C<< $rs->search ($cond, \%attrs)->count >>
1163
1164 =cut
1165
1166 sub count {
1167   my $self = shift;
1168   return $self->search(@_)->count if @_ and defined $_[0];
1169   return scalar @{ $self->get_cache } if $self->get_cache;
1170
1171   my $attrs = $self->_resolved_attrs_copy;
1172
1173   # this is a little optimization - it is faster to do the limit
1174   # adjustments in software, instead of a subquery
1175   my $rows = delete $attrs->{rows};
1176   my $offset = delete $attrs->{offset};
1177
1178   my $crs;
1179   if ($self->_has_resolved_attr (qw/collapse group_by/)) {
1180     $crs = $self->_count_subq_rs ($attrs);
1181   }
1182   else {
1183     $crs = $self->_count_rs ($attrs);
1184   }
1185   my $count = $crs->next;
1186
1187   $count -= $offset if $offset;
1188   $count = $rows if $rows and $rows < $count;
1189   $count = 0 if ($count < 0);
1190
1191   return $count;
1192 }
1193
1194 =head2 count_rs
1195
1196 =over 4
1197
1198 =item Arguments: $cond, \%attrs??
1199
1200 =item Return Value: $count_rs
1201
1202 =back
1203
1204 Same as L</count> but returns a L<DBIx::Class::ResultSetColumn> object.
1205 This can be very handy for subqueries:
1206
1207   ->search( { amount => $some_rs->count_rs->as_query } )
1208
1209 As with regular resultsets the SQL query will be executed only after
1210 the resultset is accessed via L</next> or L</all>. That would return
1211 the same single value obtainable via L</count>.
1212
1213 =cut
1214
1215 sub count_rs {
1216   my $self = shift;
1217   return $self->search(@_)->count_rs if @_;
1218
1219   # this may look like a lack of abstraction (count() does about the same)
1220   # but in fact an _rs *must* use a subquery for the limits, as the
1221   # software based limiting can not be ported if this $rs is to be used
1222   # in a subquery itself (i.e. ->as_query)
1223   if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) {
1224     return $self->_count_subq_rs;
1225   }
1226   else {
1227     return $self->_count_rs;
1228   }
1229 }
1230
1231 #
1232 # returns a ResultSetColumn object tied to the count query
1233 #
1234 sub _count_rs {
1235   my ($self, $attrs) = @_;
1236
1237   my $rsrc = $self->result_source;
1238   $attrs ||= $self->_resolved_attrs;
1239
1240   # only take pieces we need for a simple count
1241   my $tmp_attrs = { map
1242     { $_ => $attrs->{$_} }
1243     qw/ alias from where bind join /
1244   };
1245
1246   # overwrite the selector (supplied by the storage)
1247   $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs);
1248   $tmp_attrs->{as} = 'count';
1249
1250   my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
1251
1252   return $tmp_rs;
1253 }
1254
1255 #
1256 # same as above but uses a subquery
1257 #
1258 sub _count_subq_rs {
1259   my ($self, $attrs) = @_;
1260
1261   my $rsrc = $self->result_source;
1262   $attrs ||= $self->_resolved_attrs;
1263
1264   my $sub_attrs = { map
1265     { $_ => $attrs->{$_} }
1266     qw/ alias from where bind join group_by having rows offset /
1267   };
1268
1269   # if we multi-prefetch we group_by primary keys only as this is what we would
1270   # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
1271   if ( keys %{$attrs->{collapse}}  ) {
1272     $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->_pri_cols) ]
1273   }
1274
1275   # Calculate subquery selector
1276   if (my $g = $sub_attrs->{group_by}) {
1277
1278     # necessary as the group_by may refer to aliased functions
1279     my $sel_index;
1280     for my $sel (@{$attrs->{select}}) {
1281       $sel_index->{$sel->{-as}} = $sel
1282         if (ref $sel eq 'HASH' and $sel->{-as});
1283     }
1284
1285     for my $g_part (@$g) {
1286       push @{$sub_attrs->{select}}, $sel_index->{$g_part} || $g_part;
1287     }
1288   }
1289   else {
1290     my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns);
1291     $sub_attrs->{select} = @pcols ? \@pcols : [ 1 ];
1292   }
1293
1294   return $rsrc->resultset_class
1295                ->new ($rsrc, $sub_attrs)
1296                 ->as_subselect_rs
1297                  ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } })
1298                   -> get_column ('count');
1299 }
1300
1301 sub _bool {
1302   return 1;
1303 }
1304
1305 =head2 count_literal
1306
1307 =over 4
1308
1309 =item Arguments: $sql_fragment, @bind_values
1310
1311 =item Return Value: $count
1312
1313 =back
1314
1315 Counts the results in a literal query. Equivalent to calling L</search_literal>
1316 with the passed arguments, then L</count>.
1317
1318 =cut
1319
1320 sub count_literal { shift->search_literal(@_)->count; }
1321
1322 =head2 all
1323
1324 =over 4
1325
1326 =item Arguments: none
1327
1328 =item Return Value: @objects
1329
1330 =back
1331
1332 Returns all elements in the resultset. Called implicitly if the resultset
1333 is returned in list context.
1334
1335 =cut
1336
1337 sub all {
1338   my $self = shift;
1339   if(@_) {
1340       $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
1341   }
1342
1343   return @{ $self->get_cache } if $self->get_cache;
1344
1345   my @obj;
1346
1347   if (keys %{$self->_resolved_attrs->{collapse}}) {
1348     # Using $self->cursor->all is really just an optimisation.
1349     # If we're collapsing has_many prefetches it probably makes
1350     # very little difference, and this is cleaner than hacking
1351     # _construct_object to survive the approach
1352     $self->cursor->reset;
1353     my @row = $self->cursor->next;
1354     while (@row) {
1355       push(@obj, $self->_construct_object(@row));
1356       @row = (exists $self->{stashed_row}
1357                ? @{delete $self->{stashed_row}}
1358                : $self->cursor->next);
1359     }
1360   } else {
1361     @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
1362   }
1363
1364   $self->set_cache(\@obj) if $self->{attrs}{cache};
1365
1366   return @obj;
1367 }
1368
1369 =head2 reset
1370
1371 =over 4
1372
1373 =item Arguments: none
1374
1375 =item Return Value: $self
1376
1377 =back
1378
1379 Resets the resultset's cursor, so you can iterate through the elements again.
1380 Implicitly resets the storage cursor, so a subsequent L</next> will trigger
1381 another query.
1382
1383 =cut
1384
1385 sub reset {
1386   my ($self) = @_;
1387   delete $self->{_attrs} if exists $self->{_attrs};
1388   $self->{all_cache_position} = 0;
1389   $self->cursor->reset;
1390   return $self;
1391 }
1392
1393 =head2 first
1394
1395 =over 4
1396
1397 =item Arguments: none
1398
1399 =item Return Value: $object?
1400
1401 =back
1402
1403 Resets the resultset and returns an object for the first result (if the
1404 resultset returns anything).
1405
1406 =cut
1407
1408 sub first {
1409   return $_[0]->reset->next;
1410 }
1411
1412
1413 # _rs_update_delete
1414 #
1415 # Determines whether and what type of subquery is required for the $rs operation.
1416 # If grouping is necessary either supplies its own, or verifies the current one
1417 # After all is done delegates to the proper storage method.
1418
1419 sub _rs_update_delete {
1420   my ($self, $op, $values) = @_;
1421
1422   my $rsrc = $self->result_source;
1423
1424   # if a condition exists we need to strip all table qualifiers
1425   # if this is not possible we'll force a subquery below
1426   my $cond = $rsrc->schema->storage->_strip_cond_qualifiers ($self->{cond});
1427
1428   my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/);
1429   my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/rows offset/);
1430
1431   if ($needs_group_by_subq or $needs_subq) {
1432
1433     # make a new $rs selecting only the PKs (that's all we really need)
1434     my $attrs = $self->_resolved_attrs_copy;
1435
1436
1437     delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_select as/;
1438     $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ];
1439
1440     if ($needs_group_by_subq) {
1441       # make sure no group_by was supplied, or if there is one - make sure it matches
1442       # the columns compiled above perfectly. Anything else can not be sanely executed
1443       # on most databases so croak right then and there
1444
1445       if (my $g = $attrs->{group_by}) {
1446         my @current_group_by = map
1447           { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
1448           @$g
1449         ;
1450
1451         if (
1452           join ("\x00", sort @current_group_by)
1453             ne
1454           join ("\x00", sort @{$attrs->{columns}} )
1455         ) {
1456           $self->throw_exception (
1457             "You have just attempted a $op operation on a resultset which does group_by"
1458             . ' on columns other than the primary keys, while DBIC internally needs to retrieve'
1459             . ' the primary keys in a subselect. All sane RDBMS engines do not support this'
1460             . ' kind of queries. Please retry the operation with a modified group_by or'
1461             . ' without using one at all.'
1462           );
1463         }
1464       }
1465       else {
1466         $attrs->{group_by} = $attrs->{columns};
1467       }
1468     }
1469
1470     my $subrs = (ref $self)->new($rsrc, $attrs);
1471     return $self->result_source->storage->_subq_update_delete($subrs, $op, $values);
1472   }
1473   else {
1474     return $rsrc->storage->$op(
1475       $rsrc,
1476       $op eq 'update' ? $values : (),
1477       $cond,
1478     );
1479   }
1480 }
1481
1482 =head2 update
1483
1484 =over 4
1485
1486 =item Arguments: \%values
1487
1488 =item Return Value: $storage_rv
1489
1490 =back
1491
1492 Sets the specified columns in the resultset to the supplied values in a
1493 single query. Return value will be true if the update succeeded or false
1494 if no records were updated; exact type of success value is storage-dependent.
1495
1496 =cut
1497
1498 sub update {
1499   my ($self, $values) = @_;
1500   $self->throw_exception('Values for update must be a hash')
1501     unless ref $values eq 'HASH';
1502
1503   return $self->_rs_update_delete ('update', $values);
1504 }
1505
1506 =head2 update_all
1507
1508 =over 4
1509
1510 =item Arguments: \%values
1511
1512 =item Return Value: 1
1513
1514 =back
1515
1516 Fetches all objects and updates them one at a time. Note that C<update_all>
1517 will run DBIC cascade triggers, while L</update> will not.
1518
1519 =cut
1520
1521 sub update_all {
1522   my ($self, $values) = @_;
1523   $self->throw_exception('Values for update_all must be a hash')
1524     unless ref $values eq 'HASH';
1525
1526   my $guard = $self->result_source->schema->txn_scope_guard;
1527   $_->update($values) for $self->all;
1528   $guard->commit;
1529   return 1;
1530 }
1531
1532 =head2 delete
1533
1534 =over 4
1535
1536 =item Arguments: none
1537
1538 =item Return Value: $storage_rv
1539
1540 =back
1541
1542 Deletes the contents of the resultset from its result source. Note that this
1543 will not run DBIC cascade triggers. See L</delete_all> if you need triggers
1544 to run. See also L<DBIx::Class::Row/delete>.
1545
1546 Return value will be the number of rows deleted; exact type of return value
1547 is storage-dependent.
1548
1549 =cut
1550
1551 sub delete {
1552   my $self = shift;
1553   $self->throw_exception('delete does not accept any arguments')
1554     if @_;
1555
1556   return $self->_rs_update_delete ('delete');
1557 }
1558
1559 =head2 delete_all
1560
1561 =over 4
1562
1563 =item Arguments: none
1564
1565 =item Return Value: 1
1566
1567 =back
1568
1569 Fetches all objects and deletes them one at a time. Note that C<delete_all>
1570 will run DBIC cascade triggers, while L</delete> will not.
1571
1572 =cut
1573
1574 sub delete_all {
1575   my $self = shift;
1576   $self->throw_exception('delete_all does not accept any arguments')
1577     if @_;
1578
1579   my $guard = $self->result_source->schema->txn_scope_guard;
1580   $_->delete for $self->all;
1581   $guard->commit;
1582   return 1;
1583 }
1584
1585 =head2 populate
1586
1587 =over 4
1588
1589 =item Arguments: \@data;
1590
1591 =back
1592
1593 Accepts either an arrayref of hashrefs or alternatively an arrayref of arrayrefs.
1594 For the arrayref of hashrefs style each hashref should be a structure suitable
1595 forsubmitting to a $resultset->create(...) method.
1596
1597 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
1598 to insert the data, as this is a faster method.
1599
1600 Otherwise, each set of data is inserted into the database using
1601 L<DBIx::Class::ResultSet/create>, and the resulting objects are
1602 accumulated into an array. The array itself, or an array reference
1603 is returned depending on scalar or list context.
1604
1605 Example:  Assuming an Artist Class that has many CDs Classes relating:
1606
1607   my $Artist_rs = $schema->resultset("Artist");
1608
1609   ## Void Context Example
1610   $Artist_rs->populate([
1611      { artistid => 4, name => 'Manufactured Crap', cds => [
1612         { title => 'My First CD', year => 2006 },
1613         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
1614       ],
1615      },
1616      { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
1617         { title => 'My parents sold me to a record company', year => 2005 },
1618         { title => 'Why Am I So Ugly?', year => 2006 },
1619         { title => 'I Got Surgery and am now Popular', year => 2007 }
1620       ],
1621      },
1622   ]);
1623
1624   ## Array Context Example
1625   my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([
1626     { name => "Artist One"},
1627     { name => "Artist Two"},
1628     { name => "Artist Three", cds=> [
1629     { title => "First CD", year => 2007},
1630     { title => "Second CD", year => 2008},
1631   ]}
1632   ]);
1633
1634   print $ArtistOne->name; ## response is 'Artist One'
1635   print $ArtistThree->cds->count ## reponse is '2'
1636
1637 For the arrayref of arrayrefs style,  the first element should be a list of the
1638 fieldsnames to which the remaining elements are rows being inserted.  For
1639 example:
1640
1641   $Arstist_rs->populate([
1642     [qw/artistid name/],
1643     [100, 'A Formally Unknown Singer'],
1644     [101, 'A singer that jumped the shark two albums ago'],
1645     [102, 'An actually cool singer'],
1646   ]);
1647
1648 Please note an important effect on your data when choosing between void and
1649 wantarray context. Since void context goes straight to C<insert_bulk> in
1650 L<DBIx::Class::Storage::DBI> this will skip any component that is overriding
1651 C<insert>.  So if you are using something like L<DBIx-Class-UUIDColumns> to
1652 create primary keys for you, you will find that your PKs are empty.  In this
1653 case you will have to use the wantarray context in order to create those
1654 values.
1655
1656 =cut
1657
1658 sub populate {
1659   my $self = shift;
1660
1661   # cruft placed in standalone method
1662   my $data = $self->_normalize_populate_args(@_);
1663
1664   if(defined wantarray) {
1665     my @created;
1666     foreach my $item (@$data) {
1667       push(@created, $self->create($item));
1668     }
1669     return wantarray ? @created : \@created;
1670   } else {
1671     my $first = $data->[0];
1672
1673     # if a column is a registered relationship, and is a non-blessed hash/array, consider
1674     # it relationship data
1675     my (@rels, @columns);
1676     for (keys %$first) {
1677       my $ref = ref $first->{$_};
1678       $self->result_source->has_relationship($_) && ($ref eq 'ARRAY' or $ref eq 'HASH')
1679         ? push @rels, $_
1680         : push @columns, $_
1681       ;
1682     }
1683
1684     my @pks = $self->result_source->primary_columns;
1685
1686     ## do the belongs_to relationships
1687     foreach my $index (0..$#$data) {
1688
1689       # delegate to create() for any dataset without primary keys with specified relationships
1690       if (grep { !defined $data->[$index]->{$_} } @pks ) {
1691         for my $r (@rels) {
1692           if (grep { ref $data->[$index]{$r} eq $_ } qw/HASH ARRAY/) {  # a related set must be a HASH or AoH
1693             my @ret = $self->populate($data);
1694             return;
1695           }
1696         }
1697       }
1698
1699       foreach my $rel (@rels) {
1700         next unless ref $data->[$index]->{$rel} eq "HASH";
1701         my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
1702         my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)};
1703         my $related = $result->result_source->_resolve_condition(
1704           $result->result_source->relationship_info($reverse)->{cond},
1705           $self,
1706           $result,
1707         );
1708
1709         delete $data->[$index]->{$rel};
1710         $data->[$index] = {%{$data->[$index]}, %$related};
1711
1712         push @columns, keys %$related if $index == 0;
1713       }
1714     }
1715
1716     ## inherit the data locked in the conditions of the resultset
1717     my ($rs_data) = $self->_merge_cond_with_data({});
1718     delete @{$rs_data}{@columns};
1719     my @inherit_cols = keys %$rs_data;
1720     my @inherit_data = values %$rs_data;
1721
1722     ## do bulk insert on current row
1723     $self->result_source->storage->insert_bulk(
1724       $self->result_source,
1725       [@columns, @inherit_cols],
1726       [ map { [ @$_{@columns}, @inherit_data ] } @$data ],
1727     );
1728
1729     ## do the has_many relationships
1730     foreach my $item (@$data) {
1731
1732       foreach my $rel (@rels) {
1733         next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY";
1734
1735         my $parent = $self->find({map { $_ => $item->{$_} } @pks})
1736      || $self->throw_exception('Cannot find the relating object.');
1737
1738         my $child = $parent->$rel;
1739
1740         my $related = $child->result_source->_resolve_condition(
1741           $parent->result_source->relationship_info($rel)->{cond},
1742           $child,
1743           $parent,
1744         );
1745
1746         my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
1747         my @populate = map { {%$_, %$related} } @rows_to_add;
1748
1749         $child->populate( \@populate );
1750       }
1751     }
1752   }
1753 }
1754
1755
1756 # populate() argumnets went over several incarnations
1757 # What we ultimately support is AoH
1758 sub _normalize_populate_args {
1759   my ($self, $arg) = @_;
1760
1761   if (ref $arg eq 'ARRAY') {
1762     if (ref $arg->[0] eq 'HASH') {
1763       return $arg;
1764     }
1765     elsif (ref $arg->[0] eq 'ARRAY') {
1766       my @ret;
1767       my @colnames = @{$arg->[0]};
1768       foreach my $values (@{$arg}[1 .. $#$arg]) {
1769         push @ret, { map { $colnames[$_] => $values->[$_] } (0 .. $#colnames) };
1770       }
1771       return \@ret;
1772     }
1773   }
1774
1775   $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs');
1776 }
1777
1778 =head2 pager
1779
1780 =over 4
1781
1782 =item Arguments: none
1783
1784 =item Return Value: $pager
1785
1786 =back
1787
1788 Return Value a L<Data::Page> object for the current resultset. Only makes
1789 sense for queries with a C<page> attribute.
1790
1791 To get the full count of entries for a paged resultset, call
1792 C<total_entries> on the L<Data::Page> object.
1793
1794 =cut
1795
1796 sub pager {
1797   my ($self) = @_;
1798
1799   return $self->{pager} if $self->{pager};
1800
1801   my $attrs = $self->{attrs};
1802   $self->throw_exception("Can't create pager for non-paged rs")
1803     unless $self->{attrs}{page};
1804   $attrs->{rows} ||= 10;
1805
1806   # throw away the paging flags and re-run the count (possibly
1807   # with a subselect) to get the real total count
1808   my $count_attrs = { %$attrs };
1809   delete $count_attrs->{$_} for qw/rows offset page pager/;
1810   my $total_count = (ref $self)->new($self->result_source, $count_attrs)->count;
1811
1812   return $self->{pager} = Data::Page->new(
1813     $total_count,
1814     $attrs->{rows},
1815     $self->{attrs}{page}
1816   );
1817 }
1818
1819 =head2 page
1820
1821 =over 4
1822
1823 =item Arguments: $page_number
1824
1825 =item Return Value: $rs
1826
1827 =back
1828
1829 Returns a resultset for the $page_number page of the resultset on which page
1830 is called, where each page contains a number of rows equal to the 'rows'
1831 attribute set on the resultset (10 by default).
1832
1833 =cut
1834
1835 sub page {
1836   my ($self, $page) = @_;
1837   return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
1838 }
1839
1840 =head2 new_result
1841
1842 =over 4
1843
1844 =item Arguments: \%vals
1845
1846 =item Return Value: $rowobject
1847
1848 =back
1849
1850 Creates a new row object in the resultset's result class and returns
1851 it. The row is not inserted into the database at this point, call
1852 L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
1853 will tell you whether the row object has been inserted or not.
1854
1855 Passes the hashref of input on to L<DBIx::Class::Row/new>.
1856
1857 =cut
1858
1859 sub new_result {
1860   my ($self, $values) = @_;
1861   $self->throw_exception( "new_result needs a hash" )
1862     unless (ref $values eq 'HASH');
1863
1864   my ($merged_cond, $cols_from_relations) = $self->_merge_cond_with_data($values);
1865
1866   my %new = (
1867     %$merged_cond,
1868     @$cols_from_relations
1869       ? (-cols_from_relations => $cols_from_relations)
1870       : (),
1871     -source_handle => $self->_source_handle,
1872     -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
1873   );
1874
1875   return $self->result_class->new(\%new);
1876 }
1877
1878 # _merge_cond_with_data
1879 #
1880 # Takes a simple hash of K/V data and returns its copy merged with the
1881 # condition already present on the resultset. Additionally returns an
1882 # arrayref of value/condition names, which were inferred from related
1883 # objects (this is needed for in-memory related objects)
1884 sub _merge_cond_with_data {
1885   my ($self, $data) = @_;
1886
1887   my (%new_data, @cols_from_relations);
1888
1889   my $alias = $self->{attrs}{alias};
1890
1891   if (! defined $self->{cond}) {
1892     # just massage $data below
1893   }
1894   elsif ($self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
1895     %new_data = %{ $self->{attrs}{related_objects} || {} };  # nothing might have been inserted yet
1896     @cols_from_relations = keys %new_data;
1897   }
1898   elsif (ref $self->{cond} ne 'HASH') {
1899     $self->throw_exception(
1900       "Can't abstract implicit construct, resultset condition not a hash"
1901     );
1902   }
1903   else {
1904     # precendence must be given to passed values over values inherited from
1905     # the cond, so the order here is important.
1906     my $collapsed_cond = $self->_collapse_cond($self->{cond});
1907     my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
1908
1909     while ( my($col, $value) = each %implied ) {
1910       if (ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') {
1911         $new_data{$col} = $value->{'='};
1912         next;
1913       }
1914       $new_data{$col} = $value if $self->_is_deterministic_value($value);
1915     }
1916   }
1917
1918   %new_data = (
1919     %new_data,
1920     %{ $self->_remove_alias($data, $alias) },
1921   );
1922
1923   return (\%new_data, \@cols_from_relations);
1924 }
1925
1926 # _is_deterministic_value
1927 #
1928 # Make an effor to strip non-deterministic values from the condition,
1929 # to make sure new_result chokes less
1930
1931 sub _is_deterministic_value {
1932   my $self = shift;
1933   my $value = shift;
1934   my $ref_type = ref $value;
1935   return 1 if $ref_type eq '' || $ref_type eq 'SCALAR';
1936   return 1 if Scalar::Util::blessed($value);
1937   return 0;
1938 }
1939
1940 # _has_resolved_attr
1941 #
1942 # determines if the resultset defines at least one
1943 # of the attributes supplied
1944 #
1945 # used to determine if a subquery is neccessary
1946 #
1947 # supports some virtual attributes:
1948 #   -join
1949 #     This will scan for any joins being present on the resultset.
1950 #     It is not a mere key-search but a deep inspection of {from}
1951 #
1952
1953 sub _has_resolved_attr {
1954   my ($self, @attr_names) = @_;
1955
1956   my $attrs = $self->_resolved_attrs;
1957
1958   my %extra_checks;
1959
1960   for my $n (@attr_names) {
1961     if (grep { $n eq $_ } (qw/-join/) ) {
1962       $extra_checks{$n}++;
1963       next;
1964     }
1965
1966     my $attr =  $attrs->{$n};
1967
1968     next if not defined $attr;
1969
1970     if (ref $attr eq 'HASH') {
1971       return 1 if keys %$attr;
1972     }
1973     elsif (ref $attr eq 'ARRAY') {
1974       return 1 if @$attr;
1975     }
1976     else {
1977       return 1 if $attr;
1978     }
1979   }
1980
1981   # a resolved join is expressed as a multi-level from
1982   return 1 if (
1983     $extra_checks{-join}
1984       and
1985     ref $attrs->{from} eq 'ARRAY'
1986       and
1987     @{$attrs->{from}} > 1
1988   );
1989
1990   return 0;
1991 }
1992
1993 # _collapse_cond
1994 #
1995 # Recursively collapse the condition.
1996
1997 sub _collapse_cond {
1998   my ($self, $cond, $collapsed) = @_;
1999
2000   $collapsed ||= {};
2001
2002   if (ref $cond eq 'ARRAY') {
2003     foreach my $subcond (@$cond) {
2004       next unless ref $subcond;  # -or
2005       $collapsed = $self->_collapse_cond($subcond, $collapsed);
2006     }
2007   }
2008   elsif (ref $cond eq 'HASH') {
2009     if (keys %$cond and (keys %$cond)[0] eq '-and') {
2010       foreach my $subcond (@{$cond->{-and}}) {
2011         $collapsed = $self->_collapse_cond($subcond, $collapsed);
2012       }
2013     }
2014     else {
2015       foreach my $col (keys %$cond) {
2016         my $value = $cond->{$col};
2017         $collapsed->{$col} = $value;
2018       }
2019     }
2020   }
2021
2022   return $collapsed;
2023 }
2024
2025 # _remove_alias
2026 #
2027 # Remove the specified alias from the specified query hash. A copy is made so
2028 # the original query is not modified.
2029
2030 sub _remove_alias {
2031   my ($self, $query, $alias) = @_;
2032
2033   my %orig = %{ $query || {} };
2034   my %unaliased;
2035
2036   foreach my $key (keys %orig) {
2037     if ($key !~ /\./) {
2038       $unaliased{$key} = $orig{$key};
2039       next;
2040     }
2041     $unaliased{$1} = $orig{$key}
2042       if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
2043   }
2044
2045   return \%unaliased;
2046 }
2047
2048 =head2 as_query
2049
2050 =over 4
2051
2052 =item Arguments: none
2053
2054 =item Return Value: \[ $sql, @bind ]
2055
2056 =back
2057
2058 Returns the SQL query and bind vars associated with the invocant.
2059
2060 This is generally used as the RHS for a subquery.
2061
2062 =cut
2063
2064 sub as_query {
2065   my $self = shift;
2066
2067   my $attrs = $self->_resolved_attrs_copy;
2068
2069   # For future use:
2070   #
2071   # in list ctx:
2072   # my ($sql, \@bind, \%dbi_bind_attrs) = _select_args_to_query (...)
2073   # $sql also has no wrapping parenthesis in list ctx
2074   #
2075   my $sqlbind = $self->result_source->storage
2076     ->_select_args_to_query ($attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs);
2077
2078   return $sqlbind;
2079 }
2080
2081 =head2 find_or_new
2082
2083 =over 4
2084
2085 =item Arguments: \%vals, \%attrs?
2086
2087 =item Return Value: $rowobject
2088
2089 =back
2090
2091   my $artist = $schema->resultset('Artist')->find_or_new(
2092     { artist => 'fred' }, { key => 'artists' });
2093
2094   $cd->cd_to_producer->find_or_new({ producer => $producer },
2095                                    { key => 'primary });
2096
2097 Find an existing record from this resultset, based on its primary
2098 key, or a unique constraint. If none exists, instantiate a new result
2099 object and return it. The object will not be saved into your storage
2100 until you call L<DBIx::Class::Row/insert> on it.
2101
2102 You most likely want this method when looking for existing rows using
2103 a unique constraint that is not the primary key, or looking for
2104 related rows.
2105
2106 If you want objects to be saved immediately, use L</find_or_create>
2107 instead.
2108
2109 B<Note>: Take care when using C<find_or_new> with a table having
2110 columns with default values that you intend to be automatically
2111 supplied by the database (e.g. an auto_increment primary key column).
2112 In normal usage, the value of such columns should NOT be included at
2113 all in the call to C<find_or_new>, even when set to C<undef>.
2114
2115 =cut
2116
2117 sub find_or_new {
2118   my $self     = shift;
2119   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2120   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2121   if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2122     return $row;
2123   }
2124   return $self->new_result($hash);
2125 }
2126
2127 =head2 create
2128
2129 =over 4
2130
2131 =item Arguments: \%vals
2132
2133 =item Return Value: a L<DBIx::Class::Row> $object
2134
2135 =back
2136
2137 Attempt to create a single new row or a row with multiple related rows
2138 in the table represented by the resultset (and related tables). This
2139 will not check for duplicate rows before inserting, use
2140 L</find_or_create> to do that.
2141
2142 To create one row for this resultset, pass a hashref of key/value
2143 pairs representing the columns of the table and the values you wish to
2144 store. If the appropriate relationships are set up, foreign key fields
2145 can also be passed an object representing the foreign row, and the
2146 value will be set to its primary key.
2147
2148 To create related objects, pass a hashref of related-object column values
2149 B<keyed on the relationship name>. If the relationship is of type C<multi>
2150 (L<DBIx::Class::Relationship/has_many>) - pass an arrayref of hashrefs.
2151 The process will correctly identify columns holding foreign keys, and will
2152 transparently populate them from the keys of the corresponding relation.
2153 This can be applied recursively, and will work correctly for a structure
2154 with an arbitrary depth and width, as long as the relationships actually
2155 exists and the correct column data has been supplied.
2156
2157
2158 Instead of hashrefs of plain related data (key/value pairs), you may
2159 also pass new or inserted objects. New objects (not inserted yet, see
2160 L</new>), will be inserted into their appropriate tables.
2161
2162 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
2163
2164 Example of creating a new row.
2165
2166   $person_rs->create({
2167     name=>"Some Person",
2168     email=>"somebody@someplace.com"
2169   });
2170
2171 Example of creating a new row and also creating rows in a related C<has_many>
2172 or C<has_one> resultset.  Note Arrayref.
2173
2174   $artist_rs->create(
2175      { artistid => 4, name => 'Manufactured Crap', cds => [
2176         { title => 'My First CD', year => 2006 },
2177         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2178       ],
2179      },
2180   );
2181
2182 Example of creating a new row and also creating a row in a related
2183 C<belongs_to>resultset. Note Hashref.
2184
2185   $cd_rs->create({
2186     title=>"Music for Silly Walks",
2187     year=>2000,
2188     artist => {
2189       name=>"Silly Musician",
2190     }
2191   });
2192
2193 =over
2194
2195 =item WARNING
2196
2197 When subclassing ResultSet never attempt to override this method. Since
2198 it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a
2199 lot of the internals simply never call it, so your override will be
2200 bypassed more often than not. Override either L<new|DBIx::Class::Row/new>
2201 or L<insert|DBIx::Class::Row/insert> depending on how early in the
2202 L</create> process you need to intervene.
2203
2204 =back
2205
2206 =cut
2207
2208 sub create {
2209   my ($self, $attrs) = @_;
2210   $self->throw_exception( "create needs a hashref" )
2211     unless ref $attrs eq 'HASH';
2212   return $self->new_result($attrs)->insert;
2213 }
2214
2215 =head2 find_or_create
2216
2217 =over 4
2218
2219 =item Arguments: \%vals, \%attrs?
2220
2221 =item Return Value: $rowobject
2222
2223 =back
2224
2225   $cd->cd_to_producer->find_or_create({ producer => $producer },
2226                                       { key => 'primary' });
2227
2228 Tries to find a record based on its primary key or unique constraints; if none
2229 is found, creates one and returns that instead.
2230
2231   my $cd = $schema->resultset('CD')->find_or_create({
2232     cdid   => 5,
2233     artist => 'Massive Attack',
2234     title  => 'Mezzanine',
2235     year   => 2005,
2236   });
2237
2238 Also takes an optional C<key> attribute, to search by a specific key or unique
2239 constraint. For example:
2240
2241   my $cd = $schema->resultset('CD')->find_or_create(
2242     {
2243       artist => 'Massive Attack',
2244       title  => 'Mezzanine',
2245     },
2246     { key => 'cd_artist_title' }
2247   );
2248
2249 B<Note>: Because find_or_create() reads from the database and then
2250 possibly inserts based on the result, this method is subject to a race
2251 condition. Another process could create a record in the table after
2252 the find has completed and before the create has started. To avoid
2253 this problem, use find_or_create() inside a transaction.
2254
2255 B<Note>: Take care when using C<find_or_create> with a table having
2256 columns with default values that you intend to be automatically
2257 supplied by the database (e.g. an auto_increment primary key column).
2258 In normal usage, the value of such columns should NOT be included at
2259 all in the call to C<find_or_create>, even when set to C<undef>.
2260
2261 See also L</find> and L</update_or_create>. For information on how to declare
2262 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2263
2264 =cut
2265
2266 sub find_or_create {
2267   my $self     = shift;
2268   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2269   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2270   if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2271     return $row;
2272   }
2273   return $self->create($hash);
2274 }
2275
2276 =head2 update_or_create
2277
2278 =over 4
2279
2280 =item Arguments: \%col_values, { key => $unique_constraint }?
2281
2282 =item Return Value: $rowobject
2283
2284 =back
2285
2286   $resultset->update_or_create({ col => $val, ... });
2287
2288 First, searches for an existing row matching one of the unique constraints
2289 (including the primary key) on the source of this resultset. If a row is
2290 found, updates it with the other given column values. Otherwise, creates a new
2291 row.
2292
2293 Takes an optional C<key> attribute to search on a specific unique constraint.
2294 For example:
2295
2296   # In your application
2297   my $cd = $schema->resultset('CD')->update_or_create(
2298     {
2299       artist => 'Massive Attack',
2300       title  => 'Mezzanine',
2301       year   => 1998,
2302     },
2303     { key => 'cd_artist_title' }
2304   );
2305
2306   $cd->cd_to_producer->update_or_create({
2307     producer => $producer,
2308     name => 'harry',
2309   }, {
2310     key => 'primary',
2311   });
2312
2313
2314 If no C<key> is specified, it searches on all unique constraints defined on the
2315 source, including the primary key.
2316
2317 If the C<key> is specified as C<primary>, it searches only on the primary key.
2318
2319 See also L</find> and L</find_or_create>. For information on how to declare
2320 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2321
2322 B<Note>: Take care when using C<update_or_create> with a table having
2323 columns with default values that you intend to be automatically
2324 supplied by the database (e.g. an auto_increment primary key column).
2325 In normal usage, the value of such columns should NOT be included at
2326 all in the call to C<update_or_create>, even when set to C<undef>.
2327
2328 =cut
2329
2330 sub update_or_create {
2331   my $self = shift;
2332   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2333   my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
2334
2335   my $row = $self->find($cond, $attrs);
2336   if (defined $row) {
2337     $row->update($cond);
2338     return $row;
2339   }
2340
2341   return $self->create($cond);
2342 }
2343
2344 =head2 update_or_new
2345
2346 =over 4
2347
2348 =item Arguments: \%col_values, { key => $unique_constraint }?
2349
2350 =item Return Value: $rowobject
2351
2352 =back
2353
2354   $resultset->update_or_new({ col => $val, ... });
2355
2356 First, searches for an existing row matching one of the unique constraints
2357 (including the primary key) on the source of this resultset. If a row is
2358 found, updates it with the other given column values. Otherwise, instantiate
2359 a new result object and return it. The object will not be saved into your storage
2360 until you call L<DBIx::Class::Row/insert> on it.
2361
2362 Takes an optional C<key> attribute to search on a specific unique constraint.
2363 For example:
2364
2365   # In your application
2366   my $cd = $schema->resultset('CD')->update_or_new(
2367     {
2368       artist => 'Massive Attack',
2369       title  => 'Mezzanine',
2370       year   => 1998,
2371     },
2372     { key => 'cd_artist_title' }
2373   );
2374
2375   if ($cd->in_storage) {
2376       # the cd was updated
2377   }
2378   else {
2379       # the cd is not yet in the database, let's insert it
2380       $cd->insert;
2381   }
2382
2383 B<Note>: Take care when using C<update_or_new> with a table having
2384 columns with default values that you intend to be automatically
2385 supplied by the database (e.g. an auto_increment primary key column).
2386 In normal usage, the value of such columns should NOT be included at
2387 all in the call to C<update_or_new>, even when set to C<undef>.
2388
2389 See also L</find>, L</find_or_create> and L</find_or_new>.
2390
2391 =cut
2392
2393 sub update_or_new {
2394     my $self  = shift;
2395     my $attrs = ( @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {} );
2396     my $cond  = ref $_[0] eq 'HASH' ? shift : {@_};
2397
2398     my $row = $self->find( $cond, $attrs );
2399     if ( defined $row ) {
2400         $row->update($cond);
2401         return $row;
2402     }
2403
2404     return $self->new_result($cond);
2405 }
2406
2407 =head2 get_cache
2408
2409 =over 4
2410
2411 =item Arguments: none
2412
2413 =item Return Value: \@cache_objects?
2414
2415 =back
2416
2417 Gets the contents of the cache for the resultset, if the cache is set.
2418
2419 The cache is populated either by using the L</prefetch> attribute to
2420 L</search> or by calling L</set_cache>.
2421
2422 =cut
2423
2424 sub get_cache {
2425   shift->{all_cache};
2426 }
2427
2428 =head2 set_cache
2429
2430 =over 4
2431
2432 =item Arguments: \@cache_objects
2433
2434 =item Return Value: \@cache_objects
2435
2436 =back
2437
2438 Sets the contents of the cache for the resultset. Expects an arrayref
2439 of objects of the same class as those produced by the resultset. Note that
2440 if the cache is set the resultset will return the cached objects rather
2441 than re-querying the database even if the cache attr is not set.
2442
2443 The contents of the cache can also be populated by using the
2444 L</prefetch> attribute to L</search>.
2445
2446 =cut
2447
2448 sub set_cache {
2449   my ( $self, $data ) = @_;
2450   $self->throw_exception("set_cache requires an arrayref")
2451       if defined($data) && (ref $data ne 'ARRAY');
2452   $self->{all_cache} = $data;
2453 }
2454
2455 =head2 clear_cache
2456
2457 =over 4
2458
2459 =item Arguments: none
2460
2461 =item Return Value: []
2462
2463 =back
2464
2465 Clears the cache for the resultset.
2466
2467 =cut
2468
2469 sub clear_cache {
2470   shift->set_cache(undef);
2471 }
2472
2473 =head2 is_paged
2474
2475 =over 4
2476
2477 =item Arguments: none
2478
2479 =item Return Value: true, if the resultset has been paginated
2480
2481 =back
2482
2483 =cut
2484
2485 sub is_paged {
2486   my ($self) = @_;
2487   return !!$self->{attrs}{page};
2488 }
2489
2490 =head2 is_ordered
2491
2492 =over 4
2493
2494 =item Arguments: none
2495
2496 =item Return Value: true, if the resultset has been ordered with C<order_by>.
2497
2498 =back
2499
2500 =cut
2501
2502 sub is_ordered {
2503   my ($self) = @_;
2504   return scalar $self->result_source->storage->_parse_order_by($self->{attrs}{order_by});
2505 }
2506
2507 =head2 related_resultset
2508
2509 =over 4
2510
2511 =item Arguments: $relationship_name
2512
2513 =item Return Value: $resultset
2514
2515 =back
2516
2517 Returns a related resultset for the supplied relationship name.
2518
2519   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
2520
2521 =cut
2522
2523 sub related_resultset {
2524   my ($self, $rel) = @_;
2525
2526   $self->{related_resultsets} ||= {};
2527   return $self->{related_resultsets}{$rel} ||= do {
2528     my $rsrc = $self->result_source;
2529     my $rel_info = $rsrc->relationship_info($rel);
2530
2531     $self->throw_exception(
2532       "search_related: result source '" . $rsrc->source_name .
2533         "' has no such relationship $rel")
2534       unless $rel_info;
2535
2536     my $attrs = $self->_chain_relationship($rel);
2537
2538     my $join_count = $attrs->{seen_join}{$rel};
2539
2540     my $alias = $self->result_source->storage
2541         ->relname_to_table_alias($rel, $join_count);
2542
2543     # since this is search_related, and we already slid the select window inwards
2544     # (the select/as attrs were deleted in the beginning), we need to flip all
2545     # left joins to inner, so we get the expected results
2546     # read the comment on top of the actual function to see what this does
2547     $attrs->{from} = $rsrc->schema->storage->_straight_join_to_node ($attrs->{from}, $alias);
2548
2549
2550     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
2551     delete @{$attrs}{qw(result_class alias)};
2552
2553     my $new_cache;
2554
2555     if (my $cache = $self->get_cache) {
2556       if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) {
2557         $new_cache = [ map { @{$_->related_resultset($rel)->get_cache} }
2558                         @$cache ];
2559       }
2560     }
2561
2562     my $rel_source = $rsrc->related_source($rel);
2563
2564     my $new = do {
2565
2566       # The reason we do this now instead of passing the alias to the
2567       # search_rs below is that if you wrap/overload resultset on the
2568       # source you need to know what alias it's -going- to have for things
2569       # to work sanely (e.g. RestrictWithObject wants to be able to add
2570       # extra query restrictions, and these may need to be $alias.)
2571
2572       my $rel_attrs = $rel_source->resultset_attributes;
2573       local $rel_attrs->{alias} = $alias;
2574
2575       $rel_source->resultset
2576                  ->search_rs(
2577                      undef, {
2578                        %$attrs,
2579                        where => $attrs->{where},
2580                    });
2581     };
2582     $new->set_cache($new_cache) if $new_cache;
2583     $new;
2584   };
2585 }
2586
2587 =head2 current_source_alias
2588
2589 =over 4
2590
2591 =item Arguments: none
2592
2593 =item Return Value: $source_alias
2594
2595 =back
2596
2597 Returns the current table alias for the result source this resultset is built
2598 on, that will be used in the SQL query. Usually it is C<me>.
2599
2600 Currently the source alias that refers to the result set returned by a
2601 L</search>/L</find> family method depends on how you got to the resultset: it's
2602 C<me> by default, but eg. L</search_related> aliases it to the related result
2603 source name (and keeps C<me> referring to the original result set). The long
2604 term goal is to make L<DBIx::Class> always alias the current resultset as C<me>
2605 (and make this method unnecessary).
2606
2607 Thus it's currently necessary to use this method in predefined queries (see
2608 L<DBIx::Class::Manual::Cookbook/Predefined searches>) when referring to the
2609 source alias of the current result set:
2610
2611   # in a result set class
2612   sub modified_by {
2613     my ($self, $user) = @_;
2614
2615     my $me = $self->current_source_alias;
2616
2617     return $self->search(
2618       "$me.modified" => $user->id,
2619     );
2620   }
2621
2622 =cut
2623
2624 sub current_source_alias {
2625   my ($self) = @_;
2626
2627   return ($self->{attrs} || {})->{alias} || 'me';
2628 }
2629
2630 =head2 as_subselect_rs
2631
2632 =over 4
2633
2634 =item Arguments: none
2635
2636 =item Return Value: $resultset
2637
2638 =back
2639
2640 Act as a barrier to SQL symbols.  The resultset provided will be made into a
2641 "virtual view" by including it as a subquery within the from clause.  From this
2642 point on, any joined tables are inaccessible to ->search on the resultset (as if
2643 it were simply where-filtered without joins).  For example:
2644
2645  my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' });
2646
2647  # 'x' now pollutes the query namespace
2648
2649  # So the following works as expected
2650  my $ok_rs = $rs->search({'x.other' => 1});
2651
2652  # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and
2653  # def) we look for one row with contradictory terms and join in another table
2654  # (aliased 'x_2') which we never use
2655  my $broken_rs = $rs->search({'x.name' => 'def'});
2656
2657  my $rs2 = $rs->as_subselect_rs;
2658
2659  # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away
2660  my $not_joined_rs = $rs2->search({'x.other' => 1});
2661
2662  # works as expected: finds a 'table' row related to two x rows (abc and def)
2663  my $correctly_joined_rs = $rs2->search({'x.name' => 'def'});
2664
2665 Another example of when one might use this would be to select a subset of
2666 columns in a group by clause:
2667
2668  my $rs = $schema->resultset('Bar')->search(undef, {
2669    group_by => [qw{ id foo_id baz_id }],
2670  })->as_subselect_rs->search(undef, {
2671    columns => [qw{ id foo_id }]
2672  });
2673
2674 In the above example normally columns would have to be equal to the group by,
2675 but because we isolated the group by into a subselect the above works.
2676
2677 =cut
2678
2679 sub as_subselect_rs {
2680   my $self = shift;
2681
2682   my $attrs = $self->_resolved_attrs;
2683
2684   my $fresh_rs = (ref $self)->new (
2685     $self->result_source
2686   );
2687
2688   # these pieces will be locked in the subquery
2689   delete $fresh_rs->{cond};
2690   delete @{$fresh_rs->{attrs}}{qw/where bind/};
2691
2692   return $fresh_rs->search( {}, {
2693     from => [{
2694       $attrs->{alias} => $self->as_query,
2695       -alias         => $attrs->{alias},
2696       -source_handle => $self->result_source->handle,
2697     }],
2698     alias => $attrs->{alias},
2699   });
2700 }
2701
2702 # This code is called by search_related, and makes sure there
2703 # is clear separation between the joins before, during, and
2704 # after the relationship. This information is needed later
2705 # in order to properly resolve prefetch aliases (any alias
2706 # with a relation_chain_depth less than the depth of the
2707 # current prefetch is not considered)
2708 #
2709 # The increments happen twice per join. An even number means a
2710 # relationship specified via a search_related, whereas an odd
2711 # number indicates a join/prefetch added via attributes
2712 #
2713 # Also this code will wrap the current resultset (the one we
2714 # chain to) in a subselect IFF it contains limiting attributes
2715 sub _chain_relationship {
2716   my ($self, $rel) = @_;
2717   my $source = $self->result_source;
2718   my $attrs = { %{$self->{attrs}||{}} };
2719
2720   # we need to take the prefetch the attrs into account before we
2721   # ->_resolve_join as otherwise they get lost - captainL
2722   my $join = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} );
2723
2724   delete @{$attrs}{qw/join prefetch collapse group_by distinct select as columns +select +as +columns/};
2725
2726   my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
2727
2728   my $from;
2729   my @force_subq_attrs = qw/offset rows group_by having/;
2730
2731   if (
2732     ($attrs->{from} && ref $attrs->{from} ne 'ARRAY')
2733       ||
2734     $self->_has_resolved_attr (@force_subq_attrs)
2735   ) {
2736     # Nuke the prefetch (if any) before the new $rs attrs
2737     # are resolved (prefetch is useless - we are wrapping
2738     # a subquery anyway).
2739     my $rs_copy = $self->search;
2740     $rs_copy->{attrs}{join} = $self->_merge_attr (
2741       $rs_copy->{attrs}{join},
2742       delete $rs_copy->{attrs}{prefetch},
2743     );
2744
2745     $from = [{
2746       -source_handle => $source->handle,
2747       -alias => $attrs->{alias},
2748       $attrs->{alias} => $rs_copy->as_query,
2749     }];
2750     delete @{$attrs}{@force_subq_attrs, qw/where bind/};
2751     $seen->{-relation_chain_depth} = 0;
2752   }
2753   elsif ($attrs->{from}) {  #shallow copy suffices
2754     $from = [ @{$attrs->{from}} ];
2755   }
2756   else {
2757     $from = [{
2758       -source_handle => $source->handle,
2759       -alias => $attrs->{alias},
2760       $attrs->{alias} => $source->from,
2761     }];
2762   }
2763
2764   my $jpath = ($seen->{-relation_chain_depth})
2765     ? $from->[-1][0]{-join_path}
2766     : [];
2767
2768   my @requested_joins = $source->_resolve_join(
2769     $join,
2770     $attrs->{alias},
2771     $seen,
2772     $jpath,
2773   );
2774
2775   push @$from, @requested_joins;
2776
2777   $seen->{-relation_chain_depth}++;
2778
2779   # if $self already had a join/prefetch specified on it, the requested
2780   # $rel might very well be already included. What we do in this case
2781   # is effectively a no-op (except that we bump up the chain_depth on
2782   # the join in question so we could tell it *is* the search_related)
2783   my $already_joined;
2784
2785   # we consider the last one thus reverse
2786   for my $j (reverse @requested_joins) {
2787     my ($last_j) = keys %{$j->[0]{-join_path}[-1]};
2788     if ($rel eq $last_j) {
2789       $j->[0]{-relation_chain_depth}++;
2790       $already_joined++;
2791       last;
2792     }
2793   }
2794
2795   unless ($already_joined) {
2796     push @$from, $source->_resolve_join(
2797       $rel,
2798       $attrs->{alias},
2799       $seen,
2800       $jpath,
2801     );
2802   }
2803
2804   $seen->{-relation_chain_depth}++;
2805
2806   return {%$attrs, from => $from, seen_join => $seen};
2807 }
2808
2809 # too many times we have to do $attrs = { %{$self->_resolved_attrs} }
2810 sub _resolved_attrs_copy {
2811   my $self = shift;
2812   return { %{$self->_resolved_attrs (@_)} };
2813 }
2814
2815 sub _resolved_attrs {
2816   my $self = shift;
2817   return $self->{_attrs} if $self->{_attrs};
2818
2819   my $attrs  = { %{ $self->{attrs} || {} } };
2820   my $source = $self->result_source;
2821   my $alias  = $attrs->{alias};
2822
2823   $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols};
2824   my @colbits;
2825
2826   # build columns (as long as select isn't set) into a set of as/select hashes
2827   unless ( $attrs->{select} ) {
2828
2829     my @cols;
2830     if ( ref $attrs->{columns} eq 'ARRAY' ) {
2831       @cols = @{ delete $attrs->{columns}}
2832     } elsif ( defined $attrs->{columns} ) {
2833       @cols = delete $attrs->{columns}
2834     } else {
2835       @cols = $source->columns
2836     }
2837
2838     for (@cols) {
2839       if ( ref $_ eq 'HASH' ) {
2840         push @colbits, $_
2841       } else {
2842         my $key = /^\Q${alias}.\E(.+)$/
2843           ? "$1"
2844           : "$_";
2845         my $value = /\./
2846           ? "$_"
2847           : "${alias}.$_";
2848         push @colbits, { $key => $value };
2849       }
2850     }
2851   }
2852
2853   # add the additional columns on
2854   foreach (qw{include_columns +columns}) {
2855     if ( $attrs->{$_} ) {
2856       my @list = ( ref($attrs->{$_}) eq 'ARRAY' )
2857         ? @{ delete $attrs->{$_} }
2858         : delete $attrs->{$_};
2859       for (@list) {
2860         if ( ref($_) eq 'HASH' ) {
2861           push @colbits, $_
2862         } else {
2863           my $key = ( split /\./, $_ )[-1];
2864           my $value = ( /\./ ? $_ : "$alias.$_" );
2865           push @colbits, { $key => $value };
2866         }
2867       }
2868     }
2869   }
2870
2871   # start with initial select items
2872   if ( $attrs->{select} ) {
2873     $attrs->{select} =
2874         ( ref $attrs->{select} eq 'ARRAY' )
2875       ? [ @{ $attrs->{select} } ]
2876       : [ $attrs->{select} ];
2877
2878     if ( $attrs->{as} ) {
2879       $attrs->{as} =
2880         (
2881           ref $attrs->{as} eq 'ARRAY'
2882             ? [ @{ $attrs->{as} } ]
2883             : [ $attrs->{as} ]
2884         )
2885     } else {
2886       $attrs->{as} = [ map {
2887          m/^\Q${alias}.\E(.+)$/
2888            ? $1
2889            : $_
2890          } @{ $attrs->{select} }
2891       ]
2892     }
2893   }
2894   else {
2895
2896     # otherwise we intialise select & as to empty
2897     $attrs->{select} = [];
2898     $attrs->{as}     = [];
2899   }
2900
2901   # now add colbits to select/as
2902   push @{ $attrs->{select} }, map values %{$_}, @colbits;
2903   push @{ $attrs->{as}     }, map keys   %{$_}, @colbits;
2904
2905   if ( my $adds = delete $attrs->{'+select'} ) {
2906     $adds = [$adds] unless ref $adds eq 'ARRAY';
2907     push @{ $attrs->{select} },
2908       map { /\./ || ref $_ ? $_ : "$alias.$_" } @$adds;
2909   }
2910   if ( my $adds = delete $attrs->{'+as'} ) {
2911     $adds = [$adds] unless ref $adds eq 'ARRAY';
2912     push @{ $attrs->{as} }, @$adds;
2913   }
2914
2915   $attrs->{from} ||= [{
2916     -source_handle => $source->handle,
2917     -alias => $self->{attrs}{alias},
2918     $self->{attrs}{alias} => $source->from,
2919   }];
2920
2921   if ( $attrs->{join} || $attrs->{prefetch} ) {
2922
2923     $self->throw_exception ('join/prefetch can not be used with a custom {from}')
2924       if ref $attrs->{from} ne 'ARRAY';
2925
2926     my $join = delete $attrs->{join} || {};
2927
2928     if ( defined $attrs->{prefetch} ) {
2929       $join = $self->_merge_attr( $join, $attrs->{prefetch} );
2930     }
2931
2932     $attrs->{from} =    # have to copy here to avoid corrupting the original
2933       [
2934         @{ $attrs->{from} },
2935         $source->_resolve_join(
2936           $join,
2937           $alias,
2938           { %{ $attrs->{seen_join} || {} } },
2939           ( $attrs->{seen_join} && keys %{$attrs->{seen_join}})
2940             ? $attrs->{from}[-1][0]{-join_path}
2941             : []
2942           ,
2943         )
2944       ];
2945   }
2946
2947   if ( defined $attrs->{order_by} ) {
2948     $attrs->{order_by} = (
2949       ref( $attrs->{order_by} ) eq 'ARRAY'
2950       ? [ @{ $attrs->{order_by} } ]
2951       : [ $attrs->{order_by} || () ]
2952     );
2953   }
2954
2955   if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') {
2956     $attrs->{group_by} = [ $attrs->{group_by} ];
2957   }
2958
2959   # generate the distinct induced group_by early, as prefetch will be carried via a
2960   # subquery (since a group_by is present)
2961   if (delete $attrs->{distinct}) {
2962     if ($attrs->{group_by}) {
2963       carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
2964     }
2965     else {
2966       $attrs->{group_by} = [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ];
2967
2968       # add any order_by parts that are not already present in the group_by
2969       # we need to be careful not to add any named functions/aggregates
2970       # i.e. select => [ ... { count => 'foo', -as 'foocount' } ... ]
2971       my %already_grouped = map { $_ => 1 } (@{$attrs->{group_by}});
2972
2973       my $storage = $self->result_source->schema->storage;
2974
2975       my $rs_column_list = $storage->_resolve_column_info ($attrs->{from});
2976
2977       for my $chunk ($storage->_parse_order_by($attrs->{order_by})) {
2978         if ($rs_column_list->{$chunk} && not $already_grouped{$chunk}++) {
2979           push @{$attrs->{group_by}}, $chunk;
2980         }
2981       }
2982     }
2983   }
2984
2985   $attrs->{collapse} ||= {};
2986   if ( my $prefetch = delete $attrs->{prefetch} ) {
2987     $prefetch = $self->_merge_attr( {}, $prefetch );
2988
2989     my $prefetch_ordering = [];
2990
2991     # this is a separate structure (we don't look in {from} directly)
2992     # as the resolver needs to shift things off the lists to work
2993     # properly (identical-prefetches on different branches)
2994     my $join_map = {};
2995     if (ref $attrs->{from} eq 'ARRAY') {
2996
2997       my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0;
2998
2999       for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
3000         next unless $j->[0]{-alias};
3001         next unless $j->[0]{-join_path};
3002         next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth;
3003
3004         my @jpath = map { keys %$_ } @{$j->[0]{-join_path}};
3005
3006         my $p = $join_map;
3007         $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries
3008         push @{$p->{-join_aliases} }, $j->[0]{-alias};
3009       }
3010     }
3011
3012     my @prefetch =
3013       $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
3014
3015     # we need to somehow mark which columns came from prefetch
3016     $attrs->{_prefetch_select} = [ map { $_->[0] } @prefetch ];
3017
3018     push @{ $attrs->{select} }, @{$attrs->{_prefetch_select}};
3019     push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
3020
3021     push( @{$attrs->{order_by}}, @$prefetch_ordering );
3022     $attrs->{_collapse_order_by} = \@$prefetch_ordering;
3023   }
3024
3025   # if both page and offset are specified, produce a combined offset
3026   # even though it doesn't make much sense, this is what pre 081xx has
3027   # been doing
3028   if (my $page = delete $attrs->{page}) {
3029     $attrs->{offset} =
3030       ($attrs->{rows} * ($page - 1))
3031             +
3032       ($attrs->{offset} || 0)
3033     ;
3034   }
3035
3036   return $self->{_attrs} = $attrs;
3037 }
3038
3039 sub _rollout_attr {
3040   my ($self, $attr) = @_;
3041
3042   if (ref $attr eq 'HASH') {
3043     return $self->_rollout_hash($attr);
3044   } elsif (ref $attr eq 'ARRAY') {
3045     return $self->_rollout_array($attr);
3046   } else {
3047     return [$attr];
3048   }
3049 }
3050
3051 sub _rollout_array {
3052   my ($self, $attr) = @_;
3053
3054   my @rolled_array;
3055   foreach my $element (@{$attr}) {
3056     if (ref $element eq 'HASH') {
3057       push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
3058     } elsif (ref $element eq 'ARRAY') {
3059       #  XXX - should probably recurse here
3060       push( @rolled_array, @{$self->_rollout_array($element)} );
3061     } else {
3062       push( @rolled_array, $element );
3063     }
3064   }
3065   return \@rolled_array;
3066 }
3067
3068 sub _rollout_hash {
3069   my ($self, $attr) = @_;
3070
3071   my @rolled_array;
3072   foreach my $key (keys %{$attr}) {
3073     push( @rolled_array, { $key => $attr->{$key} } );
3074   }
3075   return \@rolled_array;
3076 }
3077
3078 sub _calculate_score {
3079   my ($self, $a, $b) = @_;
3080
3081   if (defined $a xor defined $b) {
3082     return 0;
3083   }
3084   elsif (not defined $a) {
3085     return 1;
3086   }
3087
3088   if (ref $b eq 'HASH') {
3089     my ($b_key) = keys %{$b};
3090     if (ref $a eq 'HASH') {
3091       my ($a_key) = keys %{$a};
3092       if ($a_key eq $b_key) {
3093         return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
3094       } else {
3095         return 0;
3096       }
3097     } else {
3098       return ($a eq $b_key) ? 1 : 0;
3099     }
3100   } else {
3101     if (ref $a eq 'HASH') {
3102       my ($a_key) = keys %{$a};
3103       return ($b eq $a_key) ? 1 : 0;
3104     } else {
3105       return ($b eq $a) ? 1 : 0;
3106     }
3107   }
3108 }
3109
3110 sub _merge_attr {
3111   my ($self, $orig, $import) = @_;
3112
3113   return $import unless defined($orig);
3114   return $orig unless defined($import);
3115
3116   $orig = $self->_rollout_attr($orig);
3117   $import = $self->_rollout_attr($import);
3118
3119   my $seen_keys;
3120   foreach my $import_element ( @{$import} ) {
3121     # find best candidate from $orig to merge $b_element into
3122     my $best_candidate = { position => undef, score => 0 }; my $position = 0;
3123     foreach my $orig_element ( @{$orig} ) {
3124       my $score = $self->_calculate_score( $orig_element, $import_element );
3125       if ($score > $best_candidate->{score}) {
3126         $best_candidate->{position} = $position;
3127         $best_candidate->{score} = $score;
3128       }
3129       $position++;
3130     }
3131     my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
3132
3133     if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
3134       push( @{$orig}, $import_element );
3135     } else {
3136       my $orig_best = $orig->[$best_candidate->{position}];
3137       # merge orig_best and b_element together and replace original with merged
3138       if (ref $orig_best ne 'HASH') {
3139         $orig->[$best_candidate->{position}] = $import_element;
3140       } elsif (ref $import_element eq 'HASH') {
3141         my ($key) = keys %{$orig_best};
3142         $orig->[$best_candidate->{position}] = { $key => $self->_merge_attr($orig_best->{$key}, $import_element->{$key}) };
3143       }
3144     }
3145     $seen_keys->{$import_key} = 1; # don't merge the same key twice
3146   }
3147
3148   return $orig;
3149 }
3150
3151 sub result_source {
3152     my $self = shift;
3153
3154     if (@_) {
3155         $self->_source_handle($_[0]->handle);
3156     } else {
3157         $self->_source_handle->resolve;
3158     }
3159 }
3160
3161 =head2 throw_exception
3162
3163 See L<DBIx::Class::Schema/throw_exception> for details.
3164
3165 =cut
3166
3167 sub throw_exception {
3168   my $self=shift;
3169
3170   if (ref $self && $self->_source_handle->schema) {
3171     $self->_source_handle->schema->throw_exception(@_)
3172   }
3173   else {
3174     DBIx::Class::Exception->throw(@_);
3175   }
3176 }
3177
3178 # XXX: FIXME: Attributes docs need clearing up
3179
3180 =head1 ATTRIBUTES
3181
3182 Attributes are used to refine a ResultSet in various ways when
3183 searching for data. They can be passed to any method which takes an
3184 C<\%attrs> argument. See L</search>, L</search_rs>, L</find>,
3185 L</count>.
3186
3187 These are in no particular order:
3188
3189 =head2 order_by
3190
3191 =over 4
3192
3193 =item Value: ( $order_by | \@order_by | \%order_by )
3194
3195 =back
3196
3197 Which column(s) to order the results by.
3198
3199 [The full list of suitable values is documented in
3200 L<SQL::Abstract/"ORDER BY CLAUSES">; the following is a summary of
3201 common options.]
3202
3203 If a single column name, or an arrayref of names is supplied, the
3204 argument is passed through directly to SQL. The hashref syntax allows
3205 for connection-agnostic specification of ordering direction:
3206
3207  For descending order:
3208
3209   order_by => { -desc => [qw/col1 col2 col3/] }
3210
3211  For explicit ascending order:
3212
3213   order_by => { -asc => 'col' }
3214
3215 The old scalarref syntax (i.e. order_by => \'year DESC') is still
3216 supported, although you are strongly encouraged to use the hashref
3217 syntax as outlined above.
3218
3219 =head2 columns
3220
3221 =over 4
3222
3223 =item Value: \@columns
3224
3225 =back
3226
3227 Shortcut to request a particular set of columns to be retrieved. Each
3228 column spec may be a string (a table column name), or a hash (in which
3229 case the key is the C<as> value, and the value is used as the C<select>
3230 expression). Adds C<me.> onto the start of any column without a C<.> in
3231 it and sets C<select> from that, then auto-populates C<as> from
3232 C<select> as normal. (You may also use the C<cols> attribute, as in
3233 earlier versions of DBIC.)
3234
3235 =head2 +columns
3236
3237 =over 4
3238
3239 =item Value: \@columns
3240
3241 =back
3242
3243 Indicates additional columns to be selected from storage. Works the same
3244 as L</columns> but adds columns to the selection. (You may also use the
3245 C<include_columns> attribute, as in earlier versions of DBIC). For
3246 example:-
3247
3248   $schema->resultset('CD')->search(undef, {
3249     '+columns' => ['artist.name'],
3250     join => ['artist']
3251   });
3252
3253 would return all CDs and include a 'name' column to the information
3254 passed to object inflation. Note that the 'artist' is the name of the
3255 column (or relationship) accessor, and 'name' is the name of the column
3256 accessor in the related table.
3257
3258 =head2 include_columns
3259
3260 =over 4
3261
3262 =item Value: \@columns
3263
3264 =back
3265
3266 Deprecated.  Acts as a synonym for L</+columns> for backward compatibility.
3267
3268 =head2 select
3269
3270 =over 4
3271
3272 =item Value: \@select_columns
3273
3274 =back
3275
3276 Indicates which columns should be selected from the storage. You can use
3277 column names, or in the case of RDBMS back ends, function or stored procedure
3278 names:
3279
3280   $rs = $schema->resultset('Employee')->search(undef, {
3281     select => [
3282       'name',
3283       { count => 'employeeid' },
3284       { max => { length => 'name' }, -as => 'longest_name' }
3285     ]
3286   });
3287
3288   # Equivalent SQL
3289   SELECT name, COUNT( employeeid ), MAX( LENGTH( name ) ) AS longest_name FROM employee
3290
3291 B<NOTE:> You will almost always need a corresponding L</as> attribute when you
3292 use L</select>, to instruct DBIx::Class how to store the result of the column.
3293 Also note that the L</as> attribute has nothing to do with the SQL-side 'AS'
3294 identifier aliasing. You can however alias a function, so you can use it in
3295 e.g. an C<ORDER BY> clause. This is done via the C<-as> B<select function
3296 attribute> supplied as shown in the example above.
3297
3298 =head2 +select
3299
3300 =over 4
3301
3302 Indicates additional columns to be selected from storage.  Works the same as
3303 L</select> but adds columns to the default selection, instead of specifying
3304 an explicit list.
3305
3306 =back
3307
3308 =head2 +as
3309
3310 =over 4
3311
3312 Indicates additional column names for those added via L</+select>. See L</as>.
3313
3314 =back
3315
3316 =head2 as
3317
3318 =over 4
3319
3320 =item Value: \@inflation_names
3321
3322 =back
3323
3324 Indicates column names for object inflation. That is L</as> indicates the
3325 slot name in which the column value will be stored within the
3326 L<Row|DBIx::Class::Row> object. The value will then be accessible via this
3327 identifier by the C<get_column> method (or via the object accessor B<if one
3328 with the same name already exists>) as shown below. The L</as> attribute has
3329 B<nothing to do> with the SQL-side C<AS>. See L</select> for details.
3330
3331   $rs = $schema->resultset('Employee')->search(undef, {
3332     select => [
3333       'name',
3334       { count => 'employeeid' },
3335       { max => { length => 'name' }, -as => 'longest_name' }
3336     ],
3337     as => [qw/
3338       name
3339       employee_count
3340       max_name_length
3341     /],
3342   });
3343
3344 If the object against which the search is performed already has an accessor
3345 matching a column name specified in C<as>, the value can be retrieved using
3346 the accessor as normal:
3347
3348   my $name = $employee->name();
3349
3350 If on the other hand an accessor does not exist in the object, you need to
3351 use C<get_column> instead:
3352
3353   my $employee_count = $employee->get_column('employee_count');
3354
3355 You can create your own accessors if required - see
3356 L<DBIx::Class::Manual::Cookbook> for details.
3357
3358 =head2 join
3359
3360 =over 4
3361
3362 =item Value: ($rel_name | \@rel_names | \%rel_names)
3363
3364 =back
3365
3366 Contains a list of relationships that should be joined for this query.  For
3367 example:
3368
3369   # Get CDs by Nine Inch Nails
3370   my $rs = $schema->resultset('CD')->search(
3371     { 'artist.name' => 'Nine Inch Nails' },
3372     { join => 'artist' }
3373   );
3374
3375 Can also contain a hash reference to refer to the other relation's relations.
3376 For example:
3377
3378   package MyApp::Schema::Track;
3379   use base qw/DBIx::Class/;
3380   __PACKAGE__->table('track');
3381   __PACKAGE__->add_columns(qw/trackid cd position title/);
3382   __PACKAGE__->set_primary_key('trackid');
3383   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
3384   1;
3385
3386   # In your application
3387   my $rs = $schema->resultset('Artist')->search(
3388     { 'track.title' => 'Teardrop' },
3389     {
3390       join     => { cd => 'track' },
3391       order_by => 'artist.name',
3392     }
3393   );
3394
3395 You need to use the relationship (not the table) name in  conditions,
3396 because they are aliased as such. The current table is aliased as "me", so
3397 you need to use me.column_name in order to avoid ambiguity. For example:
3398
3399   # Get CDs from 1984 with a 'Foo' track
3400   my $rs = $schema->resultset('CD')->search(
3401     {
3402       'me.year' => 1984,
3403       'tracks.name' => 'Foo'
3404     },
3405     { join => 'tracks' }
3406   );
3407
3408 If the same join is supplied twice, it will be aliased to <rel>_2 (and
3409 similarly for a third time). For e.g.
3410
3411   my $rs = $schema->resultset('Artist')->search({
3412     'cds.title'   => 'Down to Earth',
3413     'cds_2.title' => 'Popular',
3414   }, {
3415     join => [ qw/cds cds/ ],
3416   });
3417
3418 will return a set of all artists that have both a cd with title 'Down
3419 to Earth' and a cd with title 'Popular'.
3420
3421 If you want to fetch related objects from other tables as well, see C<prefetch>
3422 below.
3423
3424 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
3425
3426 =head2 prefetch
3427
3428 =over 4
3429
3430 =item Value: ($rel_name | \@rel_names | \%rel_names)
3431
3432 =back
3433
3434 Contains one or more relationships that should be fetched along with
3435 the main query (when they are accessed afterwards the data will
3436 already be available, without extra queries to the database).  This is
3437 useful for when you know you will need the related objects, because it
3438 saves at least one query:
3439
3440   my $rs = $schema->resultset('Tag')->search(
3441     undef,
3442     {
3443       prefetch => {
3444         cd => 'artist'
3445       }
3446     }
3447   );
3448
3449 The initial search results in SQL like the following:
3450
3451   SELECT tag.*, cd.*, artist.* FROM tag
3452   JOIN cd ON tag.cd = cd.cdid
3453   JOIN artist ON cd.artist = artist.artistid
3454
3455 L<DBIx::Class> has no need to go back to the database when we access the
3456 C<cd> or C<artist> relationships, which saves us two SQL statements in this
3457 case.
3458
3459 Simple prefetches will be joined automatically, so there is no need
3460 for a C<join> attribute in the above search.
3461
3462 C<prefetch> can be used with the following relationship types: C<belongs_to>,
3463 C<has_one> (or if you're using C<add_relationship>, any relationship declared
3464 with an accessor type of 'single' or 'filter'). A more complex example that
3465 prefetches an artists cds, the tracks on those cds, and the tags associated
3466 with that artist is given below (assuming many-to-many from artists to tags):
3467
3468  my $rs = $schema->resultset('Artist')->search(
3469    undef,
3470    {
3471      prefetch => [
3472        { cds => 'tracks' },
3473        { artist_tags => 'tags' }
3474      ]
3475    }
3476  );
3477
3478
3479 B<NOTE:> If you specify a C<prefetch> attribute, the C<join> and C<select>
3480 attributes will be ignored.
3481
3482 B<CAVEATs>: Prefetch does a lot of deep magic. As such, it may not behave
3483 exactly as you might expect.
3484
3485 =over 4
3486
3487 =item *
3488
3489 Prefetch uses the L</cache> to populate the prefetched relationships. This
3490 may or may not be what you want.
3491
3492 =item *
3493
3494 If you specify a condition on a prefetched relationship, ONLY those
3495 rows that match the prefetched condition will be fetched into that relationship.
3496 This means that adding prefetch to a search() B<may alter> what is returned by
3497 traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
3498
3499   my $artist_rs = $schema->resultset('Artist')->search({
3500       'cds.year' => 2008,
3501   }, {
3502       join => 'cds',
3503   });
3504
3505   my $count = $artist_rs->first->cds->count;
3506
3507   my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
3508
3509   my $prefetch_count = $artist_rs_prefetch->first->cds->count;
3510
3511   cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
3512
3513 that cmp_ok() may or may not pass depending on the datasets involved. This
3514 behavior may or may not survive the 0.09 transition.
3515
3516 =back
3517
3518 =head2 page
3519
3520 =over 4
3521
3522 =item Value: $page
3523
3524 =back
3525
3526 Makes the resultset paged and specifies the page to retrieve. Effectively
3527 identical to creating a non-pages resultset and then calling ->page($page)
3528 on it.
3529
3530 If L<rows> attribute is not specified it defaults to 10 rows per page.
3531
3532 When you have a paged resultset, L</count> will only return the number
3533 of rows in the page. To get the total, use the L</pager> and call
3534 C<total_entries> on it.
3535
3536 =head2 rows
3537
3538 =over 4
3539
3540 =item Value: $rows
3541
3542 =back
3543
3544 Specifies the maximum number of rows for direct retrieval or the number of
3545 rows per page if the page attribute or method is used.
3546
3547 =head2 offset
3548
3549 =over 4
3550
3551 =item Value: $offset
3552
3553 =back
3554
3555 Specifies the (zero-based) row number for the  first row to be returned, or the
3556 of the first row of the first page if paging is used.
3557
3558 =head2 group_by
3559
3560 =over 4
3561
3562 =item Value: \@columns
3563
3564 =back
3565
3566 A arrayref of columns to group by. Can include columns of joined tables.
3567
3568   group_by => [qw/ column1 column2 ... /]
3569
3570 =head2 having
3571
3572 =over 4
3573
3574 =item Value: $condition
3575
3576 =back
3577
3578 HAVING is a select statement attribute that is applied between GROUP BY and
3579 ORDER BY. It is applied to the after the grouping calculations have been
3580 done.
3581
3582   having => { 'count(employee)' => { '>=', 100 } }
3583
3584 =head2 distinct
3585
3586 =over 4
3587
3588 =item Value: (0 | 1)
3589
3590 =back
3591
3592 Set to 1 to group by all columns. If the resultset already has a group_by
3593 attribute, this setting is ignored and an appropriate warning is issued.
3594
3595 =head2 where
3596
3597 =over 4
3598
3599 Adds to the WHERE clause.
3600
3601   # only return rows WHERE deleted IS NULL for all searches
3602   __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
3603
3604 Can be overridden by passing C<< { where => undef } >> as an attribute
3605 to a resultset.
3606
3607 =back
3608
3609 =head2 cache
3610
3611 Set to 1 to cache search results. This prevents extra SQL queries if you
3612 revisit rows in your ResultSet:
3613
3614   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
3615
3616   while( my $artist = $resultset->next ) {
3617     ... do stuff ...
3618   }
3619
3620   $rs->first; # without cache, this would issue a query
3621
3622 By default, searches are not cached.
3623
3624 For more examples of using these attributes, see
3625 L<DBIx::Class::Manual::Cookbook>.
3626
3627 =head2 for
3628
3629 =over 4
3630
3631 =item Value: ( 'update' | 'shared' )
3632
3633 =back
3634
3635 Set to 'update' for a SELECT ... FOR UPDATE or 'shared' for a SELECT
3636 ... FOR SHARED.
3637
3638 =cut
3639
3640 1;