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