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