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