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