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