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