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