File Coverage

blib/lib/DBIx/Class/ResultSet.pm
Criterion Covered Total %
statement 978 1061 92.1
branch 556 672 82.7
condition 256 355 72.1
subroutine 89 96 92.7
pod 43 45 95.5
total 1922 2229 86.2


line stmt bran cond sub pod time code
1             package DBIx::Class::ResultSet;
2              
3 379     379   4289 use strict;
  379         1255  
  379         11403  
4 379     379   2070 use warnings;
  379         1184  
  379         10663  
5 379     379   2153 use base qw/DBIx::Class/;
  379         1169  
  379         41215  
6 379     379   3109 use DBIx::Class::Carp;
  379         1151  
  379         3149  
7 379     379   172394 use DBIx::Class::ResultSetColumn;
  379         1381  
  379         15565  
8 379     379   2910 use Scalar::Util qw/blessed weaken reftype/;
  379         1156  
  379         22645  
9 379         18880 use DBIx::Class::_Util qw(
10             fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION
11 379     379   2643 );
  379         1171  
12 379     379   2531 use Try::Tiny;
  379         1162  
  379         18687  
13              
14             # not importing first() as it will clash with our own method
15 379     379   2485 use List::Util ();
  379         1221  
  379         17979  
16              
17             BEGIN {
18             # De-duplication in _merge_attr() is disabled, but left in for reference
19             # (the merger is used for other things that ought not to be de-duped)
20 379     379   7877 *__HM_DEDUP = sub () { 0 };
21             }
22              
23             # FIXME - get rid of this
24 379     379   199761 use Hash::Merge ();
  379         1743701  
  379         9136  
25              
26 379     379   3163 use namespace::clean;
  379         1190  
  379         2668  
27              
28             use overload
29 379         3881 '0+' => "count",
30             'bool' => "_bool",
31 379     379   135142 fallback => 1;
  379         1224  
32              
33             # this is real - CDBICompat overrides it with insanity
34             # yes, prototype won't matter, but that's for now ;)
35             sub _bool () { 1 }
36              
37             __PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/);
38              
39             =head1 NAME
40              
41             DBIx::Class::ResultSet - Represents a query used for fetching a set of results.
42              
43             =head1 SYNOPSIS
44              
45             my $users_rs = $schema->resultset('User');
46             while( $user = $users_rs->next) {
47             print $user->username;
48             }
49              
50             my $registered_users_rs = $schema->resultset('User')->search({ registered => 1 });
51             my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all();
52              
53             =head1 DESCRIPTION
54              
55             A ResultSet is an object which stores a set of conditions representing
56             a query. It is the backbone of DBIx::Class (i.e. the really
57             important/useful bit).
58              
59             No SQL is executed on the database when a ResultSet is created, it
60             just stores all the conditions needed to create the query.
61              
62             A basic ResultSet representing the data of an entire table is returned
63             by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
64             L<Source|DBIx::Class::Manual::Glossary/ResultSource> name.
65              
66             my $users_rs = $schema->resultset('User');
67              
68             A new ResultSet is returned from calling L</search> on an existing
69             ResultSet. The new one will contain all the conditions of the
70             original, plus any new conditions added in the C<search> call.
71              
72             A ResultSet also incorporates an implicit iterator. L</next> and L</reset>
73             can be used to walk through all the L<DBIx::Class::Row>s the ResultSet
74             represents.
75              
76             The query that the ResultSet represents is B<only> executed against
77             the database when these methods are called:
78             L</find>, L</next>, L</all>, L</first>, L</single>, L</count>.
79              
80             If a resultset is used in a numeric context it returns the L</count>.
81             However, if it is used in a boolean context it is B<always> true. So if
82             you want to check if a resultset has any results, you must use C<if $rs
83             != 0>.
84              
85             =head1 EXAMPLES
86              
87             =head2 Chaining resultsets
88              
89             Let's say you've got a query that needs to be run to return some data
90             to the user. But, you have an authorization system in place that
91             prevents certain users from seeing certain information. So, you want
92             to construct the basic query in one method, but add constraints to it in
93             another.
94              
95             sub get_data {
96             my $self = shift;
97             my $request = $self->get_request; # Get a request object somehow.
98             my $schema = $self->result_source->schema;
99              
100             my $cd_rs = $schema->resultset('CD')->search({
101             title => $request->param('title'),
102             year => $request->param('year'),
103             });
104              
105             $cd_rs = $self->apply_security_policy( $cd_rs );
106              
107             return $cd_rs->all();
108             }
109              
110             sub apply_security_policy {
111             my $self = shift;
112             my ($rs) = @_;
113              
114             return $rs->search({
115             subversive => 0,
116             });
117             }
118              
119             =head3 Resolving conditions and attributes
120              
121             When a resultset is chained from another resultset (e.g.:
122             C<< my $new_rs = $old_rs->search(\%extra_cond, \%attrs) >>), conditions
123             and attributes with the same keys need resolving.
124              
125             If any of L</columns>, L</select>, L</as> are present, they reset the
126             original selection, and start the selection "clean".
127              
128             The L</join>, L</prefetch>, L</+columns>, L</+select>, L</+as> attributes
129             are merged into the existing ones from the original resultset.
130              
131             The L</where> and L</having> attributes, and any search conditions, are
132             merged with an SQL C<AND> to the existing condition from the original
133             resultset.
134              
135             All other attributes are overridden by any new ones supplied in the
136             search attributes.
137              
138             =head2 Multiple queries
139              
140             Since a resultset just defines a query, you can do all sorts of
141             things with it with the same object.
142              
143             # Don't hit the DB yet.
144             my $cd_rs = $schema->resultset('CD')->search({
145             title => 'something',
146             year => 2009,
147             });
148              
149             # Each of these hits the DB individually.
150             my $count = $cd_rs->count;
151             my $most_recent = $cd_rs->get_column('date_released')->max();
152             my @records = $cd_rs->all;
153              
154             And it's not just limited to SELECT statements.
155              
156             $cd_rs->delete();
157              
158             This is even cooler:
159              
160             $cd_rs->create({ artist => 'Fred' });
161              
162             Which is the same as:
163              
164             $schema->resultset('CD')->create({
165             title => 'something',
166             year => 2009,
167             artist => 'Fred'
168             });
169              
170             See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
171              
172             =head2 Custom ResultSet classes
173              
174             To add methods to your resultsets, you can subclass L<DBIx::Class::ResultSet>, similar to:
175              
176             package MyApp::Schema::ResultSet::User;
177              
178             use strict;
179             use warnings;
180              
181             use base 'DBIx::Class::ResultSet';
182              
183             sub active {
184             my $self = shift;
185             $self->search({ $self->current_source_alias . '.active' => 1 });
186             }
187              
188             sub unverified {
189             my $self = shift;
190             $self->search({ $self->current_source_alias . '.verified' => 0 });
191             }
192              
193             sub created_n_days_ago {
194             my ($self, $days_ago) = @_;
195             $self->search({
196             $self->current_source_alias . '.create_date' => {
197             '<=',
198             $self->result_source->schema->storage->datetime_parser->format_datetime(
199             DateTime->now( time_zone => 'UTC' )->subtract( days => $days_ago )
200             )}
201             });
202             }
203              
204             sub users_to_warn { shift->active->unverified->created_n_days_ago(7) }
205              
206             1;
207              
208             See L<DBIx::Class::Schema/load_namespaces> on how DBIC can discover and
209             automatically attach L<Result|DBIx::Class::Manual::ResultClass>-specific
210             L<ResulSet|DBIx::Class::ResultSet> classes.
211              
212             =head3 ResultSet subclassing with Moose and similar constructor-providers
213              
214             Using L<Moose> or L<Moo> in your ResultSet classes is usually overkill, but
215             you may find it useful if your ResultSets contain a lot of business logic
216             (e.g. C<has xml_parser>, C<has json>, etc) or if you just prefer to organize
217             your code via roles.
218              
219             In order to write custom ResultSet classes with L<Moo> you need to use the
220             following template. The L<BUILDARGS|Moo/BUILDARGS> is necessary due to the
221             unusual signature of the L<constructor provided by DBIC
222             |DBIx::Class::ResultSet/new> C<< ->new($source, \%args) >>.
223              
224             use Moo;
225             extends 'DBIx::Class::ResultSet';
226             sub BUILDARGS { $_[2] } # ::RS::new() expects my ($class, $rsrc, $args) = @_
227              
228             ...your code...
229              
230             1;
231              
232             If you want to build your custom ResultSet classes with L<Moose>, you need
233             a similar, though a little more elaborate template in order to interface the
234             inlining of the L<Moose>-provided
235             L<object constructor|Moose::Manual::Construction/WHERE'S THE CONSTRUCTOR?>,
236             with the DBIC one.
237              
238             package MyApp::Schema::ResultSet::User;
239              
240             use Moose;
241             use MooseX::NonMoose;
242             extends 'DBIx::Class::ResultSet';
243              
244             sub BUILDARGS { $_[2] } # ::RS::new() expects my ($class, $rsrc, $args) = @_
245              
246             ...your code...
247              
248             __PACKAGE__->meta->make_immutable;
249              
250             1;
251              
252             The L<MooseX::NonMoose> is necessary so that the L<Moose> constructor does not
253             entirely overwrite the DBIC one (in contrast L<Moo> does this automatically).
254             Alternatively, you can skip L<MooseX::NonMoose> and get by with just L<Moose>
255             instead by doing:
256              
257             __PACKAGE__->meta->make_immutable(inline_constructor => 0);
258              
259             =head1 METHODS
260              
261             =head2 new
262              
263             =over 4
264              
265             =item Arguments: L<$source|DBIx::Class::ResultSource>, L<\%attrs?|/ATTRIBUTES>
266              
267             =item Return Value: L<$resultset|/search>
268              
269             =back
270              
271             The resultset constructor. Takes a source object (usually a
272             L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
273             L</ATTRIBUTES> below). Does not perform any queries -- these are
274             executed as needed by the other methods.
275              
276             Generally you never construct a resultset manually. Instead you get one
277             from e.g. a
278             C<< $schema->L<resultset|DBIx::Class::Schema/resultset>('$source_name') >>
279             or C<< $another_resultset->L<search|/search>(...) >> (the later called in
280             scalar context):
281              
282             my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
283              
284             =over
285              
286             =item WARNING
287              
288             If called on an object, proxies to L</new_result> instead, so
289              
290             my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
291              
292             will return a CD object, not a ResultSet, and is equivalent to:
293              
294             my $cd = $schema->resultset('CD')->new_result({ title => 'Spoon' });
295              
296             Please also keep in mind that many internals call L</new_result> directly,
297             so overloading this method with the idea of intercepting new result object
298             creation B<will not work>. See also warning pertaining to L</create>.
299              
300             =back
301              
302             =cut
303              
304             sub new {
305 33104     33104 1 65296 my $class = shift;
306              
307 33104 100       75567 if (ref $class) {
308 21         130 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
309 21         129 return $class->new_result(@_);
310             }
311              
312 33083         64866 my ($source, $attrs) = @_;
313 33083 100       170574 $source = $source->resolve
314             if $source->isa('DBIx::Class::ResultSourceHandle');
315              
316 33083 100       50193 $attrs = { %{$attrs||{}} };
  33083         146505  
317 33083         64212 delete @{$attrs}{qw(_last_sqlmaker_alias_map _simple_passthrough_construction)};
  33083         66214  
318              
319 33083 100       76637 if ($attrs->{page}) {
320 26   100     122 $attrs->{rows} ||= 10;
321             }
322              
323 33083   100     115879 $attrs->{alias} ||= 'me';
324              
325             my $self = bless {
326             result_source => $source,
327             cond => $attrs->{where},
328 33083         131822 pager => undef,
329             attrs => $attrs,
330             }, $class;
331              
332             # if there is a dark selector, this means we are already in a
333             # chain and the cleanup/sanification was taken care of by
334             # _search_rs already
335             $self->_normalize_selection($attrs)
336 33083 100       124848 unless $attrs->{_dark_selector};
337              
338             $self->result_class(
339 33083   66     798302 $attrs->{result_class} || $source->result_class
340             );
341              
342 33081         160816 $self;
343             }
344              
345             =head2 search
346              
347             =over 4
348              
349             =item Arguments: L<$cond|DBIx::Class::SQLMaker> | undef, L<\%attrs?|/ATTRIBUTES>
350              
351             =item Return Value: $resultset (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
352              
353             =back
354              
355             my @cds = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
356             my $new_rs = $cd_rs->search({ year => 2005 });
357              
358             my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
359             # year = 2005 OR year = 2004
360              
361             In list context, C<< ->all() >> is called implicitly on the resultset, thus
362             returning a list of L<result|DBIx::Class::Manual::ResultClass> objects instead.
363             To avoid that, use L</search_rs>.
364              
365             If you need to pass in additional attributes but no additional condition,
366             call it as C<search(undef, \%attrs)>.
367              
368             # "SELECT name, artistid FROM $artist_table"
369             my @all_artists = $schema->resultset('Artist')->search(undef, {
370             columns => [qw/name artistid/],
371             });
372              
373             For a list of attributes that can be passed to C<search>, see
374             L</ATTRIBUTES>. For more examples of using this function, see
375             L<Searching|DBIx::Class::Manual::Cookbook/SEARCHING>. For a complete
376             documentation for the first argument, see L<SQL::Abstract/"WHERE CLAUSES">
377             and its extension L<DBIx::Class::SQLMaker>.
378              
379             For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
380              
381             =head3 CAVEAT
382              
383             Note that L</search> does not process/deflate any of the values passed in the
384             L<SQL::Abstract>-compatible search condition structure. This is unlike other
385             condition-bound methods L</new_result>, L</create> and L</find>. The user must ensure
386             manually that any value passed to this method will stringify to something the
387             RDBMS knows how to deal with. A notable example is the handling of L<DateTime>
388             objects, for more info see:
389             L<DBIx::Class::Manual::Cookbook/Formatting DateTime objects in queries>.
390              
391             =cut
392              
393             sub search {
394 16563     16563 1 965218 my $self = shift;
395 16563         40349 my $rs = $self->search_rs( @_ );
396              
397 16555 100       45264 if (wantarray) {
    100          
398 85         169 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray;
399 85         336 return $rs->all;
400             }
401             elsif (defined wantarray) {
402 16469         90957 return $rs;
403             }
404             else {
405             # we can be called by a relationship helper, which in
406             # turn may be called in void context due to some braindead
407             # overload or whatever else the user decided to be clever
408             # at this particular day. Thus limit the exception to
409             # external code calls only
410 1 50       5 $self->throw_exception ('->search is *not* a mutator, calling it in void context makes no sense')
411             if (caller)[0] !~ /^\QDBIx::Class::/;
412              
413 0         0 return ();
414             }
415             }
416              
417             =head2 search_rs
418              
419             =over 4
420              
421             =item Arguments: L<$cond|DBIx::Class::SQLMaker>, L<\%attrs?|/ATTRIBUTES>
422              
423             =item Return Value: L<$resultset|/search>
424              
425             =back
426              
427             This method does the same exact thing as search() except it will
428             always return a resultset, even in list context.
429              
430             =cut
431              
432             sub search_rs {
433 17554     17554 1 28917 my $self = shift;
434              
435 17554         36156 my $rsrc = $self->result_source;
436 17554         29634 my ($call_cond, $call_attrs);
437              
438             # Special-case handling for (undef, undef) or (undef)
439             # Note that (foo => undef) is valid deprecated syntax
440 17554 100       36112 @_ = () if not scalar grep { defined $_ } @_;
  22607         63434  
441              
442             # just a cond
443 17554 100 100     85141 if (@_ == 1) {
    100 66        
    100          
    100          
444 5601         9194 $call_cond = shift;
445             }
446             # fish out attrs in the ($condref, $attr) case
447             elsif (@_ == 2 and ( ! defined $_[0] or (ref $_[0]) ne '') ) {
448 8493         18425 ($call_cond, $call_attrs) = @_;
449             }
450             elsif (@_ % 2) {
451 6         20 $self->throw_exception('Odd number of arguments to search')
452             }
453             # legacy search
454             elsif (@_) {
455 1 50       23 carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead'
456             unless $rsrc->result_class->isa('DBIx::Class::CDBICompat');
457              
458 1         114 for my $i (0 .. $#_) {
459 2 100       7 next if $i % 2;
460 1 50 33     10 $self->throw_exception ('All keys in condition key/value pairs must be plain scalars')
461             if (! defined $_[$i] or ref $_[$i] ne '');
462             }
463              
464 1         5 $call_cond = { @_ };
465             }
466              
467             # see if we can keep the cache (no $rs changes)
468 17548         24415 my $cache;
469 17548         47734 my %safe = (alias => 1, cache => 1);
470 17548 100 66 8610   152511 if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and (
  8610   66     27666  
471             ! defined $call_cond
472             or
473             ref $call_cond eq 'HASH' && ! keys %$call_cond
474             or
475             ref $call_cond eq 'ARRAY' && ! @$call_cond
476             )) {
477 3649         9387 $cache = $self->get_cache;
478             }
479              
480 17548         50946 my $old_attrs = { %{$self->{attrs}} };
  17548         77222  
481 17548         33818 my ($old_having, $old_where) = delete @{$old_attrs}{qw(having where)};
  17548         46261  
482              
483 17548         56723 my $new_attrs = { %$old_attrs };
484              
485             # take care of call attrs (only if anything is changing)
486 17548 100 66     74271 if ($call_attrs and keys %$call_attrs) {
487              
488             # copy for _normalize_selection
489 8488         26368 $call_attrs = { %$call_attrs };
490              
491 8488         27157 my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/;
492              
493             # reset the current selector list if new selectors are supplied
494 8488 100   30000   29951 if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) {
  30000         51010  
495 1655         3274 delete @{$old_attrs}{(@selector_attrs, '_dark_selector')};
  1655         4864  
496             }
497              
498             # Normalize the new selector list (operates on the passed-in attr structure)
499             # Need to do it on every chain instead of only once on _resolved_attrs, in
500             # order to allow detection of empty vs partial 'as'
501             $call_attrs->{_dark_selector} = $old_attrs->{_dark_selector}
502 8488 100       27074 if $old_attrs->{_dark_selector};
503 8488         24558 $self->_normalize_selection ($call_attrs);
504              
505             # start with blind overwriting merge, exclude selector attrs
506 8486         13548 $new_attrs = { %{$old_attrs}, %{$call_attrs} };
  8486         19004  
  8486         37160  
507 8486         17653 delete @{$new_attrs}{@selector_attrs};
  8486         20890  
508              
509 8486         16550 for (@selector_attrs) {
510             $new_attrs->{$_} = $self->_merge_attr($old_attrs->{$_}, $call_attrs->{$_})
511 67888 100 100     208611 if ( exists $old_attrs->{$_} or exists $call_attrs->{$_} );
512             }
513              
514             # older deprecated name, use only if {columns} is not there
515 8486 100       22822 if (my $c = delete $new_attrs->{cols}) {
516 1         8 carp_unique( "Resultset attribute 'cols' is deprecated, use 'columns' instead" );
517 1 50       127 if ($new_attrs->{columns}) {
518 0         0 carp "Resultset specifies both the 'columns' and the legacy 'cols' attributes - ignoring 'cols'";
519             }
520             else {
521 1         3 $new_attrs->{columns} = $c;
522             }
523             }
524              
525              
526             # join/prefetch use their own crazy merging heuristics
527 8486         15706 foreach my $key (qw/join prefetch/) {
528             $new_attrs->{$key} = $self->_merge_joinpref_attr($old_attrs->{$key}, $call_attrs->{$key})
529 16972 100       37818 if exists $call_attrs->{$key};
530             }
531              
532             # stack binds together
533 8486 100       12441 $new_attrs->{bind} = [ @{ $old_attrs->{bind} || [] }, @{ $call_attrs->{bind} || [] } ];
  8486 100       27854  
  8486         38409  
534             }
535              
536              
537 17546         36932 for ($old_where, $call_cond) {
538 35092 100       71064 if (defined $_) {
539             $new_attrs->{where} = $self->_stack_cond (
540             $_, $new_attrs->{where}
541 21787         65334 );
542             }
543             }
544              
545 17546 100       37543 if (defined $old_having) {
546             $new_attrs->{having} = $self->_stack_cond (
547             $old_having, $new_attrs->{having}
548             )
549 27         99 }
550              
551 17546         55463 my $rs = (ref $self)->new($rsrc, $new_attrs);
552              
553 17544 100       40372 $rs->set_cache($cache) if ($cache);
554              
555 17544         90198 return $rs;
556             }
557              
558             my $dark_sel_dumper;
559             sub _normalize_selection {
560 41544     41544   73193 my ($self, $attrs) = @_;
561              
562             # legacy syntax
563 41544 100       86114 if ( exists $attrs->{include_columns} ) {
564 1         8 carp_unique( "Resultset attribute 'include_columns' is deprecated, use '+columns' instead" );
565             $attrs->{'+columns'} = $self->_merge_attr(
566             $attrs->{'+columns'}, delete $attrs->{include_columns}
567 1         105 );
568             }
569              
570             # columns are always placed first, however
571              
572             # Keep the X vs +X separation until _resolved_attrs time - this allows to
573             # delay the decision on whether to use a default select list ($rsrc->columns)
574             # allowing stuff like the remove_columns helper to work
575             #
576             # select/as +select/+as pairs need special handling - the amount of select/as
577             # elements in each pair does *not* have to be equal (think multicolumn
578             # selectors like distinct(foo, bar) ). If the selector is bare (no 'as'
579             # supplied at all) - try to infer the alias, either from the -as parameter
580             # of the selector spec, or use the parameter whole if it looks like a column
581             # name (ugly legacy heuristic). If all fails - leave the selector bare (which
582             # is ok as well), but make sure no more additions to the 'as' chain take place
583 41544         79213 for my $pref ('', '+') {
584              
585             my ($sel, $as) = map {
586 83088         135897 my $key = "${pref}${_}";
  166176         268950  
587              
588             my $val = [ ref $attrs->{$key} eq 'ARRAY'
589 2370         5871 ? @{$attrs->{$key}}
590 166176 100 66     537736 : $attrs->{$key} || ()
591             ];
592 166176         251505 delete $attrs->{$key};
593 166176         320349 $val;
594             } qw/select as/;
595              
596 83088 100 100     276516 if (! @$as and ! @$sel ) {
    50 66        
    100 66        
    50          
    100          
597 80843         169386 next;
598             }
599             elsif (@$as and ! @$sel) {
600 0         0 $self->throw_exception(
601             "Unable to handle ${pref}as specification (@$as) without a corresponding ${pref}select"
602             );
603             }
604             elsif( ! @$as ) {
605             # no as part supplied at all - try to deduce (unless explicit end of named selection is declared)
606             # if any @$as has been supplied we assume the user knows what (s)he is doing
607             # and blindly keep stacking up pieces
608 601 100       1811 unless ($attrs->{_dark_selector}) {
609             SELECTOR:
610 596         1440 for (@$sel) {
611 664 100 100     5917 if ( ref $_ eq 'HASH' and exists $_->{-as} ) {
    100 66        
612 5         23 push @$as, $_->{-as};
613             }
614             # assume any plain no-space, no-parenthesis string to be a column spec
615             # FIXME - this is retarded but is necessary to support shit like 'count(foo)'
616             elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) {
617 638         2035 push @$as, $_;
618             }
619             # if all else fails - raise a flag that no more aliasing will be allowed
620             else {
621             $attrs->{_dark_selector} = {
622             plus_stage => $pref,
623 21   66     134 string => ($dark_sel_dumper ||= do {
624 9         97 require Data::Dumper::Concise;
625 9         60 Data::Dumper::Concise::DumperObject()->Indent(0);
626             })->Values([$_])->Dump
627             ,
628             };
629 21         2234 last SELECTOR;
630             }
631             }
632             }
633             }
634             elsif (@$as < @$sel) {
635 0         0 $self->throw_exception(
636             "Unable to handle an ${pref}as specification (@$as) with less elements than the corresponding ${pref}select"
637             );
638             }
639             elsif ($pref and $attrs->{_dark_selector}) {
640 2         20 $self->throw_exception(
641             "Unable to process named '+select', resultset contains an unnamed selector $attrs->{_dark_selector}{string}"
642             );
643             }
644              
645              
646             # merge result
647 2243         9970 $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel);
648 2243         10068 $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as);
649             }
650             }
651              
652             sub _stack_cond {
653 21814     21814   59687 my ($self, $left, $right) = @_;
654              
655             (
656             (ref $_ eq 'ARRAY' and !@$_)
657             or
658             (ref $_ eq 'HASH' and ! keys %$_)
659 21814   66     189984 ) and $_ = undef for ($left, $right);
      100        
660              
661             # either one of the two undef
662 21814 100 100     80475 if ( (defined $left) xor (defined $right) ) {
    100          
663 16921 100       65385 return defined $left ? $left : $right;
664             }
665             # both undef
666             elsif ( ! defined $left ) {
667             return undef
668 968         3215 }
669             else {
670 3925         15919 return $self->result_source->schema->storage->_collapse_cond({ -and => [$left, $right] });
671             }
672             }
673              
674             =head2 search_literal
675              
676             B<CAVEAT>: C<search_literal> is provided for Class::DBI compatibility and
677             should only be used in that context. C<search_literal> is a convenience
678             method. It is equivalent to calling C<< $schema->search(\[]) >>, but if you
679             want to ensure columns are bound correctly, use L</search>.
680              
681             See L<DBIx::Class::Manual::Cookbook/SEARCHING> and
682             L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
683             require C<search_literal>.
684              
685             =over 4
686              
687             =item Arguments: $sql_fragment, @standalone_bind_values
688              
689             =item Return Value: L<$resultset|/search> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
690              
691             =back
692              
693             my @cds = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
694             my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
695              
696             Pass a literal chunk of SQL to be added to the conditional part of the
697             resultset query.
698              
699             Example of how to use C<search> instead of C<search_literal>
700              
701             my @cds = $cd_rs->search_literal('cdid = ? AND (artist = ? OR artist = ?)', (2, 1, 2));
702             my @cds = $cd_rs->search(\[ 'cdid = ? AND (artist = ? OR artist = ?)', [ 'cdid', 2 ], [ 'artist', 1 ], [ 'artist', 2 ] ]);
703              
704             =cut
705              
706             sub search_literal {
707 1     1 1 6 my ($self, $sql, @bind) = @_;
708 1         2 my $attr;
709 1 50 33     5 if ( @bind && ref($bind[-1]) eq 'HASH' ) {
710 0         0 $attr = pop @bind;
711             }
712 1   33     13 return $self->search(\[ $sql, map [ {} => $_ ], @bind ], ($attr || () ));
713             }
714              
715             =head2 find
716              
717             =over 4
718              
719             =item Arguments: \%columns_values | @pk_values, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
720              
721             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
722              
723             =back
724              
725             Finds and returns a single row based on supplied criteria. Takes either a
726             hashref with the same format as L</create> (including inference of foreign
727             keys from related objects), or a list of primary key values in the same
728             order as the L<primary columns|DBIx::Class::ResultSource/primary_columns>
729             declaration on the L</result_source>.
730              
731             In either case an attempt is made to combine conditions already existing on
732             the resultset with the condition passed to this method.
733              
734             To aid with preparing the correct query for the storage you may supply the
735             C<key> attribute, which is the name of a
736             L<unique constraint|DBIx::Class::ResultSource/add_unique_constraint> (the
737             unique constraint corresponding to the
738             L<primary columns|DBIx::Class::ResultSource/primary_columns> is always named
739             C<primary>). If the C<key> attribute has been supplied, and DBIC is unable
740             to construct a query that satisfies the named unique constraint fully (
741             non-NULL values for each column member of the constraint) an exception is
742             thrown.
743              
744             If no C<key> is specified, the search is carried over all unique constraints
745             which are fully defined by the available condition.
746              
747             If no such constraint is found, C<find> currently defaults to a simple
748             C<< search->(\%column_values) >> which may or may not do what you expect.
749             Note that this fallback behavior may be deprecated in further versions. If
750             you need to search with arbitrary conditions - use L</search>. If the query
751             resulting from this fallback produces more than one row, a warning to the
752             effect is issued, though only the first row is constructed and returned as
753             C<$result_object>.
754              
755             In addition to C<key>, L</find> recognizes and applies standard
756             L<resultset attributes|/ATTRIBUTES> in the same way as L</search> does.
757              
758             Note that if you have extra concerns about the correctness of the resulting
759             query you need to specify the C<key> attribute and supply the entire condition
760             as an argument to find (since it is not always possible to perform the
761             combination of the resultset condition with the supplied one, especially if
762             the resultset condition contains literal sql).
763              
764             For example, to find a row by its primary key:
765              
766             my $cd = $schema->resultset('CD')->find(5);
767              
768             You can also find a row by a specific unique constraint:
769              
770             my $cd = $schema->resultset('CD')->find(
771             {
772             artist => 'Massive Attack',
773             title => 'Mezzanine',
774             },
775             { key => 'cd_artist_title' }
776             );
777              
778             See also L</find_or_create> and L</update_or_create>.
779              
780             =cut
781              
782             sub find {
783 1410     1410 1 50739 my $self = shift;
784 1410 100 100     7318 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
785              
786 1410         4359 my $rsrc = $self->result_source;
787              
788 1410         3129 my $constraint_name;
789 1410 100       4541 if (exists $attrs->{key}) {
790             $constraint_name = defined $attrs->{key}
791             ? $attrs->{key}
792 18 50       67 : $self->throw_exception("An undefined 'key' resultset attribute makes no sense")
793             ;
794             }
795              
796             # Parse out the condition from input
797 1410         2741 my $call_cond;
798              
799 1410 100       4537 if (ref $_[0] eq 'HASH') {
800 1180         2474 $call_cond = { %{$_[0]} };
  1180         4681  
801             }
802             else {
803             # if only values are supplied we need to default to 'primary'
804 230 100       897 $constraint_name = 'primary' unless defined $constraint_name;
805              
806 230         1516 my @c_cols = $rsrc->unique_constraint_columns($constraint_name);
807              
808 230 50       935 $self->throw_exception(
809             "No constraint columns, maybe a malformed '$constraint_name' constraint?"
810             ) unless @c_cols;
811              
812 230 100       898 $self->throw_exception (
813             'find() expects either a column/value hashref, or a list of values '
814             . "corresponding to the columns of the specified unique constraint '$constraint_name'"
815             ) unless @c_cols == @_;
816              
817 229         590 @{$call_cond}{@c_cols} = @_;
  229         882  
818             }
819              
820             # process relationship data if any
821 1409         5033 for my $key (keys %$call_cond) {
822 1305 100 100     5270 if (
      100        
823             length ref($call_cond->{$key})
824             and
825             my $relinfo = $rsrc->relationship_info($key)
826             and
827             # implicitly skip has_many's (likely MC)
828             (ref (my $val = delete $call_cond->{$key}) ne 'ARRAY' )
829             ) {
830             my ($rel_cond, $crosstable) = $rsrc->_resolve_condition(
831 21         124 $relinfo->{cond}, $val, $key, $key
832             );
833              
834 20 50 33     136 $self->throw_exception("Complex condition via relationship '$key' is unsupported in find()")
835             if $crosstable or ref($rel_cond) ne 'HASH';
836              
837             # supplement condition
838             # relationship conditions take precedence (?)
839 20         88 @{$call_cond}{keys %$rel_cond} = values %$rel_cond;
  20         82  
840             }
841             }
842              
843 1408 50       5069 my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
844 1408         2541 my $final_cond;
845 1408 100 100     6752 if (defined $constraint_name) {
    100          
846 246         1326 $final_cond = $self->_qualify_cond_columns (
847              
848             $self->result_source->_minimal_valueset_satisfying_constraint(
849             constraint_name => $constraint_name,
850             values => ($self->_merge_with_rscond($call_cond))[0],
851             carp_on_nulls => 1,
852             ),
853              
854             $alias,
855             );
856             }
857             elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') {
858             # This means that we got here after a merger of relationship conditions
859             # in ::Relationship::Base::search_related (the row method), and furthermore
860             # the relationship is of the 'single' type. This means that the condition
861             # provided by the relationship (already attached to $self) is sufficient,
862             # as there can be only one row in the database that would satisfy the
863             # relationship
864             }
865             else {
866 1154         2836 my (@unique_queries, %seen_column_combinations, $ci, @fc_exceptions);
867              
868             # no key was specified - fall down to heuristics mode:
869             # run through all unique queries registered on the resultset, and
870             # 'OR' all qualifying queries together
871             #
872             # always start from 'primary' if it exists at all
873 1154         6410 for my $c_name ( sort {
874 4049 100       11778 $a eq 'primary' ? -1
    100          
875             : $b eq 'primary' ? 1
876             : $a cmp $b
877             } $rsrc->unique_constraint_names) {
878              
879             next if $seen_column_combinations{
880 3841 100       27072 join "\x00", sort $rsrc->unique_constraint_columns($c_name)
881             }++;
882              
883             try {
884 3017   66 3017   199610 push @unique_queries, $self->_qualify_cond_columns(
885             $self->result_source->_minimal_valueset_satisfying_constraint(
886             constraint_name => $c_name,
887             values => ($self->_merge_with_rscond($call_cond))[0],
888             columns_info => ($ci ||= $self->result_source->columns_info),
889             ),
890             $alias
891             );
892             }
893             catch {
894 1971 100   1971   37883 push @fc_exceptions, $_ if $_ =~ /\bFilterColumn\b/;
895 3017         23178 };
896             }
897              
898             $final_cond =
899             @unique_queries ? \@unique_queries
900 1154 100       9856 : @fc_exceptions ? $self->throw_exception(join "; ", map { $_ =~ /(.*) at .+ line \d+$/s } @fc_exceptions )
  1 100       3  
901             : $self->_non_unique_find_fallback ($call_cond, $attrs)
902             ;
903             }
904              
905             # Run the query, passing the result_class since it should propagate for find
906 1403         5529 my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs});
907 1403 100       6258 if ($rs->_resolved_attrs->{collapse}) {
908 11         63 my $row = $rs->next;
909 11 100       51 carp "Query returned more than one row" if $rs->next;
910 11         167 return $row;
911             }
912             else {
913 1392         5370 return $rs->single;
914             }
915             }
916              
917             # This is a stop-gap method as agreed during the discussion on find() cleanup:
918             # http://lists.scsys.co.uk/pipermail/dbix-class/2010-October/009535.html
919             #
920             # It is invoked when find() is called in legacy-mode with insufficiently-unique
921             # condition. It is provided for overrides until a saner way forward is devised
922             #
923             # *NOTE* This is not a public method, and it's *GUARANTEED* to disappear down
924             # the road. Please adjust your tests accordingly to catch this situation early
925             # DBIx::Class::ResultSet->can('_non_unique_find_fallback') is reasonable
926             #
927             # The method will not be removed without an adequately complete replacement
928             # for strict-mode enforcement
929             sub _non_unique_find_fallback {
930 132     132   417 my ($self, $cond, $attrs) = @_;
931              
932             return $self->_qualify_cond_columns(
933             $cond,
934             exists $attrs->{alias}
935             ? $attrs->{alias}
936             : $self->{attrs}{alias}
937 132 50       802 );
938             }
939              
940              
941             sub _qualify_cond_columns {
942 1420     1420   4166 my ($self, $cond, $alias) = @_;
943              
944 1420         5473 my %aliased = %$cond;
945 1420         4460 for (keys %aliased) {
946 1556 50       8874 $aliased{"$alias.$_"} = delete $aliased{$_}
947             if $_ !~ /\./;
948             }
949              
950 1420         6136 return \%aliased;
951             }
952              
953             sub _build_unique_cond {
954 0     0   0 carp_unique sprintf
955             '_build_unique_cond is a private method, and moreover is about to go '
956             . 'away. Please contact the development team at %s if you believe you '
957             . 'have a genuine use for this method, in order to discuss alternatives.',
958             DBIx::Class::_ENV_::HELP_URL,
959             ;
960              
961 0         0 my ($self, $constraint_name, $cond, $croak_on_null) = @_;
962              
963 0         0 $self->result_source->_minimal_valueset_satisfying_constraint(
964             constraint_name => $constraint_name,
965             values => $cond,
966             carp_on_nulls => !$croak_on_null
967             );
968             }
969              
970             =head2 search_related
971              
972             =over 4
973              
974             =item Arguments: $rel_name, $cond?, L<\%attrs?|/ATTRIBUTES>
975              
976             =item Return Value: L<$resultset|/search> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
977              
978             =back
979              
980             $new_rs = $cd_rs->search_related('artist', {
981             name => 'Emo-R-Us',
982             });
983              
984             Searches the specified relationship, optionally specifying a condition and
985             attributes for matching records. See L</ATTRIBUTES> for more information.
986              
987             In list context, C<< ->all() >> is called implicitly on the resultset, thus
988             returning a list of result objects instead. To avoid that, use L</search_related_rs>.
989              
990             See also L</search_related_rs>.
991              
992             =cut
993              
994             sub search_related {
995 214     214 1 5260 return shift->related_resultset(shift)->search(@_);
996             }
997              
998             =head2 search_related_rs
999              
1000             This method works exactly the same as search_related, except that
1001             it guarantees a resultset, even in list context.
1002              
1003             =cut
1004              
1005             sub search_related_rs {
1006 1     1 1 20 return shift->related_resultset(shift)->search_rs(@_);
1007             }
1008              
1009             =head2 cursor
1010              
1011             =over 4
1012              
1013             =item Arguments: none
1014              
1015             =item Return Value: L<$cursor|DBIx::Class::Cursor>
1016              
1017             =back
1018              
1019             Returns a storage-driven cursor to the given resultset. See
1020             L<DBIx::Class::Cursor> for more information.
1021              
1022             =cut
1023              
1024             sub cursor {
1025 10755     10755 1 17999 my $self = shift;
1026              
1027 10755   66     37879 return $self->{cursor} ||= do {
1028 3804         9943 my $attrs = $self->_resolved_attrs;
1029             $self->result_source->storage->select(
1030 3804         17621 $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
1031             );
1032             };
1033             }
1034              
1035             =head2 single
1036              
1037             =over 4
1038              
1039             =item Arguments: L<$cond?|DBIx::Class::SQLMaker>
1040              
1041             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
1042              
1043             =back
1044              
1045             my $cd = $schema->resultset('CD')->single({ year => 2001 });
1046              
1047             Inflates the first result without creating a cursor if the resultset has
1048             any records in it; if not returns C<undef>. Used by L</find> as a lean version
1049             of L</search>.
1050              
1051             While this method can take an optional search condition (just like L</search>)
1052             being a fast-code-path it does not recognize search attributes. If you need to
1053             add extra joins or similar, call L</search> and then chain-call L</single> on the
1054             L<DBIx::Class::ResultSet> returned.
1055              
1056             =over
1057              
1058             =item B<Note>
1059              
1060             As of 0.08100, this method enforces the assumption that the preceding
1061             query returns only one row. If more than one row is returned, you will receive
1062             a warning:
1063              
1064             Query returned more than one row
1065              
1066             In this case, you should be using L</next> or L</find> instead, or if you really
1067             know what you are doing, use the L</rows> attribute to explicitly limit the size
1068             of the resultset.
1069              
1070             This method will also throw an exception if it is called on a resultset prefetching
1071             has_many, as such a prefetch implies fetching multiple rows from the database in
1072             order to assemble the resulting object.
1073              
1074             =back
1075              
1076             =cut
1077              
1078             sub single {
1079 2733     2733 1 6369 my ($self, $where) = @_;
1080 2733 50       6638 if(@_ > 2) {
1081 0         0 $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()');
1082             }
1083              
1084 2733         4088 my $attrs = { %{$self->_resolved_attrs} };
  2733         6350  
1085              
1086             $self->throw_exception(
1087             'single() can not be used on resultsets collapsing a has_many. Use find( \%cond ) or next() instead'
1088 2733 100       9366 ) if $attrs->{collapse};
1089              
1090 2732 100       6207 if ($where) {
1091 9 50       31 if (defined $attrs->{where}) {
1092             $attrs->{where} = {
1093             '-and' =>
1094 0 0       0 [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
1095 0         0 $where, delete $attrs->{where} ]
1096             };
1097             } else {
1098 9         21 $attrs->{where} = $where;
1099             }
1100             }
1101              
1102             my $data = [ $self->result_source->storage->select_single(
1103             $attrs->{from}, $attrs->{select},
1104 2732         11640 $attrs->{where}, $attrs
1105             )];
1106              
1107 2731 100       11171 return undef unless @$data;
1108 2432         6842 $self->{_stashed_rows} = [ $data ];
1109 2432         7727 $self->_construct_results->[0];
1110             }
1111              
1112             =head2 get_column
1113              
1114             =over 4
1115              
1116             =item Arguments: L<$cond?|DBIx::Class::SQLMaker>
1117              
1118             =item Return Value: L<$resultsetcolumn|DBIx::Class::ResultSetColumn>
1119              
1120             =back
1121              
1122             my $max_length = $rs->get_column('length')->max;
1123              
1124             Returns a L<DBIx::Class::ResultSetColumn> instance for a column of the ResultSet.
1125              
1126             =cut
1127              
1128             sub get_column {
1129 714     714 1 11872 my ($self, $column) = @_;
1130 714         4395 my $new = DBIx::Class::ResultSetColumn->new($self, $column);
1131 714         4389 return $new;
1132             }
1133              
1134             =head2 search_like
1135              
1136             =over 4
1137              
1138             =item Arguments: L<$cond|DBIx::Class::SQLMaker>, L<\%attrs?|/ATTRIBUTES>
1139              
1140             =item Return Value: L<$resultset|/search> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
1141              
1142             =back
1143              
1144             # WHERE title LIKE '%blue%'
1145             $cd_rs = $rs->search_like({ title => '%blue%'});
1146              
1147             Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
1148             that this is simply a convenience method retained for ex Class::DBI users.
1149             You most likely want to use L</search> with specific operators.
1150              
1151             For more information, see L<DBIx::Class::Manual::Cookbook>.
1152              
1153             This method is deprecated and will be removed in 0.09. Use L<search()|/search>
1154             instead. An example conversion is:
1155              
1156             ->search_like({ foo => 'bar' });
1157              
1158             # Becomes
1159              
1160             ->search({ foo => { like => 'bar' } });
1161              
1162             =cut
1163              
1164             sub search_like {
1165 0     0 1 0 my $class = shift;
1166 0         0 carp_unique (
1167             'search_like() is deprecated and will be removed in DBIC version 0.09.'
1168             .' Instead use ->search({ x => { -like => "y%" } })'
1169             .' (note the outer pair of {}s - they are important!)'
1170             );
1171 0 0 0     0 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1172 0 0       0 my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
  0         0  
1173 0         0 $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
1174 0         0 return $class->search($query, { %$attrs });
1175             }
1176              
1177             =head2 slice
1178              
1179             =over 4
1180              
1181             =item Arguments: $first, $last
1182              
1183             =item Return Value: L<$resultset|/search> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
1184              
1185             =back
1186              
1187             Returns a resultset or object list representing a subset of elements from the
1188             resultset slice is called on. Indexes are from 0, i.e., to get the first
1189             three records, call:
1190              
1191             my ($one, $two, $three) = $rs->slice(0, 2);
1192              
1193             =cut
1194              
1195             sub slice {
1196 14     14 1 5089 my ($self, $min, $max) = @_;
1197 14         37 my $attrs = {}; # = { %{ $self->{attrs} || {} } };
1198 14   50     100 $attrs->{offset} = $self->{attrs}{offset} || 0;
1199 14         33 $attrs->{offset} += $min;
1200 14 100       68 $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
1201 14         53 return $self->search(undef, $attrs);
1202             }
1203              
1204             =head2 next
1205              
1206             =over 4
1207              
1208             =item Arguments: none
1209              
1210             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
1211              
1212             =back
1213              
1214             Returns the next element in the resultset (C<undef> is there is none).
1215              
1216             Can be used to efficiently iterate over records in the resultset:
1217              
1218             my $rs = $schema->resultset('CD')->search;
1219             while (my $cd = $rs->next) {
1220             print $cd->title;
1221             }
1222              
1223             Note that you need to store the resultset object, and call C<next> on it.
1224             Calling C<< resultset('Table')->next >> repeatedly will always return the
1225             first record from the resultset.
1226              
1227             =cut
1228              
1229             sub next {
1230 4888     4888 1 94594 my ($self) = @_;
1231              
1232 4888 100       11717 if (my $cache = $self->get_cache) {
1233 65   100     316 $self->{all_cache_position} ||= 0;
1234 65         1115 return $cache->[$self->{all_cache_position}++];
1235             }
1236              
1237 4823 100       13179 if ($self->{attrs}{cache}) {
1238 2         5 delete $self->{pager};
1239 2         5 $self->{all_cache_position} = 1;
1240 2         9 return ($self->all)[0];
1241             }
1242              
1243 4821 100       7061 return shift(@{$self->{_stashed_results}}) if @{ $self->{_stashed_results}||[] };
  11 100       45  
  4821         16429  
1244              
1245 4810 100       10370 $self->{_stashed_results} = $self->_construct_results
1246             or return undef;
1247              
1248 4070         6731 return shift @{$self->{_stashed_results}};
  4070         30327  
1249             }
1250              
1251             # Constructs as many results as it can in one pass while respecting
1252             # cursor laziness. Several modes of operation:
1253             #
1254             # * Always builds everything present in @{$self->{_stashed_rows}}
1255             # * If called with $fetch_all true - pulls everything off the cursor and
1256             # builds all result structures (or objects) in one pass
1257             # * If $self->_resolved_attrs->{collapse} is true, checks the order_by
1258             # and if the resultset is ordered properly by the left side:
1259             # * Fetches stuff off the cursor until the "master object" changes,
1260             # and saves the last extra row (if any) in @{$self->{_stashed_rows}}
1261             # OR
1262             # * Just fetches, and collapses/constructs everything as if $fetch_all
1263             # was requested (there is no other way to collapse except for an
1264             # eager cursor)
1265             # * If no collapse is requested - just get the next row, construct and
1266             # return
1267             sub _construct_results {
1268 8862     8862   17433 my ($self, $fetch_all) = @_;
1269              
1270 8862         19708 my $rsrc = $self->result_source;
1271 8862         21295 my $attrs = $self->_resolved_attrs;
1272              
1273 8861 100 100     40967 if (
      100        
      66        
1274             ! $fetch_all
1275             and
1276             ! $attrs->{order_by}
1277             and
1278             $attrs->{collapse}
1279             and
1280             my @pcols = $rsrc->primary_columns
1281             ) {
1282             # default order for collapsing unless the user asked for something
1283 34         120 $attrs->{order_by} = [ map { join '.', $attrs->{alias}, $_} @pcols ];
  34         195  
1284 34         99 $attrs->{_ordered_for_collapse} = 1;
1285 34         94 $attrs->{_order_is_artificial} = 1;
1286             }
1287              
1288             # this will be used as both initial raw-row collector AND as a RV of
1289             # _construct_results. Not regrowing the array twice matters a lot...
1290             # a surprising amount actually
1291 8861         16789 my $rows = delete $self->{_stashed_rows};
1292              
1293 8861         13929 my $cursor; # we may not need one at all
1294              
1295 8861         14056 my $did_fetch_all = $fetch_all;
1296              
1297 8861 100       23092 if ($fetch_all) {
    100          
1298             # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1299 1620 50       5281 $rows = [ ($rows ? @$rows : ()), $self->cursor->all ];
1300             }
1301             elsif( $attrs->{collapse} ) {
1302              
1303             # a cursor will need to be closed over in case of collapse
1304 109         327 $cursor = $self->cursor;
1305              
1306             $attrs->{_ordered_for_collapse} = (
1307             (
1308             $attrs->{order_by}
1309             and
1310             $rsrc->schema
1311             ->storage
1312             ->_extract_colinfo_of_stable_main_source_order_by_portion($attrs)
1313             ) ? 1 : 0
1314 109 100 66     467 ) unless defined $attrs->{_ordered_for_collapse};
    100          
1315              
1316 109 100       344 if (! $attrs->{_ordered_for_collapse}) {
1317 13         32 $did_fetch_all = 1;
1318              
1319             # instead of looping over ->next, use ->all in stealth mode
1320             # *without* calling a ->reset afterwards
1321             # FIXME ENCAPSULATION - encapsulation breach, cursor method additions pending
1322 13 100       57 if (! $cursor->{_done}) {
1323 8 50       58 $rows = [ ($rows ? @$rows : ()), $cursor->all ];
1324 7         44 $cursor->{_done} = 1;
1325             }
1326             }
1327             }
1328              
1329 8852 100 100     22555 if (! $did_fetch_all and ! @{$rows||[]} ) {
  7228 100       28050  
1330             # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1331 4772   66     14439 $cursor ||= $self->cursor;
1332 4772 100       13999 if (scalar (my @r = $cursor->next) ) {
1333 4066         10108 $rows = [ \@r ];
1334             }
1335             }
1336              
1337 8845 100       15625 return undef unless @{$rows||[]};
  8845 100       30219  
1338              
1339             # sanity check - people are too clever for their own good
1340 7849 100 66     22446 if ($attrs->{collapse} and my $aliastypes = $attrs->{_last_sqlmaker_alias_map} ) {
1341              
1342 226         442 my $multiplied_selectors;
1343 226         492 for my $sel_alias ( grep { $_ ne $attrs->{alias} } keys %{ $aliastypes->{selecting} } ) {
  611         1805  
  226         978  
1344 423 100 100     1627 if (
1345             $aliastypes->{multiplying}{$sel_alias}
1346             or
1347             $aliastypes->{premultiplied}{$sel_alias}
1348             ) {
1349 341         577 $multiplied_selectors->{$_} = 1 for values %{$aliastypes->{selecting}{$sel_alias}{-seen_columns}}
  341         2297  
1350             }
1351             }
1352              
1353 226         590 for my $i (0 .. $#{$attrs->{as}} ) {
  226         836  
1354 2167         3368 my $sel = $attrs->{select}[$i];
1355              
1356 2167 100 66     5825 if (ref $sel eq 'SCALAR') {
    100          
1357 3         6 $sel = $$sel;
1358             }
1359             elsif( ref $sel eq 'REF' and ref $$sel eq 'ARRAY' ) {
1360 6         20 $sel = $$sel->[0];
1361             }
1362              
1363             $self->throw_exception(
1364             'Result collapse not possible - selection from a has_many source redirected to the main object'
1365 2167 100 100     7165 ) if ($multiplied_selectors->{$sel} and $attrs->{as}[$i] !~ /\./);
1366             }
1367             }
1368              
1369             # hotspot - skip the setter
1370 7813         19491 my $res_class = $self->_result_class;
1371              
1372 7813   66     27002 my $inflator_cref = $self->{_result_inflator}{cref} ||= do {
1373 4658 100       51335 $res_class->can ('inflate_result')
1374             or $self->throw_exception("Inflator $res_class does not provide an inflate_result() method");
1375             };
1376              
1377 7812         15472 my $infmap = $attrs->{as};
1378              
1379             $self->{_result_inflator}{is_core_row} = ( (
1380             $inflator_cref
1381             ==
1382             ( \&DBIx::Class::Row::inflate_result || die "No ::Row::inflate_result() - can't happen" )
1383 7812 100 50     32608 ) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_core_row};
    100          
1384              
1385             $self->{_result_inflator}{is_hri} = ( (
1386             ! $self->{_result_inflator}{is_core_row}
1387             and
1388             $inflator_cref == (
1389             require DBIx::Class::ResultClass::HashRefInflator
1390             &&
1391             DBIx::Class::ResultClass::HashRefInflator->can('inflate_result')
1392             )
1393 7812 100 100     31241 ) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_hri};
    100          
1394              
1395              
1396 7812 100       16234 if ($attrs->{_simple_passthrough_construction}) {
1397             # construct a much simpler array->hash folder for the one-table HRI cases right here
1398 7546 100 66     31996 if ($self->{_result_inflator}{is_hri}) {
    100          
1399 51         116 for my $r (@$rows) {
1400 142         287 $r = { map { $infmap->[$_] => $r->[$_] } 0..$#$infmap };
  317         913  
1401             }
1402             }
1403             # FIXME SUBOPTIMAL this is a very very very hot spot
1404             # while rather optimal we can *still* do much better, by
1405             # building a smarter Row::inflate_result(), and
1406             # switch to feeding it data via a much leaner interface
1407             #
1408             # crude unscientific benchmarking indicated the shortcut eval is not worth it for
1409             # this particular resultset size
1410             elsif ( $self->{_result_inflator}{is_core_row} and @$rows < 60 ) {
1411 7491         15586 for my $r (@$rows) {
1412 8736         21782 $r = $inflator_cref->($res_class, $rsrc, { map { $infmap->[$_] => $r->[$_] } (0..$#$infmap) } );
  51824         126471  
1413             }
1414             }
1415             else {
1416             eval sprintf (
1417             ( $self->{_result_inflator}{is_core_row}
1418             ? '$_ = $inflator_cref->($res_class, $rsrc, { %s }) for @$rows'
1419             # a custom inflator may be a multiplier/reductor - put it in direct list ctx
1420             : '@$rows = map { $inflator_cref->($res_class, $rsrc, { %s } ) } @$rows'
1421             ),
1422 4 50       21 ( join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap ) )
  26 100       695  
1423             ) . '; 1' or die;
1424             }
1425             }
1426             else {
1427             my $parser_type =
1428             $self->{_result_inflator}{is_hri} ? 'hri'
1429 266 100       1298 : $self->{_result_inflator}{is_core_row} ? 'classic_pruning'
    100          
1430             : 'classic_nonpruning'
1431             ;
1432              
1433             # $args and $attrs to _mk_row_parser are separated to delineate what is
1434             # core collapser stuff and what is dbic $rs specific
1435 223         1409 @{$self->{_row_parser}{$parser_type}}{qw(cref nullcheck)} = $rsrc->_mk_row_parser({
1436             eval => 1,
1437             inflate_map => $infmap,
1438             collapse => $attrs->{collapse},
1439             premultiplied => $attrs->{_main_source_premultiplied},
1440             hri_style => $self->{_result_inflator}{is_hri},
1441             prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row},
1442 266 100 100     5002 }, $attrs) unless $self->{_row_parser}{$parser_type}{cref};
1443              
1444             # column_info metadata historically hasn't been too reliable.
1445             # We need to start fixing this somehow (the collapse resolver
1446             # can't work without it). Add an explicit check for the *main*
1447             # result, hopefully this will gradually weed out such errors
1448             #
1449             # FIXME - this is a temporary kludge that reduces performance
1450             # It is however necessary for the time being
1451 266         923 my ($unrolled_non_null_cols_to_check, $err);
1452              
1453 266 100       1149 if (my $check_non_null_cols = $self->{_row_parser}{$parser_type}{nullcheck} ) {
1454              
1455 168         441 $err =
1456             'Collapse aborted due to invalid ResultSource metadata - the following '
1457             . 'selections are declared non-nullable but NULLs were retrieved: '
1458             ;
1459              
1460 168         345 my @violating_idx;
1461 168         469 COL: for my $i (@$check_non_null_cols) {
1462 174   33     1625 ! defined $_->[$i] and push @violating_idx, $i and next COL for @$rows;
      50        
1463             }
1464              
1465 168 50       566 $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) )
  0         0  
1466             if @violating_idx;
1467              
1468 168         587 $unrolled_non_null_cols_to_check = join (',', @$check_non_null_cols);
1469              
1470 168         337 utf8::upgrade($unrolled_non_null_cols_to_check)
1471             if DBIx::Class::_ENV_::STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE;
1472             }
1473              
1474             my $next_cref =
1475             ($did_fetch_all or ! $attrs->{collapse}) ? undef
1476             : defined $unrolled_non_null_cols_to_check ? eval sprintf <<'EOS', $unrolled_non_null_cols_to_check
1477             sub {
1478             # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1479             my @r = $cursor->next or return;
1480             if (my @violating_idx = grep { ! defined $r[$_] } (%s) ) {
1481             $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) )
1482             }
1483             \@r
1484             }
1485             EOS
1486             : sub {
1487             # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1488 90 100   90   263 my @r = $cursor->next or return;
1489             \@r
1490 88         2532 }
1491 266 100 100     9995 ;
    100          
1492              
1493             $self->{_row_parser}{$parser_type}{cref}->(
1494             $rows,
1495 266 100       8427 $next_cref ? ( $next_cref, $self->{_stashed_rows} = [] ) : (),
1496             );
1497              
1498             # simple in-place substitution, does not regrow $rows
1499 266 100       1488 if ($self->{_result_inflator}{is_core_row}) {
    100          
1500 200         1196 $_ = $inflator_cref->($res_class, $rsrc, @$_) for @$rows
1501             }
1502             # Special-case multi-object HRI - there is no $inflator_cref pass at all
1503             elsif ( ! $self->{_result_inflator}{is_hri} ) {
1504             # the inflator may be a multiplier/reductor - put it in list ctx
1505 9         28 @$rows = map { $inflator_cref->($res_class, $rsrc, @$_) } @$rows;
  53         189  
1506             }
1507             }
1508              
1509             # The @$rows check seems odd at first - why wouldn't we want to warn
1510             # regardless? The issue is things like find() etc, where the user
1511             # *knows* only one result will come back. In these cases the ->all
1512             # is not a pessimization, but rather something we actually want
1513 7809 100 100     29143 carp_unique(
1514             'Unable to properly collapse has_many results in iterator mode due '
1515             . 'to order criteria - performed an eager cursor slurp underneath. '
1516             . 'Consider using ->all() instead'
1517             ) if ( ! $fetch_all and @$rows > 1 );
1518              
1519 7809         46350 return $rows;
1520             }
1521              
1522             =head2 result_source
1523              
1524             =over 4
1525              
1526             =item Arguments: L<$result_source?|DBIx::Class::ResultSource>
1527              
1528             =item Return Value: L<$result_source|DBIx::Class::ResultSource>
1529              
1530             =back
1531              
1532             An accessor for the primary ResultSource object from which this ResultSet
1533             is derived.
1534              
1535             =head2 result_class
1536              
1537             =over 4
1538              
1539             =item Arguments: $result_class?
1540              
1541             =item Return Value: $result_class
1542              
1543             =back
1544              
1545             An accessor for the class to use when creating result objects. Defaults to
1546             C<< result_source->result_class >> - which in most cases is the name of the
1547             L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
1548              
1549             Note that changing the result_class will also remove any components
1550             that were originally loaded in the source class via
1551             L<load_components|Class::C3::Componentised/load_components( @comps )>.
1552             Any overloaded methods in the original source class will not run.
1553              
1554             =cut
1555              
1556             sub result_class {
1557 37144     37144 1 79932 my ($self, $result_class) = @_;
1558 37144 100       77502 if ($result_class) {
1559              
1560             # don't fire this for an object
1561 33101 50       144208 $self->ensure_class_loaded($result_class)
1562             unless ref($result_class);
1563              
1564 33097 100 66     461361 if ($self->get_cache) {
    100          
1565 1         6 carp_unique('Changing the result_class of a ResultSet instance with cached results is a noop - the cache contents will not be altered');
1566             }
1567             # FIXME ENCAPSULATION - encapsulation breach, cursor method additions pending
1568             elsif ($self->{cursor} && $self->{cursor}{_pos}) {
1569 1         6 $self->throw_exception('Changing the result_class of a ResultSet instance with an active cursor is not supported');
1570             }
1571              
1572 33096         112938 $self->_result_class($result_class);
1573              
1574 33096         145132 delete $self->{_result_inflator};
1575             }
1576 37139         113139 $self->_result_class;
1577             }
1578              
1579             =head2 count
1580              
1581             =over 4
1582              
1583             =item Arguments: L<$cond|DBIx::Class::SQLMaker>, L<\%attrs?|/ATTRIBUTES>
1584              
1585             =item Return Value: $count
1586              
1587             =back
1588              
1589             Performs an SQL C<COUNT> with the same query as the resultset was built
1590             with to find the number of elements. Passing arguments is equivalent to
1591             C<< $rs->search ($cond, \%attrs)->count >>
1592              
1593             =cut
1594              
1595             sub count {
1596 624     624 1 94553 my $self = shift;
1597 624 100 100     2619 return $self->search(@_)->count if @_ and defined $_[0];
1598 609 100       1653 return scalar @{ $self->get_cache } if $self->get_cache;
  58         124  
1599              
1600 551         1173 my $attrs = { %{ $self->_resolved_attrs } };
  551         1965  
1601              
1602             # this is a little optimization - it is faster to do the limit
1603             # adjustments in software, instead of a subquery
1604 551         2013 my ($rows, $offset) = delete @{$attrs}{qw/rows offset/};
  551         2142  
1605              
1606 551         1136 my $crs;
1607 551 100       2756 if ($self->_has_resolved_attr (qw/collapse group_by/)) {
1608 65         358 $crs = $self->_count_subq_rs ($attrs);
1609             }
1610             else {
1611 486         2216 $crs = $self->_count_rs ($attrs);
1612             }
1613 551         3020 my $count = $crs->next;
1614              
1615 548 100       1705 $count -= $offset if $offset;
1616 548 100 100     1902 $count = $rows if $rows and $rows < $count;
1617 548 100       1555 $count = 0 if ($count < 0);
1618              
1619 548         2493 return $count;
1620             }
1621              
1622             =head2 count_rs
1623              
1624             =over 4
1625              
1626             =item Arguments: L<$cond|DBIx::Class::SQLMaker>, L<\%attrs?|/ATTRIBUTES>
1627              
1628             =item Return Value: L<$count_rs|DBIx::Class::ResultSetColumn>
1629              
1630             =back
1631              
1632             Same as L</count> but returns a L<DBIx::Class::ResultSetColumn> object.
1633             This can be very handy for subqueries:
1634              
1635             ->search( { amount => $some_rs->count_rs->as_query } )
1636              
1637             As with regular resultsets the SQL query will be executed only after
1638             the resultset is accessed via L</next> or L</all>. That would return
1639             the same single value obtainable via L</count>.
1640              
1641             =cut
1642              
1643             sub count_rs {
1644 68     68 1 227 my $self = shift;
1645 68 100       267 return $self->search(@_)->count_rs if @_;
1646              
1647             # this may look like a lack of abstraction (count() does about the same)
1648             # but in fact an _rs *must* use a subquery for the limits, as the
1649             # software based limiting can not be ported if this $rs is to be used
1650             # in a subquery itself (i.e. ->as_query)
1651 58 100       271 if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) {
1652 28         147 return $self->_count_subq_rs($self->{_attrs});
1653             }
1654             else {
1655 30         184 return $self->_count_rs($self->{_attrs});
1656             }
1657             }
1658              
1659             #
1660             # returns a ResultSetColumn object tied to the count query
1661             #
1662             sub _count_rs {
1663 516     516   1456 my ($self, $attrs) = @_;
1664              
1665 516         1827 my $rsrc = $self->result_source;
1666              
1667 516         3347 my $tmp_attrs = { %$attrs };
1668             # take off any limits, record_filter is cdbi, and no point of ordering nor locking a count
1669 516         1563 delete @{$tmp_attrs}{qw/rows offset order_by record_filter for/};
  516         1558  
1670              
1671             # overwrite the selector (supplied by the storage)
1672 516         13887 $rsrc->resultset_class->new($rsrc, {
1673             %$tmp_attrs,
1674             select => $rsrc->storage->_count_select ($rsrc, $attrs),
1675             as => 'count',
1676             })->get_column ('count');
1677             }
1678              
1679             #
1680             # same as above but uses a subquery
1681             #
1682             sub _count_subq_rs {
1683 93     93   254 my ($self, $attrs) = @_;
1684              
1685 93         309 my $rsrc = $self->result_source;
1686              
1687 93         698 my $sub_attrs = { %$attrs };
1688             # extra selectors do not go in the subquery and there is no point of ordering it, nor locking it
1689 93         280 delete @{$sub_attrs}{qw/collapse columns as select order_by for/};
  93         352  
1690              
1691             # if we multi-prefetch we group_by something unique, as this is what we would
1692             # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
1693 93 100       372 if ( $attrs->{collapse} ) {
1694 31         202 $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } @{
1695 31 50       86 $rsrc->_identifying_column_set || $self->throw_exception(
  31         234  
1696             'Unable to construct a unique group_by criteria properly collapsing the '
1697             . 'has_many prefetch before count()'
1698             );
1699             } ]
1700             }
1701              
1702             # Calculate subquery selector
1703 93 100       351 if (my $g = $sub_attrs->{group_by}) {
1704              
1705 90         435 my $sql_maker = $rsrc->storage->sql_maker;
1706              
1707             # necessary as the group_by may refer to aliased functions
1708 90         203 my $sel_index;
1709 90         176 for my $sel (@{$attrs->{select}}) {
  90         280  
1710             $sel_index->{$sel->{-as}} = $sel
1711 544 100 100     1247 if (ref $sel eq 'HASH' and $sel->{-as});
1712             }
1713              
1714             # anything from the original select mentioned on the group-by needs to make it to the inner selector
1715             # also look for named aggregates referred in the having clause
1716             # having often contains scalarrefs - thus parse it out entirely
1717 90         325 my @parts = @$g;
1718 90 100       357 if ($attrs->{having}) {
1719 3         11 local $sql_maker->{having_bind};
1720 3         14 local $sql_maker->{quote_char} = $sql_maker->{quote_char};
1721 3         12 local $sql_maker->{name_sep} = $sql_maker->{name_sep};
1722 3 50 33     18 unless (defined $sql_maker->{quote_char} and length $sql_maker->{quote_char}) {
1723 3         12 $sql_maker->{quote_char} = [ "\x00", "\xFF" ];
1724             # if we don't unset it we screw up retarded but unfortunately working
1725             # 'MAX(foo.bar)' => { '>', 3 }
1726 3         9 $sql_maker->{name_sep} = '';
1727             }
1728              
1729 3         19 my ($lquote, $rquote, $sep) = map { quotemeta $_ } ($sql_maker->_quote_chars, $sql_maker->name_sep);
  9         26  
1730              
1731 3         21 my $having_sql = $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} });
1732 3         9 my %seen_having;
1733              
1734             # search for both a proper quoted qualified string, for a naive unquoted scalarref
1735             # and if all fails for an utterly naive quoted scalar-with-function
1736 3         214 while ($having_sql =~ /
1737             $rquote $sep $lquote (.+?) $rquote
1738             |
1739             [\s,] \w+ \. (\w+) [\s,]
1740             |
1741             [\s,] $lquote (.+?) $rquote [\s,]
1742             /gx) {
1743 3   33     35 my $part = $1 || $2 || $3; # one of them matched if we got here
1744 3 100       22 unless ($seen_having{$part}++) {
1745 2         22 push @parts, $part;
1746             }
1747             }
1748             }
1749              
1750 90         227 for (@parts) {
1751 140   66     679 my $colpiece = $sel_index->{$_} || $_;
1752              
1753             # unqualify join-based group_by's. Arcane but possible query
1754             # also horrible horrible hack to alias a column (not a func.)
1755             # (probably need to introduce SQLA syntax)
1756 140 100 100     1218 if ($colpiece =~ /\./ && $colpiece !~ /^$attrs->{alias}\./) {
1757 3         8 my $as = $colpiece;
1758 3         13 $as =~ s/\./__/;
1759 3         11 $colpiece = \ sprintf ('%s AS %s', map { $sql_maker->_quote ($_) } ($colpiece, $as) );
  6         79  
1760             }
1761 140         321 push @{$sub_attrs->{select}}, $colpiece;
  140         551  
1762             }
1763             }
1764             else {
1765 3         33 my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns);
  3         17  
1766 3 50       16 $sub_attrs->{select} = @pcols ? \@pcols : [ 1 ];
1767             }
1768              
1769 93         2162 return $rsrc->resultset_class
1770             ->new ($rsrc, $sub_attrs)
1771             ->as_subselect_rs
1772             ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } })
1773             ->get_column ('count');
1774             }
1775              
1776              
1777             =head2 count_literal
1778              
1779             B<CAVEAT>: C<count_literal> is provided for Class::DBI compatibility and
1780             should only be used in that context. See L</search_literal> for further info.
1781              
1782             =over 4
1783              
1784             =item Arguments: $sql_fragment, @standalone_bind_values
1785              
1786             =item Return Value: $count
1787              
1788             =back
1789              
1790             Counts the results in a literal query. Equivalent to calling L</search_literal>
1791             with the passed arguments, then L</count>.
1792              
1793             =cut
1794              
1795 0     0 1 0 sub count_literal { shift->search_literal(@_)->count; }
1796              
1797             =head2 all
1798              
1799             =over 4
1800              
1801             =item Arguments: none
1802              
1803             =item Return Value: L<@result_objs|DBIx::Class::Manual::ResultClass>
1804              
1805             =back
1806              
1807             Returns all elements in the resultset.
1808              
1809             =cut
1810              
1811             sub all {
1812 1686     1686 1 335971 my $self = shift;
1813 1686 50       4824 if(@_) {
1814 0         0 $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
1815             }
1816              
1817 1686         3227 delete @{$self}{qw/_stashed_rows _stashed_results/};
  1686         4581  
1818              
1819 1686 100       4354 if (my $c = $self->get_cache) {
1820 66         398 return @$c;
1821             }
1822              
1823 1620         4803 $self->cursor->reset;
1824              
1825 1620   100     5476 my $objs = $self->_construct_results('fetch_all') || [];
1826              
1827 1599 100       5446 $self->set_cache($objs) if $self->{attrs}{cache};
1828              
1829 1599         9076 return @$objs;
1830             }
1831              
1832             =head2 reset
1833              
1834             =over 4
1835              
1836             =item Arguments: none
1837              
1838             =item Return Value: $self
1839              
1840             =back
1841              
1842             Resets the resultset's cursor, so you can iterate through the elements again.
1843             Implicitly resets the storage cursor, so a subsequent L</next> will trigger
1844             another query.
1845              
1846             =cut
1847              
1848             sub reset {
1849 1524     1524 1 3791 my ($self) = @_;
1850              
1851 1524         2974 delete @{$self}{qw/_stashed_rows _stashed_results/};
  1524         4182  
1852 1524         3552 $self->{all_cache_position} = 0;
1853 1524         3860 $self->cursor->reset;
1854 1524         4778 return $self;
1855             }
1856              
1857             =head2 first
1858              
1859             =over 4
1860              
1861             =item Arguments: none
1862              
1863             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
1864              
1865             =back
1866              
1867             L<Resets|/reset> the resultset (causing a fresh query to storage) and returns
1868             an object for the first result (or C<undef> if the resultset is empty).
1869              
1870             =cut
1871              
1872             sub first {
1873 885     885 1 62700 return $_[0]->reset->next;
1874             }
1875              
1876              
1877             # _rs_update_delete
1878             #
1879             # Determines whether and what type of subquery is required for the $rs operation.
1880             # If grouping is necessary either supplies its own, or verifies the current one
1881             # After all is done delegates to the proper storage method.
1882              
1883             sub _rs_update_delete {
1884 601     601   1704 my ($self, $op, $values) = @_;
1885              
1886 601         1551 my $rsrc = $self->result_source;
1887 601         2520 my $storage = $rsrc->schema->storage;
1888              
1889 601         9050 my $attrs = { %{$self->_resolved_attrs} };
  601         1770  
1890              
1891 601         1582 my $join_classifications;
1892 601         1217 my ($existing_group_by) = delete @{$attrs}{qw(group_by _grouped_by_distinct)};
  601         1881  
1893              
1894             # do we need a subquery for any reason?
1895             my $needs_subq = (
1896             defined $existing_group_by
1897             or
1898             # if {from} is unparseable wrap a subq
1899 601   100     4605 ref($attrs->{from}) ne 'ARRAY'
1900             or
1901             # limits call for a subq
1902             $self->_has_resolved_attr(qw/rows offset/)
1903             );
1904              
1905             # simplify the joinmap, so we can further decide if a subq is necessary
1906 601 100 100     2191 if (!$needs_subq and @{$attrs->{from}} > 1) {
  596         2194  
1907              
1908 18         153 ($attrs->{from}, $join_classifications) =
1909             $storage->_prune_unused_joins ($attrs);
1910              
1911             # any non-pruneable non-local restricting joins imply subq
1912 18 50   26   103 $needs_subq = defined List::Util::first { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} };
  26         106  
  18         119  
1913             }
1914              
1915             # check if the head is composite (by now all joins are thrown out unless $needs_subq)
1916             $needs_subq ||= (
1917             (ref $attrs->{from}[0]) ne 'HASH'
1918             or
1919             ref $attrs->{from}[0]{ $attrs->{from}[0]{-alias} }
1920 601   66     4629 );
      100        
1921              
1922 601         1190 my ($cond, $guard);
1923             # do we need anything like a subquery?
1924 601 100       1676 if (! $needs_subq) {
1925             # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
1926             # a condition containing 'me' or other table prefixes will not work
1927             # at all. Tell SQLMaker to dequalify idents via a gross hack.
1928 571         955 $cond = do {
1929 571         2038 my $sqla = $rsrc->storage->sql_maker;
1930 571         1798 local $sqla->{_dequalify_idents} = 1;
1931 571         2476 \[ $sqla->_recurse_where($self->{cond}) ];
1932             };
1933             }
1934             else {
1935             # we got this far - means it is time to wrap a subquery
1936 30   33     228 my $idcols = $rsrc->_identifying_column_set || $self->throw_exception(
1937             sprintf(
1938             "Unable to perform complex resultset %s() without an identifying set of columns on source '%s'",
1939             $op,
1940             $rsrc->source_name,
1941             )
1942             );
1943              
1944             # make a new $rs selecting only the PKs (that's all we really need for the subq)
1945 30         162 delete $attrs->{$_} for qw/select as collapse/;
1946 30         84 $attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ];
  62         237  
1947              
1948             # this will be consumed by the pruner waaaaay down the stack
1949 30         114 $attrs->{_force_prune_multiplying_joins} = 1;
1950              
1951 30         152 my $subrs = (ref $self)->new($rsrc, $attrs);
1952              
1953 30 100       432 if (@$idcols == 1) {
    50          
1954 20         151 $cond = { $idcols->[0] => { -in => $subrs->as_query } };
1955             }
1956             elsif ($storage->_use_multicolumn_in) {
1957             # no syntax for calling this properly yet
1958             # !!! EXPERIMENTAL API !!! WILL CHANGE !!!
1959 0         0 $cond = $storage->sql_maker->_where_op_multicolumn_in (
1960             $idcols, # how do I convey a list of idents...? can binds reside on lhs?
1961             $subrs->as_query
1962             ),
1963             }
1964             else {
1965             # if all else fails - get all primary keys and operate over a ORed set
1966             # wrap in a transaction for consistency
1967             # this is where the group_by/multiplication starts to matter
1968 10 100 100     42 if (
1969             $existing_group_by
1970             or
1971             # we do not need to check pre-multipliers, since if the premulti is there, its
1972             # parent (who is multi) will be there too
1973 8 100       68 keys %{ $join_classifications->{multiplying} || {} }
1974             ) {
1975             # make sure if there is a supplied group_by it matches the columns compiled above
1976             # perfectly. Anything else can not be sanely executed on most databases so croak
1977             # right then and there
1978 5 100       13 if ($existing_group_by) {
1979             my @current_group_by = map
1980 2 100       7 { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
  14         43  
1981             @$existing_group_by
1982             ;
1983              
1984 2 100       13 if (
1985             join ("\x00", sort @current_group_by)
1986             ne
1987 2         13 join ("\x00", sort @{$attrs->{columns}} )
1988             ) {
1989 1         14 $self->throw_exception (
1990             "You have just attempted a $op operation on a resultset which does group_by"
1991             . ' on columns other than the primary keys, while DBIC internally needs to retrieve'
1992             . ' the primary keys in a subselect. All sane RDBMS engines do not support this'
1993             . ' kind of queries. Please retry the operation with a modified group_by or'
1994             . ' without using one at all.'
1995             );
1996             }
1997             }
1998              
1999 4         22 $subrs = $subrs->search({}, { group_by => $attrs->{columns} });
2000             }
2001              
2002 9         88 $guard = $storage->txn_scope_guard;
2003              
2004 9         39 for my $row ($subrs->cursor->all) {
2005             push @$cond, { map
2006 19         65 { $idcols->[$_] => $row->[$_] }
  66         198  
2007             (0 .. $#$idcols)
2008             };
2009             }
2010             }
2011             }
2012              
2013 600 100       130400 my $res = $cond ? $storage->$op (
    100          
2014             $rsrc,
2015             $op eq 'update' ? $values : (),
2016             $cond,
2017             ) : '0E0';
2018              
2019 596 100       4455 $guard->commit if $guard;
2020              
2021 596         5612 return $res;
2022             }
2023              
2024             =head2 update
2025              
2026             =over 4
2027              
2028             =item Arguments: \%values
2029              
2030             =item Return Value: $underlying_storage_rv
2031              
2032             =back
2033              
2034             Sets the specified columns in the resultset to the supplied values in a
2035             single query. Note that this will not run any accessor/set_column/update
2036             triggers, nor will it update any result object instances derived from this
2037             resultset (this includes the contents of the L<resultset cache|/set_cache>
2038             if any). See L</update_all> if you need to execute any on-update
2039             triggers or cascades defined either by you or a
2040             L<result component|DBIx::Class::Manual::Component/WHAT IS A COMPONENT>.
2041              
2042             The return value is a pass through of what the underlying
2043             storage backend returned, and may vary. See L<DBI/execute> for the most
2044             common case.
2045              
2046             =head3 CAVEAT
2047              
2048             Note that L</update> does not process/deflate any of the values passed in.
2049             This is unlike the corresponding L<DBIx::Class::Row/update>. The user must
2050             ensure manually that any value passed to this method will stringify to
2051             something the RDBMS knows how to deal with. A notable example is the
2052             handling of L<DateTime> objects, for more info see:
2053             L<DBIx::Class::Manual::Cookbook/Formatting DateTime objects in queries>.
2054              
2055             =cut
2056              
2057             sub update {
2058 495     495 1 5228 my ($self, $values) = @_;
2059 495 50       1559 $self->throw_exception('Values for update must be a hash')
2060             unless ref $values eq 'HASH';
2061              
2062 495         1613 return $self->_rs_update_delete ('update', $values);
2063             }
2064              
2065             =head2 update_all
2066              
2067             =over 4
2068              
2069             =item Arguments: \%values
2070              
2071             =item Return Value: 1
2072              
2073             =back
2074              
2075             Fetches all objects and updates them one at a time via
2076             L<DBIx::Class::Row/update>. Note that C<update_all> will run DBIC defined
2077             triggers, while L</update> will not.
2078              
2079             =cut
2080              
2081             sub update_all {
2082 1     1 1 993 my ($self, $values) = @_;
2083 1 50       6 $self->throw_exception('Values for update_all must be a hash')
2084             unless ref $values eq 'HASH';
2085              
2086 1         9 my $guard = $self->result_source->schema->txn_scope_guard;
2087 1         10 $_->update({%$values}) for $self->all; # shallow copy - update will mangle it
2088 1         15 $guard->commit;
2089 1         5 return 1;
2090             }
2091              
2092             =head2 delete
2093              
2094             =over 4
2095              
2096             =item Arguments: none
2097              
2098             =item Return Value: $underlying_storage_rv
2099              
2100             =back
2101              
2102             Deletes the rows matching this resultset in a single query. Note that this
2103             will not run any delete triggers, nor will it alter the
2104             L<in_storage|DBIx::Class::Row/in_storage> status of any result object instances
2105             derived from this resultset (this includes the contents of the
2106             L<resultset cache|/set_cache> if any). See L</delete_all> if you need to
2107             execute any on-delete triggers or cascades defined either by you or a
2108             L<result component|DBIx::Class::Manual::Component/WHAT IS A COMPONENT>.
2109              
2110             The return value is a pass through of what the underlying storage backend
2111             returned, and may vary. See L<DBI/execute> for the most common case.
2112              
2113             =cut
2114              
2115             sub delete {
2116 106     106 1 4331 my $self = shift;
2117 106 50       347 $self->throw_exception('delete does not accept any arguments')
2118             if @_;
2119              
2120 106         382 return $self->_rs_update_delete ('delete');
2121             }
2122              
2123             =head2 delete_all
2124              
2125             =over 4
2126              
2127             =item Arguments: none
2128              
2129             =item Return Value: 1
2130              
2131             =back
2132              
2133             Fetches all objects and deletes them one at a time via
2134             L<DBIx::Class::Row/delete>. Note that C<delete_all> will run DBIC defined
2135             triggers, while L</delete> will not.
2136              
2137             =cut
2138              
2139             sub delete_all {
2140 270     270 1 642 my $self = shift;
2141 270 50       680 $self->throw_exception('delete_all does not accept any arguments')
2142             if @_;
2143              
2144 270         985 my $guard = $self->result_source->schema->txn_scope_guard;
2145 270         906 $_->delete for $self->all;
2146 270         1246 $guard->commit;
2147 270         978 return 1;
2148             }
2149              
2150             =head2 populate
2151              
2152             =over 4
2153              
2154             =item Arguments: [ \@column_list, \@row_values+ ] | [ \%col_data+ ]
2155              
2156             =item Return Value: L<\@result_objects|DBIx::Class::Manual::ResultClass> (scalar context) | L<@result_objects|DBIx::Class::Manual::ResultClass> (list context)
2157              
2158             =back
2159              
2160             Accepts either an arrayref of hashrefs or alternatively an arrayref of
2161             arrayrefs.
2162              
2163             =over
2164              
2165             =item NOTE
2166              
2167             The context of this method call has an important effect on what is
2168             submitted to storage. In void context data is fed directly to fastpath
2169             insertion routines provided by the underlying storage (most often
2170             L<DBI/execute_for_fetch>), bypassing the L<new|DBIx::Class::Row/new> and
2171             L<insert|DBIx::Class::Row/insert> calls on the
2172             L<Result|DBIx::Class::Manual::ResultClass> class, including any
2173             augmentation of these methods provided by components. For example if you
2174             are using something like L<DBIx::Class::UUIDColumns> to create primary
2175             keys for you, you will find that your PKs are empty. In this case you
2176             will have to explicitly force scalar or list context in order to create
2177             those values.
2178              
2179             =back
2180              
2181             In non-void (scalar or list) context, this method is simply a wrapper
2182             for L</create>. Depending on list or scalar context either a list of
2183             L<Result|DBIx::Class::Manual::ResultClass> objects or an arrayref
2184             containing these objects is returned.
2185              
2186             When supplying data in "arrayref of arrayrefs" invocation style, the
2187             first element should be a list of column names and each subsequent
2188             element should be a data value in the earlier specified column order.
2189             For example:
2190              
2191             $schema->resultset("Artist")->populate([
2192             [ qw( artistid name ) ],
2193             [ 100, 'A Formally Unknown Singer' ],
2194             [ 101, 'A singer that jumped the shark two albums ago' ],
2195             [ 102, 'An actually cool singer' ],
2196             ]);
2197              
2198             For the arrayref of hashrefs style each hashref should be a structure
2199             suitable for passing to L</create>. Multi-create is also permitted with
2200             this syntax.
2201              
2202             $schema->resultset("Artist")->populate([
2203             { artistid => 4, name => 'Manufactured Crap', cds => [
2204             { title => 'My First CD', year => 2006 },
2205             { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2206             ],
2207             },
2208             { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
2209             { title => 'My parents sold me to a record company', year => 2005 },
2210             { title => 'Why Am I So Ugly?', year => 2006 },
2211             { title => 'I Got Surgery and am now Popular', year => 2007 }
2212             ],
2213             },
2214             ]);
2215              
2216             If you attempt a void-context multi-create as in the example above (each
2217             Artist also has the related list of CDs), and B<do not> supply the
2218             necessary autoinc foreign key information, this method will proxy to the
2219             less efficient L</create>, and then throw the Result objects away. In this
2220             case there are obviously no benefits to using this method over L</create>.
2221              
2222             =cut
2223              
2224             sub populate {
2225 7751     7751 1 23470 my $self = shift;
2226              
2227             # this is naive and just a quick check
2228             # the types will need to be checked more thoroughly when the
2229             # multi-source populate gets added
2230             my $data = (
2231             ref $_[0] eq 'ARRAY'
2232             and
2233 7751 50 33     24340 ( @{$_[0]} or return )
2234             and
2235             ( ref $_[0][0] eq 'HASH' or ref $_[0][0] eq 'ARRAY' )
2236             and
2237             $_[0]
2238             ) or $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs');
2239              
2240             # FIXME - no cref handling
2241             # At this point assume either hashes or arrays
2242              
2243 7744 100       19084 if(defined wantarray) {
2244 41         86 my (@results, $guard);
2245              
2246 41 100       168 if (ref $data->[0] eq 'ARRAY') {
2247             # column names only, nothing to do
2248 21 100       67 return if @$data == 1;
2249              
2250 17 100       91 $guard = $self->result_source->schema->storage->txn_scope_guard
2251             if @$data > 2;
2252              
2253             @results = map
2254 46         93 { my $vals = $_; $self->new_result({ map { $data->[0][$_] => $vals->[$_] } 0..$#{$data->[0]} })->insert }
  46         72  
  108         444  
  46         110  
2255 17         70 @{$data}[1 .. $#$data]
  17         42  
2256             ;
2257             }
2258             else {
2259              
2260 20 100       142 $guard = $self->result_source->schema->storage->txn_scope_guard
2261             if @$data > 1;
2262              
2263 20         70 @results = map { $self->new_result($_)->insert } @$data;
  56         200  
2264             }
2265              
2266 37 100       194 $guard->commit if $guard;
2267 37 100       231 return wantarray ? @results : \@results;
2268             }
2269              
2270             # we have to deal with *possibly incomplete* related data
2271             # this means we have to walk the data structure twice
2272             # whether we want this or not
2273             # jnap, I hate you ;)
2274 7703         17168 my $rsrc = $self->result_source;
2275 7703         66867 my $rel_info = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships };
  21583         44955  
2276              
2277 7703         19105 my ($colinfo, $colnames, $slices_with_rels);
2278 7703         12262 my $data_start = 0;
2279              
2280             DATA_SLICE:
2281 7703         22504 for my $i (0 .. $#$data) {
2282              
2283 44709         60150 my $current_slice_seen_rel_infos;
2284              
2285             ### Determine/Supplement collists
2286             ### BEWARE - This is a hot piece of code, a lot of weird idioms were used
2287 44709 100       88337 if( ref $data->[$i] eq 'ARRAY' ) {
    50          
2288              
2289             # positional(!) explicit column list
2290 44603 100       74595 if ($i == 0) {
2291             # column names only, nothing to do
2292 7659 100       17232 return if @$data == 1;
2293              
2294             $colinfo->{$data->[0][$_]} = { pos => $_, name => $data->[0][$_] } and push @$colnames, $data->[0][$_]
2295 7657   33     11169 for 0 .. $#{$data->[0]};
  7657         97155  
2296              
2297 7657         15958 $data_start = 1;
2298              
2299 7657         18643 next DATA_SLICE;
2300             }
2301             else {
2302 36944         71372 for (values %$colinfo) {
2303 103458 100 100     447817 if ($_->{is_rel} ||= (
      100        
2304             $rel_info->{$_->{name}}
2305             and
2306             (
2307             ref $data->[$i][$_->{pos}] eq 'ARRAY'
2308             or
2309             ref $data->[$i][$_->{pos}] eq 'HASH'
2310             or
2311             ( defined blessed $data->[$i][$_->{pos}] and $data->[$i][$_->{pos}]->isa('DBIx::Class::Row') )
2312             )
2313             and
2314             1
2315             )) {
2316              
2317             # moar sanity check... sigh
2318 4 50       16 for ( ref $data->[$i][$_->{pos}] eq 'ARRAY' ? @{$data->[$i][$_->{pos}]} : $data->[$i][$_->{pos}] ) {
  4         9  
2319 5 50 33     15 if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) {
2320 0         0 carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()");
2321 0         0 return my $throwaway = $self->populate(@_);
2322             }
2323             }
2324              
2325 4         10 push @$current_slice_seen_rel_infos, $rel_info->{$_->{name}};
2326             }
2327             }
2328             }
2329              
2330 36944 100       65336 if ($current_slice_seen_rel_infos) {
2331 4         11 push @$slices_with_rels, { map { $colnames->[$_] => $data->[$i][$_] } 0 .. $#$colnames };
  8         20  
2332              
2333             # this is needed further down to decide whether or not to fallback to create()
2334             $colinfo->{$colnames->[$_]}{seen_null} ||= ! defined $data->[$i][$_]
2335 4   66     29 for 0 .. $#$colnames;
2336             }
2337             }
2338             elsif( ref $data->[$i] eq 'HASH' ) {
2339              
2340 106         165 for ( sort keys %{$data->[$i]} ) {
  106         389  
2341              
2342 224   66     572 $colinfo->{$_} ||= do {
2343              
2344 97 50       195 $self->throw_exception("Column '$_' must be present in supplied explicit column list")
2345             if $data_start; # it will be 0 on AoH, 1 on AoA
2346              
2347 97         197 push @$colnames, $_;
2348              
2349             # RV
2350 97         376 { pos => $#$colnames, name => $_ }
2351             };
2352              
2353 224 100 100     1025 if ($colinfo->{$_}{is_rel} ||= (
      100        
2354             $rel_info->{$_}
2355             and
2356             (
2357             ref $data->[$i]{$_} eq 'ARRAY'
2358             or
2359             ref $data->[$i]{$_} eq 'HASH'
2360             or
2361             ( defined blessed $data->[$i]{$_} and $data->[$i]{$_}->isa('DBIx::Class::Row') )
2362             )
2363             and
2364             1
2365             )) {
2366              
2367             # moar sanity check... sigh
2368 12 100       40 for ( ref $data->[$i]{$_} eq 'ARRAY' ? @{$data->[$i]{$_}} : $data->[$i]{$_} ) {
  10         32  
2369 18 100 66     65 if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) {
2370 1         6 carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()");
2371 1         141 return my $throwaway = $self->populate(@_);
2372             }
2373             }
2374              
2375 11         29 push @$current_slice_seen_rel_infos, $rel_info->{$_};
2376             }
2377             }
2378              
2379 105 100       260 if ($current_slice_seen_rel_infos) {
2380 11         25 push @$slices_with_rels, $data->[$i];
2381              
2382             # this is needed further down to decide whether or not to fallback to create()
2383             $colinfo->{$_}{seen_null} ||= ! defined $data->[$i]{$_}
2384 11   66     16 for keys %{$data->[$i]};
  11         94  
2385             }
2386             }
2387             else {
2388 0         0 $self->throw_exception('Unexpected populate() data structure member type: ' . ref $data->[$i] );
2389             }
2390              
2391 37049 100       48084 if ( grep
2392 15         55 { $_->{attrs}{is_depends_on} }
2393 37049 100       130659 @{ $current_slice_seen_rel_infos || [] }
2394             ) {
2395 2         12 carp_unique("Fast-path populate() of belongs_to relationship data is not possible - falling back to regular create()");
2396 2         251 return my $throwaway = $self->populate(@_);
2397             }
2398             }
2399              
2400 7698 100       16608 if( $slices_with_rels ) {
2401              
2402             # need to exclude the rel "columns"
2403 5         15 $colnames = [ grep { ! $colinfo->{$_}{is_rel} } @$colnames ];
  15         41  
2404              
2405             # extra sanity check - ensure the main source is in fact identifiable
2406             # the localizing of nullability is insane, but oh well... the use-case is legit
2407 5         20 my $ci = $rsrc->columns_info($colnames);
2408              
2409 8         36 $ci->{$_} = { %{$ci->{$_}}, is_nullable => 0 }
2410 5         19 for grep { ! $colinfo->{$_}{seen_null} } keys %$ci;
  10         31  
2411              
2412 5 100       34 unless( $rsrc->_identifying_column_set($ci) ) {
2413 1         7 carp_unique("Fast-path populate() of non-uniquely identifiable rows with related data is not possible - falling back to regular create()");
2414 1         145 return my $throwaway = $self->populate(@_);
2415             }
2416             }
2417              
2418             ### inherit the data locked in the conditions of the resultset
2419 7697         22163 my ($rs_data) = $self->_merge_with_rscond({});
2420 7697         18319 delete @{$rs_data}{@$colnames}; # passed-in stuff takes precedence
  7697         14495  
2421              
2422             # if anything left - decompose rs_data
2423 7697         11865 my $rs_data_vals;
2424 7697 100       19457 if (keys %$rs_data) {
2425             push @$rs_data_vals, $rs_data->{$_}
2426 9         44 for sort keys %$rs_data;
2427             }
2428              
2429             ### start work
2430 7697         10583 my $guard;
2431 7697 100       15317 $guard = $rsrc->schema->storage->txn_scope_guard
2432             if $slices_with_rels;
2433              
2434             ### main source data
2435             # FIXME - need to switch entirely to a coderef-based thing,
2436             # so that large sets aren't copied several times... I think
2437             $rsrc->storage->_insert_bulk(
2438             $rsrc,
2439             [ @$colnames, sort keys %$rs_data ],
2440             [ map {
2441 7697         24771 ref $data->[$_] eq 'ARRAY'
2442             ? (
2443 0 0       0 $slices_with_rels ? [ @{$data->[$_]}[0..$#$colnames], @{$rs_data_vals||[]} ] # the collist changed
  0         0  
2444 0         0 : $rs_data_vals ? [ @{$data->[$_]}, @$rs_data_vals ]
2445             : $data->[$_]
2446             )
2447 37043 50       353508 : [ @{$data->[$_]}{@$colnames}, @{$rs_data_vals||[]} ]
  103 50       201  
  103 100       1196  
    100          
2448             } $data_start .. $#$data ],
2449             );
2450              
2451             ### do the children relationships
2452 7690 100       31547 if ( $slices_with_rels ) {
2453 4 50       17 my @rels = grep { $colinfo->{$_}{is_rel} } keys %$colinfo
  13         45  
2454             or die 'wtf... please report a bug with DBIC_TRACE=1 output (stacktrace)';
2455              
2456 4         16 for my $sl (@$slices_with_rels) {
2457              
2458 9         19 my ($main_proto, $main_proto_rs);
2459 9         16 for my $rel (@rels) {
2460 9 50       27 next unless defined $sl->{$rel};
2461              
2462             $main_proto ||= {
2463             %$rs_data,
2464 9   50     44 (map { $_ => $sl->{$_} } @$colnames),
  17         68  
2465             };
2466              
2467 9 100       63 unless (defined $colinfo->{$rel}{rs}) {
2468              
2469 4         23 $colinfo->{$rel}{rs} = $rsrc->related_source($rel)->resultset;
2470              
2471 4         45 $colinfo->{$rel}{fk_map} = { reverse %{ $rsrc->_resolve_relationship_condition(
2472             rel_name => $rel,
2473             self_alias => "\xFE", # irrelevant
2474             foreign_alias => "\xFF", # irrelevant
2475 4 50       22 )->{identity_map} || {} } };
2476              
2477             }
2478              
2479             $colinfo->{$rel}{rs}->search({ map # only so that we inherit them values properly, no actual search
2480             {
2481             $_ => { '=' =>
2482             ( $main_proto_rs ||= $rsrc->resultset->search($main_proto) )
2483 10   66     64 ->get_column( $colinfo->{$rel}{fk_map}{$_} )
2484             ->as_query
2485             }
2486             }
2487 9         30 keys %{$colinfo->{$rel}{fk_map}}
2488 9 50       26 })->populate( ref $sl->{$rel} eq 'ARRAY' ? $sl->{$rel} : [ $sl->{$rel} ] );
2489              
2490 9         33 1;
2491             }
2492             }
2493             }
2494              
2495 7690 100       66690 $guard->commit if $guard;
2496             }
2497              
2498             =head2 pager
2499              
2500             =over 4
2501              
2502             =item Arguments: none
2503              
2504             =item Return Value: L<$pager|Data::Page>
2505              
2506             =back
2507              
2508             Returns a L<Data::Page> object for the current resultset. Only makes
2509             sense for queries with a C<page> attribute.
2510              
2511             To get the full count of entries for a paged resultset, call
2512             C<total_entries> on the L<Data::Page> object.
2513              
2514             =cut
2515              
2516             sub pager {
2517 28     28 1 8327 my ($self) = @_;
2518              
2519 28 100       131 return $self->{pager} if $self->{pager};
2520              
2521 16         39 my $attrs = $self->{attrs};
2522 16 50       65 if (!defined $attrs->{page}) {
    50          
2523 0         0 $self->throw_exception("Can't create pager for non-paged rs");
2524             }
2525             elsif ($attrs->{page} <= 0) {
2526 0         0 $self->throw_exception('Invalid page number (page-numbers are 1-based)');
2527             }
2528 16   50     47 $attrs->{rows} ||= 10;
2529              
2530             # throw away the paging flags and re-run the count (possibly
2531             # with a subselect) to get the real total count
2532 16         83 my $count_attrs = { %$attrs };
2533 16         40 delete @{$count_attrs}{qw/rows offset page pager/};
  16         53  
2534              
2535 16         83 my $total_rs = (ref $self)->new($self->result_source, $count_attrs);
2536              
2537 16         2339 require DBIx::Class::ResultSet::Pager;
2538             return $self->{pager} = DBIx::Class::ResultSet::Pager->new(
2539 10     10   39 sub { $total_rs->count }, #lazy-get the total
2540             $attrs->{rows},
2541             $self->{attrs}{page},
2542 16         198 );
2543             }
2544              
2545             =head2 page
2546              
2547             =over 4
2548              
2549             =item Arguments: $page_number
2550              
2551             =item Return Value: L<$resultset|/search>
2552              
2553             =back
2554              
2555             Returns a resultset for the $page_number page of the resultset on which page
2556             is called, where each page contains a number of rows equal to the 'rows'
2557             attribute set on the resultset (10 by default).
2558              
2559             =cut
2560              
2561             sub page {
2562 12     12 1 657 my ($self, $page) = @_;
2563 12         63 return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
  12         101  
2564             }
2565              
2566             =head2 new_result
2567              
2568             =over 4
2569              
2570             =item Arguments: \%col_data
2571              
2572             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
2573              
2574             =back
2575              
2576             Creates a new result object in the resultset's result class and returns
2577             it. The row is not inserted into the database at this point, call
2578             L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
2579             will tell you whether the result object has been inserted or not.
2580              
2581             Passes the hashref of input on to L<DBIx::Class::Row/new>.
2582              
2583             =cut
2584              
2585             sub new_result {
2586 1500     1500 1 3800 my ($self, $values) = @_;
2587              
2588 1500 50       4421 $self->throw_exception( "new_result takes only one argument - a hashref of values" )
2589             if @_ > 2;
2590              
2591 1500 50       4809 $self->throw_exception( "Result object instantiation requires a hashref as argument" )
2592             unless (ref $values eq 'HASH');
2593              
2594 1500         4347 my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values);
2595              
2596 1500 100       5160 my $new = $self->result_class->new({
2597             %$merged_cond,
2598             ( @$cols_from_relations
2599             ? (-cols_from_relations => $cols_from_relations)
2600             : ()
2601             ),
2602             -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
2603             });
2604              
2605 1498 50 33     12229 if (
      33        
2606             reftype($new) eq 'HASH'
2607             and
2608             ! keys %$new
2609             and
2610             blessed($new)
2611             ) {
2612 0         0 carp_unique (sprintf (
2613             "%s->new returned a blessed empty hashref - a strong indicator something is wrong with its inheritance chain",
2614             $self->result_class,
2615             ));
2616             }
2617              
2618 1498         10992 $new;
2619             }
2620              
2621             # _merge_with_rscond
2622             #
2623             # Takes a simple hash of K/V data and returns its copy merged with the
2624             # condition already present on the resultset. Additionally returns an
2625             # arrayref of value/condition names, which were inferred from related
2626             # objects (this is needed for in-memory related objects)
2627             sub _merge_with_rscond {
2628 12460     12460   25564 my ($self, $data) = @_;
2629              
2630 12460         20280 my ($implied_data, @cols_from_relations);
2631              
2632 12460         40832 my $alias = $self->{attrs}{alias};
2633              
2634 12460 100       34447 if (! defined $self->{cond}) {
    100          
2635             # just massage $data below
2636             }
2637             elsif ($self->{cond} eq UNRESOLVABLE_CONDITION) {
2638 6         16 $implied_data = $self->{attrs}{related_objects}; # nothing might have been inserted yet
2639 6 50       14 @cols_from_relations = keys %{ $implied_data || {} };
  6         36  
2640             }
2641             else {
2642 2073         8756 my $eqs = $self->result_source->schema->storage->_extract_fixed_condition_columns($self->{cond}, 'consider_nulls');
2643             $implied_data = { map {
2644 2073 50 100     6110 ( ($eqs->{$_}||'') eq UNRESOLVABLE_CONDITION ) ? () : ( $_ => $eqs->{$_} )
  2117         13433  
2645             } keys %$eqs };
2646             }
2647              
2648             return (
2649             { map
2650 12460   100     43353 { %{ $self->_remove_alias($_, $alias) } }
  14539         21173  
  14539         35446  
2651             # precedence must be given to passed values over values inherited from
2652             # the cond, so the order here is important.
2653             ( $implied_data||(), $data)
2654             },
2655             \@cols_from_relations
2656             );
2657             }
2658              
2659             # _has_resolved_attr
2660             #
2661             # determines if the resultset defines at least one
2662             # of the attributes supplied
2663             #
2664             # used to determine if a subquery is necessary
2665             #
2666             # supports some virtual attributes:
2667             # -join
2668             # This will scan for any joins being present on the resultset.
2669             # It is not a mere key-search but a deep inspection of {from}
2670             #
2671              
2672             sub _has_resolved_attr {
2673 1424     1424   4495 my ($self, @attr_names) = @_;
2674              
2675 1424         3805 my $attrs = $self->_resolved_attrs;
2676              
2677 1424         2800 my %extra_checks;
2678              
2679 1424         3324 for my $n (@attr_names) {
2680 3298 50       5576 if (grep { $n eq $_ } (qw/-join/) ) {
  3298         9441  
2681 0         0 $extra_checks{$n}++;
2682 0         0 next;
2683             }
2684              
2685 3298         5919 my $attr = $attrs->{$n};
2686              
2687 3298 100       8154 next if not defined $attr;
2688              
2689 125 50       652 if (ref $attr eq 'HASH') {
    100          
2690 0 0       0 return 1 if keys %$attr;
2691             }
2692             elsif (ref $attr eq 'ARRAY') {
2693 64 50       341 return 1 if @$attr;
2694             }
2695             else {
2696 61 100       421 return 1 if $attr;
2697             }
2698             }
2699              
2700             # a resolved join is expressed as a multi-level from
2701             return 1 if (
2702             $extra_checks{-join}
2703             and
2704             ref $attrs->{from} eq 'ARRAY'
2705             and
2706 1319 0 33     4759 @{$attrs->{from}} > 1
  0   33     0  
2707             );
2708              
2709 1319         4948 return 0;
2710             }
2711              
2712             # _remove_alias
2713             #
2714             # Remove the specified alias from the specified query hash. A copy is made so
2715             # the original query is not modified.
2716              
2717             sub _remove_alias {
2718 14539     14539   30141 my ($self, $query, $alias) = @_;
2719              
2720 14539 50       21248 my %orig = %{ $query || {} };
  14539         49505  
2721 14539         24693 my %unaliased;
2722              
2723 14539         30988 foreach my $key (keys %orig) {
2724 8374 100       23409 if ($key !~ /\./) {
2725 6713         13981 $unaliased{$key} = $orig{$key};
2726 6713         12289 next;
2727             }
2728 1661 100       18461 $unaliased{$1} = $orig{$key}
2729             if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
2730             }
2731              
2732 14539         92999 return \%unaliased;
2733             }
2734              
2735             =head2 as_query
2736              
2737             =over 4
2738              
2739             =item Arguments: none
2740              
2741             =item Return Value: \[ $sql, L<@bind_values|/DBIC BIND VALUES> ]
2742              
2743             =back
2744              
2745             Returns the SQL query and bind vars associated with the invocant.
2746              
2747             This is generally used as the RHS for a subquery.
2748              
2749             =cut
2750              
2751             sub as_query {
2752 662     662 1 274488 my $self = shift;
2753              
2754 662         1136 my $attrs = { %{ $self->_resolved_attrs } };
  662         1977  
2755              
2756             my $aq = $self->result_source->storage->_select_args_to_query (
2757 662         3832 $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
2758             );
2759              
2760 658         7699 $aq;
2761             }
2762              
2763             =head2 find_or_new
2764              
2765             =over 4
2766              
2767             =item Arguments: \%col_data, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
2768              
2769             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
2770              
2771             =back
2772              
2773             my $artist = $schema->resultset('Artist')->find_or_new(
2774             { artist => 'fred' }, { key => 'artists' });
2775              
2776             $cd->cd_to_producer->find_or_new({ producer => $producer },
2777             { key => 'primary' });
2778              
2779             Find an existing record from this resultset using L</find>. if none exists,
2780             instantiate a new result object and return it. The object will not be saved
2781             into your storage until you call L<DBIx::Class::Row/insert> on it.
2782              
2783             You most likely want this method when looking for existing rows using a unique
2784             constraint that is not the primary key, or looking for related rows.
2785              
2786             If you want objects to be saved immediately, use L</find_or_create> instead.
2787              
2788             B<Note>: Make sure to read the documentation of L</find> and understand the
2789             significance of the C<key> attribute, as its lack may skew your search, and
2790             subsequently result in spurious new objects.
2791              
2792             B<Note>: Take care when using C<find_or_new> with a table having
2793             columns with default values that you intend to be automatically
2794             supplied by the database (e.g. an auto_increment primary key column).
2795             In normal usage, the value of such columns should NOT be included at
2796             all in the call to C<find_or_new>, even when set to C<undef>.
2797              
2798             =cut
2799              
2800             sub find_or_new {
2801 4     4 1 13 my $self = shift;
2802 4 100 66     26 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2803 4 50       20 my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
2804 4 100 66     28 if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2805 2         10 return $row;
2806             }
2807 2         10 return $self->new_result($hash);
2808             }
2809              
2810             =head2 create
2811              
2812             =over 4
2813              
2814             =item Arguments: \%col_data
2815              
2816             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
2817              
2818             =back
2819              
2820             Attempt to create a single new row or a row with multiple related rows
2821             in the table represented by the resultset (and related tables). This
2822             will not check for duplicate rows before inserting, use
2823             L</find_or_create> to do that.
2824              
2825             To create one row for this resultset, pass a hashref of key/value
2826             pairs representing the columns of the table and the values you wish to
2827             store. If the appropriate relationships are set up, foreign key fields
2828             can also be passed an object representing the foreign row, and the
2829             value will be set to its primary key.
2830              
2831             To create related objects, pass a hashref of related-object column values
2832             B<keyed on the relationship name>. If the relationship is of type C<multi>
2833             (L<DBIx::Class::Relationship/has_many>) - pass an arrayref of hashrefs.
2834             The process will correctly identify columns holding foreign keys, and will
2835             transparently populate them from the keys of the corresponding relation.
2836             This can be applied recursively, and will work correctly for a structure
2837             with an arbitrary depth and width, as long as the relationships actually
2838             exists and the correct column data has been supplied.
2839              
2840             Instead of hashrefs of plain related data (key/value pairs), you may
2841             also pass new or inserted objects. New objects (not inserted yet, see
2842             L</new_result>), will be inserted into their appropriate tables.
2843              
2844             Effectively a shortcut for C<< ->new_result(\%col_data)->insert >>.
2845              
2846             Example of creating a new row.
2847              
2848             $person_rs->create({
2849             name=>"Some Person",
2850             email=>"somebody@someplace.com"
2851             });
2852              
2853             Example of creating a new row and also creating rows in a related C<has_many>
2854             or C<has_one> resultset. Note Arrayref.
2855              
2856             $artist_rs->create(
2857             { artistid => 4, name => 'Manufactured Crap', cds => [
2858             { title => 'My First CD', year => 2006 },
2859             { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2860             ],
2861             },
2862             );
2863              
2864             Example of creating a new row and also creating a row in a related
2865             C<belongs_to> resultset. Note Hashref.
2866              
2867             $cd_rs->create({
2868             title=>"Music for Silly Walks",
2869             year=>2000,
2870             artist => {
2871             name=>"Silly Musician",
2872             }
2873             });
2874              
2875             =over
2876              
2877             =item WARNING
2878              
2879             When subclassing ResultSet never attempt to override this method. Since
2880             it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a
2881             lot of the internals simply never call it, so your override will be
2882             bypassed more often than not. Override either L<DBIx::Class::Row/new>
2883             or L<DBIx::Class::Row/insert> depending on how early in the
2884             L</create> process you need to intervene. See also warning pertaining to
2885             L</new>.
2886              
2887             =back
2888              
2889             =cut
2890              
2891             sub create {
2892             #my ($self, $col_data) = @_;
2893 392     392 1 9424 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
2894 392         2025 return shift->new_result(shift)->insert;
2895             }
2896              
2897             =head2 find_or_create
2898              
2899             =over 4
2900              
2901             =item Arguments: \%col_data, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
2902              
2903             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
2904              
2905             =back
2906              
2907             $cd->cd_to_producer->find_or_create({ producer => $producer },
2908             { key => 'primary' });
2909              
2910             Tries to find a record based on its primary key or unique constraints; if none
2911             is found, creates one and returns that instead.
2912              
2913             my $cd = $schema->resultset('CD')->find_or_create({
2914             cdid => 5,
2915             artist => 'Massive Attack',
2916             title => 'Mezzanine',
2917             year => 2005,
2918             });
2919              
2920             Also takes an optional C<key> attribute, to search by a specific key or unique
2921             constraint. For example:
2922              
2923             my $cd = $schema->resultset('CD')->find_or_create(
2924             {
2925             artist => 'Massive Attack',
2926             title => 'Mezzanine',
2927             },
2928             { key => 'cd_artist_title' }
2929             );
2930              
2931             B<Note>: Make sure to read the documentation of L</find> and understand the
2932             significance of the C<key> attribute, as its lack may skew your search, and
2933             subsequently result in spurious row creation.
2934              
2935             B<Note>: Because find_or_create() reads from the database and then
2936             possibly inserts based on the result, this method is subject to a race
2937             condition. Another process could create a record in the table after
2938             the find has completed and before the create has started. To avoid
2939             this problem, use find_or_create() inside a transaction.
2940              
2941             B<Note>: Take care when using C<find_or_create> with a table having
2942             columns with default values that you intend to be automatically
2943             supplied by the database (e.g. an auto_increment primary key column).
2944             In normal usage, the value of such columns should NOT be included at
2945             all in the call to C<find_or_create>, even when set to C<undef>.
2946              
2947             See also L</find> and L</update_or_create>. For information on how to declare
2948             unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2949              
2950             If you need to know if an existing row was found or a new one created use
2951             L</find_or_new> and L<DBIx::Class::Row/in_storage> instead. Don't forget
2952             to call L<DBIx::Class::Row/insert> to save the newly created row to the
2953             database!
2954              
2955             my $cd = $schema->resultset('CD')->find_or_new({
2956             cdid => 5,
2957             artist => 'Massive Attack',
2958             title => 'Mezzanine',
2959             year => 2005,
2960             });
2961              
2962             if( !$cd->in_storage ) {
2963             # do some stuff
2964             $cd->insert;
2965             }
2966              
2967             =cut
2968              
2969             sub find_or_create {
2970 30     30 1 154 my $self = shift;
2971 30 100 66     167 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2972 30 50       113 my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
2973 30 100 66     221 if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2974 7         87 return $row;
2975             }
2976 21         261 return $self->new_result($hash)->insert;
2977             }
2978              
2979             =head2 update_or_create
2980              
2981             =over 4
2982              
2983             =item Arguments: \%col_data, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
2984              
2985             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
2986              
2987             =back
2988              
2989             $resultset->update_or_create({ col => $val, ... });
2990              
2991             Like L</find_or_create>, but if a row is found it is immediately updated via
2992             C<< $found_row->update (\%col_data) >>.
2993              
2994              
2995             Takes an optional C<key> attribute to search on a specific unique constraint.
2996             For example:
2997              
2998             # In your application
2999             my $cd = $schema->resultset('CD')->update_or_create(
3000             {
3001             artist => 'Massive Attack',
3002             title => 'Mezzanine',
3003             year => 1998,
3004             },
3005             { key => 'cd_artist_title' }
3006             );
3007              
3008             $cd->cd_to_producer->update_or_create({
3009             producer => $producer,
3010             name => 'harry',
3011             }, {
3012             key => 'primary',
3013             });
3014              
3015             B<Note>: Make sure to read the documentation of L</find> and understand the
3016             significance of the C<key> attribute, as its lack may skew your search, and
3017             subsequently result in spurious row creation.
3018              
3019             B<Note>: Take care when using C<update_or_create> with a table having
3020             columns with default values that you intend to be automatically
3021             supplied by the database (e.g. an auto_increment primary key column).
3022             In normal usage, the value of such columns should NOT be included at
3023             all in the call to C<update_or_create>, even when set to C<undef>.
3024              
3025             See also L</find> and L</find_or_create>. For information on how to declare
3026             unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
3027              
3028             If you need to know if an existing row was updated or a new one created use
3029             L</update_or_new> and L<DBIx::Class::Row/in_storage> instead. Don't forget
3030             to call L<DBIx::Class::Row/insert> to save the newly created row to the
3031             database!
3032              
3033             =cut
3034              
3035             sub update_or_create {
3036 15     15 1 1205 my $self = shift;
3037 15 100 66     94 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
3038 15 50       55 my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
3039              
3040 15         61 my $row = $self->find($cond, $attrs);
3041 15 100       66 if (defined $row) {
3042 9         99 $row->update($cond);
3043 9         40 return $row;
3044             }
3045              
3046 6         32 return $self->new_result($cond)->insert;
3047             }
3048              
3049             =head2 update_or_new
3050              
3051             =over 4
3052              
3053             =item Arguments: \%col_data, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
3054              
3055             =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
3056              
3057             =back
3058              
3059             $resultset->update_or_new({ col => $val, ... });
3060              
3061             Like L</find_or_new> but if a row is found it is immediately updated via
3062             C<< $found_row->update (\%col_data) >>.
3063              
3064             For example:
3065              
3066             # In your application
3067             my $cd = $schema->resultset('CD')->update_or_new(
3068             {
3069             artist => 'Massive Attack',
3070             title => 'Mezzanine',
3071             year => 1998,
3072             },
3073             { key => 'cd_artist_title' }
3074             );
3075              
3076             if ($cd->in_storage) {
3077             # the cd was updated
3078             }
3079             else {
3080             # the cd is not yet in the database, let's insert it
3081             $cd->insert;
3082             }
3083              
3084             B<Note>: Make sure to read the documentation of L</find> and understand the
3085             significance of the C<key> attribute, as its lack may skew your search, and
3086             subsequently result in spurious new objects.
3087              
3088             B<Note>: Take care when using C<update_or_new> with a table having
3089             columns with default values that you intend to be automatically
3090             supplied by the database (e.g. an auto_increment primary key column).
3091             In normal usage, the value of such columns should NOT be included at
3092             all in the call to C<update_or_new>, even when set to C<undef>.
3093              
3094             See also L</find>, L</find_or_create> and L</find_or_new>.
3095              
3096             =cut
3097              
3098             sub update_or_new {
3099 2     2 1 8 my $self = shift;
3100 2 50 33     15 my $attrs = ( @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {} );
3101 2 50       8 my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
3102              
3103 2         7 my $row = $self->find( $cond, $attrs );
3104 2 100       9 if ( defined $row ) {
3105 1         7 $row->update($cond);
3106 1         4 return $row;
3107             }
3108              
3109 1         5 return $self->new_result($cond);
3110             }
3111              
3112             =head2 get_cache
3113              
3114             =over 4
3115              
3116             =item Arguments: none
3117              
3118             =item Return Value: L<\@result_objs|DBIx::Class::Manual::ResultClass> | undef
3119              
3120             =back
3121              
3122             Gets the contents of the cache for the resultset, if the cache is set.
3123              
3124             The cache is populated either by using the L</prefetch> attribute to
3125             L</search> or by calling L</set_cache>.
3126              
3127             =cut
3128              
3129             sub get_cache {
3130 44256     44256 1 185143 shift->{all_cache};
3131             }
3132              
3133             =head2 set_cache
3134              
3135             =over 4
3136              
3137             =item Arguments: L<\@result_objs|DBIx::Class::Manual::ResultClass>
3138              
3139             =item Return Value: L<\@result_objs|DBIx::Class::Manual::ResultClass>
3140              
3141             =back
3142              
3143             Sets the contents of the cache for the resultset. Expects an arrayref
3144             of objects of the same class as those produced by the resultset. Note that
3145             if the cache is set, the resultset will return the cached objects rather
3146             than re-querying the database even if the cache attr is not set.
3147              
3148             The contents of the cache can also be populated by using the
3149             L</prefetch> attribute to L</search>.
3150              
3151             =cut
3152              
3153             sub set_cache {
3154 798     798 1 1683 my ( $self, $data ) = @_;
3155 798 50 66     3376 $self->throw_exception("set_cache requires an arrayref")
3156             if defined($data) && (ref $data ne 'ARRAY');
3157 798         2588 $self->{all_cache} = $data;
3158             }
3159              
3160             =head2 clear_cache
3161              
3162             =over 4
3163              
3164             =item Arguments: none
3165              
3166             =item Return Value: undef
3167              
3168             =back
3169              
3170             Clears the cache for the resultset.
3171              
3172             =cut
3173              
3174             sub clear_cache {
3175 2     2 1 6 shift->set_cache(undef);
3176             }
3177              
3178             =head2 is_paged
3179              
3180             =over 4
3181              
3182             =item Arguments: none
3183              
3184             =item Return Value: true, if the resultset has been paginated
3185              
3186             =back
3187              
3188             =cut
3189              
3190             sub is_paged {
3191 2     2 1 16 my ($self) = @_;
3192 2         14 return !!$self->{attrs}{page};
3193             }
3194              
3195             =head2 is_ordered
3196              
3197             =over 4
3198              
3199             =item Arguments: none
3200              
3201             =item Return Value: true, if the resultset has been ordered with C<order_by>.
3202              
3203             =back
3204              
3205             =cut
3206              
3207             sub is_ordered {
3208 14     14 1 66 my ($self) = @_;
3209 14         54 return scalar $self->result_source->storage->_extract_order_criteria($self->{attrs}{order_by});
3210             }
3211              
3212             =head2 related_resultset
3213              
3214             =over 4
3215              
3216             =item Arguments: $rel_name
3217              
3218             =item Return Value: L<$resultset|/search>
3219              
3220             =back
3221              
3222             Returns a related resultset for the supplied relationship name.
3223              
3224             $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
3225              
3226             =cut
3227              
3228             sub related_resultset {
3229 230     230 1 2022 my ($self, $rel) = @_;
3230              
3231             return $self->{related_resultsets}{$rel}
3232 230 100       1003 if defined $self->{related_resultsets}{$rel};
3233              
3234 216         424 return $self->{related_resultsets}{$rel} = do {
3235 216         598 my $rsrc = $self->result_source;
3236 216         1198 my $rel_info = $rsrc->relationship_info($rel);
3237              
3238 216 50       749 $self->throw_exception(
3239             "search_related: result source '" . $rsrc->source_name .
3240             "' has no such relationship $rel")
3241             unless $rel_info;
3242              
3243 216         882 my $attrs = $self->_chain_relationship($rel);
3244              
3245 216         626 my $join_count = $attrs->{seen_join}{$rel};
3246              
3247 216         1050 my $alias = $self->result_source->storage
3248             ->relname_to_table_alias($rel, $join_count);
3249              
3250             # since this is search_related, and we already slid the select window inwards
3251             # (the select/as attrs were deleted in the beginning), we need to flip all
3252             # left joins to inner, so we get the expected results
3253             # read the comment on top of the actual function to see what this does
3254 216         1178 $attrs->{from} = $rsrc->schema->storage->_inner_join_to_node ($attrs->{from}, $alias);
3255              
3256              
3257             #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
3258 216         507 delete @{$attrs}{qw(result_class alias)};
  216         685  
3259              
3260 216         792 my $rel_source = $rsrc->related_source($rel);
3261              
3262 216         988 my $new = do {
3263              
3264             # The reason we do this now instead of passing the alias to the
3265             # search_rs below is that if you wrap/overload resultset on the
3266             # source you need to know what alias it's -going- to have for things
3267             # to work sanely (e.g. RestrictWithObject wants to be able to add
3268             # extra query restrictions, and these may need to be $alias.)
3269              
3270 216         871 my $rel_attrs = $rel_source->resultset_attributes;
3271 216         650 local $rel_attrs->{alias} = $alias;
3272              
3273             $rel_source->resultset
3274             ->search_rs(
3275             undef, {
3276             %$attrs,
3277             where => $attrs->{where},
3278 216         769 });
3279             };
3280              
3281 216 100       1164 if (my $cache = $self->get_cache) {
3282             my @related_cache = map
3283 13 100       41 { $_->related_resultset($rel)->get_cache || () }
  39         113  
3284             @$cache
3285             ;
3286              
3287 13 100       76 $new->set_cache([ map @$_, @related_cache ]) if @related_cache == @$cache;
3288             }
3289              
3290 216         1456 $new;
3291             };
3292             }
3293              
3294             =head2 current_source_alias
3295              
3296             =over 4
3297              
3298             =item Arguments: none
3299              
3300             =item Return Value: $source_alias
3301              
3302             =back
3303              
3304             Returns the current table alias for the result source this resultset is built
3305             on, that will be used in the SQL query. Usually it is C<me>.
3306              
3307             Currently the source alias that refers to the result set returned by a
3308             L</search>/L</find> family method depends on how you got to the resultset: it's
3309             C<me> by default, but eg. L</search_related> aliases it to the related result
3310             source name (and keeps C<me> referring to the original result set). The long
3311             term goal is to make L<DBIx::Class> always alias the current resultset as C<me>
3312             (and make this method unnecessary).
3313              
3314             Thus it's currently necessary to use this method in predefined queries (see
3315             L<DBIx::Class::Manual::Cookbook/Predefined searches>) when referring to the
3316             source alias of the current result set:
3317              
3318             # in a result set class
3319             sub modified_by {
3320             my ($self, $user) = @_;
3321              
3322             my $me = $self->current_source_alias;
3323              
3324             return $self->search({
3325             "$me.modified" => $user->id,
3326             });
3327             }
3328              
3329             The alias of L<newly created resultsets|/search> can be altered by the
3330             L<alias attribute|/alias>.
3331              
3332             =cut
3333              
3334             sub current_source_alias {
3335 720   50 720 1 4038 return (shift->{attrs} || {})->{alias} || 'me';
3336             }
3337              
3338             =head2 as_subselect_rs
3339              
3340             =over 4
3341              
3342             =item Arguments: none
3343              
3344             =item Return Value: L<$resultset|/search>
3345              
3346             =back
3347              
3348             Act as a barrier to SQL symbols. The resultset provided will be made into a
3349             "virtual view" by including it as a subquery within the from clause. From this
3350             point on, any joined tables are inaccessible to ->search on the resultset (as if
3351             it were simply where-filtered without joins). For example:
3352              
3353             my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' });
3354              
3355             # 'x' now pollutes the query namespace
3356              
3357             # So the following works as expected
3358             my $ok_rs = $rs->search({'x.other' => 1});
3359              
3360             # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and
3361             # def) we look for one row with contradictory terms and join in another table
3362             # (aliased 'x_2') which we never use
3363             my $broken_rs = $rs->search({'x.name' => 'def'});
3364              
3365             my $rs2 = $rs->as_subselect_rs;
3366              
3367             # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away
3368             my $not_joined_rs = $rs2->search({'x.other' => 1});
3369              
3370             # works as expected: finds a 'table' row related to two x rows (abc and def)
3371             my $correctly_joined_rs = $rs2->search({'x.name' => 'def'});
3372              
3373             Another example of when one might use this would be to select a subset of
3374             columns in a group by clause:
3375              
3376             my $rs = $schema->resultset('Bar')->search(undef, {
3377             group_by => [qw{ id foo_id baz_id }],
3378             })->as_subselect_rs->search(undef, {
3379             columns => [qw{ id foo_id }]
3380             });
3381              
3382             In the above example normally columns would have to be equal to the group by,
3383             but because we isolated the group by into a subselect the above works.
3384              
3385             =cut
3386              
3387             sub as_subselect_rs {
3388 109     109 1 278 my $self = shift;
3389              
3390 109         429 my $attrs = $self->_resolved_attrs;
3391              
3392 109         571 my $fresh_rs = (ref $self)->new (
3393             $self->result_source
3394             );
3395              
3396             # these pieces will be locked in the subquery
3397 109         299 delete $fresh_rs->{cond};
3398 109         237 delete @{$fresh_rs->{attrs}}{qw/where bind/};
  109         353  
3399              
3400             return $fresh_rs->search( {}, {
3401             from => [{
3402             $attrs->{alias} => $self->as_query,
3403             -alias => $attrs->{alias},
3404             -rsrc => $self->result_source,
3405             }],
3406             alias => $attrs->{alias},
3407 109         572 });
3408             }
3409              
3410             # This code is called by search_related, and makes sure there
3411             # is clear separation between the joins before, during, and
3412             # after the relationship. This information is needed later
3413             # in order to properly resolve prefetch aliases (any alias
3414             # with a relation_chain_depth less than the depth of the
3415             # current prefetch is not considered)
3416             #
3417             # The increments happen twice per join. An even number means a
3418             # relationship specified via a search_related, whereas an odd
3419             # number indicates a join/prefetch added via attributes
3420             #
3421             # Also this code will wrap the current resultset (the one we
3422             # chain to) in a subselect IFF it contains limiting attributes
3423             sub _chain_relationship {
3424 216     216   527 my ($self, $rel) = @_;
3425 216         521 my $source = $self->result_source;
3426 216 50       417 my $attrs = { %{$self->{attrs}||{}} };
  216         1415  
3427              
3428             # we need to take the prefetch the attrs into account before we
3429             # ->_resolve_join as otherwise they get lost - captainL
3430 216         1352 my $join = $self->_merge_joinpref_attr( $attrs->{join}, $attrs->{prefetch} );
3431              
3432 216         701 delete @{$attrs}{qw/join prefetch collapse group_by distinct _grouped_by_distinct select as columns +select +as +columns/};
  216         726  
3433              
3434 216 100       447 my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
  216         1200  
3435              
3436 216         511 my $from;
3437 216         769 my @force_subq_attrs = qw/offset rows group_by having/;
3438              
3439 216 100 66     1507 if (
    100 66        
3440             ($attrs->{from} && ref $attrs->{from} ne 'ARRAY')
3441             ||
3442             $self->_has_resolved_attr (@force_subq_attrs)
3443             ) {
3444             # Nuke the prefetch (if any) before the new $rs attrs
3445             # are resolved (prefetch is useless - we are wrapping
3446             # a subquery anyway).
3447 9         37 my $rs_copy = $self->search;
3448             $rs_copy->{attrs}{join} = $self->_merge_joinpref_attr (
3449             $rs_copy->{attrs}{join},
3450             delete $rs_copy->{attrs}{prefetch},
3451 9         64 );
3452              
3453             $from = [{
3454             -rsrc => $source,
3455             -alias => $attrs->{alias},
3456 9         65 $attrs->{alias} => $rs_copy->as_query,
3457             }];
3458 9         36 delete @{$attrs}{@force_subq_attrs, qw/where bind/};
  9         33  
3459 9         67 $seen->{-relation_chain_depth} = 0;
3460             }
3461             elsif ($attrs->{from}) { #shallow copy suffices
3462 22         60 $from = [ @{$attrs->{from}} ];
  22         69  
3463             }
3464             else {
3465             $from = [{
3466             -rsrc => $source,
3467             -alias => $attrs->{alias},
3468 185         925 $attrs->{alias} => $source->from,
3469             }];
3470             }
3471              
3472             my $jpath = ($seen->{-relation_chain_depth})
3473             ? $from->[-1][0]{-join_path}
3474 216 100       779 : [];
3475              
3476             my @requested_joins = $source->_resolve_join(
3477             $join,
3478             $attrs->{alias},
3479 216         1294 $seen,
3480             $jpath,
3481             );
3482              
3483 216         506 push @$from, @requested_joins;
3484              
3485 216         925 $seen->{-relation_chain_depth}++;
3486              
3487             # if $self already had a join/prefetch specified on it, the requested
3488             # $rel might very well be already included. What we do in this case
3489             # is effectively a no-op (except that we bump up the chain_depth on
3490             # the join in question so we could tell it *is* the search_related)
3491 216         409 my $already_joined;
3492              
3493             # we consider the last one thus reverse
3494 216         504 for my $j (reverse @requested_joins) {
3495 30         55 my ($last_j) = keys %{$j->[0]{-join_path}[-1]};
  30         117  
3496 30 100       128 if ($rel eq $last_j) {
3497 12         35 $j->[0]{-relation_chain_depth}++;
3498 12         23 $already_joined++;
3499 12         35 last;
3500             }
3501             }
3502              
3503 216 100       611 unless ($already_joined) {
3504             push @$from, $source->_resolve_join(
3505             $rel,
3506             $attrs->{alias},
3507 204         759 $seen,
3508             $jpath,
3509             );
3510             }
3511              
3512 216         601 $seen->{-relation_chain_depth}++;
3513              
3514 216         1910 return {%$attrs, from => $from, seen_join => $seen};
3515             }
3516              
3517             sub _resolved_attrs {
3518 20896     20896   33677 my $self = shift;
3519 20896 100       65553 return $self->{_attrs} if $self->{_attrs};
3520              
3521 9008 50       13864 my $attrs = { %{ $self->{attrs} || {} } };
  9008         55658  
3522 9008         31476 my $source = $attrs->{result_source} = $self->result_source;
3523 9008         16325 my $alias = $attrs->{alias};
3524              
3525             $self->throw_exception("Specifying distinct => 1 in conjunction with collapse => 1 is unsupported")
3526 9008 50 66     21570 if $attrs->{collapse} and $attrs->{distinct};
3527              
3528             # default selection list
3529             $attrs->{columns} = [ $source->columns ]
3530 9008 100   30971   47531 unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/;
  30971         72495  
3531              
3532             # merge selectors together
3533 9008         35296 for (qw/columns select as/) {
3534             $attrs->{$_} = $self->_merge_attr($attrs->{$_}, delete $attrs->{"+$_"})
3535 27024 100 100     127154 if $attrs->{$_} or $attrs->{"+$_"};
3536             }
3537              
3538             # disassemble columns
3539 9008         16985 my (@sel, @as);
3540 9008 100       26268 if (my $cols = delete $attrs->{columns}) {
3541 7888 50       25195 for my $c (ref $cols eq 'ARRAY' ? @$cols : $cols) {
3542 35938 100       58674 if (ref $c eq 'HASH') {
3543 1068         4080 for my $as (sort keys %$c) {
3544 1135         2887 push @sel, $c->{$as};
3545 1135         3246 push @as, $as;
3546             }
3547             }
3548             else {
3549 34870         57996 push @sel, $c;
3550 34870         58648 push @as, $c;
3551             }
3552             }
3553             }
3554              
3555             # when trying to weed off duplicates later do not go past this point -
3556             # everything added from here on is unbalanced "anyone's guess" stuff
3557 9008         17158 my $dedup_stop_idx = $#as;
3558              
3559 1170 50       5404 push @as, @{ ref $attrs->{as} eq 'ARRAY' ? $attrs->{as} : [ $attrs->{as} ] }
3560 9008 100       22613 if $attrs->{as};
3561 1175 50       4061 push @sel, @{ ref $attrs->{select} eq 'ARRAY' ? $attrs->{select} : [ $attrs->{select} ] }
3562 9008 100       20750 if $attrs->{select};
3563              
3564             # assume all unqualified selectors to apply to the current alias (legacy stuff)
3565 9008 100 100     99632 $_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_" for @sel;
3566              
3567             # disqualify all $alias.col as-bits (inflate-map mandated)
3568 9008 100       96884 $_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_ for @as;
3569              
3570             # de-duplicate the result (remove *identical* select/as pairs)
3571             # and also die on duplicate {as} pointing to different {select}s
3572             # not using a c-style for as the condition is prone to shrinkage
3573 9008         15764 my $seen;
3574 9008         14212 my $i = 0;
3575 9008         21342 while ($i <= $dedup_stop_idx) {
3576 36005 100       137235 if ($seen->{"$sel[$i] \x00\x00 $as[$i]"}++) {
    50          
3577 10         20 splice @sel, $i, 1;
3578 10         20 splice @as, $i, 1;
3579 10         23 $dedup_stop_idx--;
3580             }
3581             elsif ($seen->{$as[$i]}++) {
3582 0         0 $self->throw_exception(
3583             "inflate_result() alias '$as[$i]' specified twice with different SQL-side {select}-ors"
3584             );
3585             }
3586             else {
3587 35995         67145 $i++;
3588             }
3589             }
3590              
3591 9008         21181 $attrs->{select} = \@sel;
3592 9008         19368 $attrs->{as} = \@as;
3593              
3594             $attrs->{from} ||= [{
3595             -rsrc => $source,
3596             -alias => $self->{attrs}{alias},
3597 9008   100     56784 $self->{attrs}{alias} => $source->from,
3598             }];
3599              
3600 9008 100 100     36225 if ( $attrs->{join} || $attrs->{prefetch} ) {
3601              
3602             $self->throw_exception ('join/prefetch can not be used with a custom {from}')
3603 720 50       2721 if ref $attrs->{from} ne 'ARRAY';
3604              
3605 720   100     2503 my $join = (delete $attrs->{join}) || {};
3606              
3607 720 100       2219 if ( defined $attrs->{prefetch} ) {
3608 485         1610 $join = $self->_merge_joinpref_attr( $join, $attrs->{prefetch} );
3609             }
3610              
3611             $attrs->{from} = # have to copy here to avoid corrupting the original
3612             [
3613 720         1816 @{ $attrs->{from} },
3614             $source->_resolve_join(
3615             $join,
3616             $alias,
3617 720 100       7431 { %{ $attrs->{seen_join} || {} } },
3618             ( $attrs->{seen_join} && keys %{$attrs->{seen_join}})
3619             ? $attrs->{from}[-1][0]{-join_path}
3620 720 100 100     1366 : []
3621             ,
3622             )
3623             ];
3624             }
3625              
3626 9008         18816 for my $attr (qw(order_by group_by)) {
3627              
3628 18016 100       41327 if ( defined $attrs->{$attr} ) {
3629             $attrs->{$attr} = (
3630             ref( $attrs->{$attr} ) eq 'ARRAY'
3631 629         2339 ? [ @{ $attrs->{$attr} } ]
3632 3583 100 66     16344 : [ $attrs->{$attr} || () ]
3633             );
3634              
3635 3583 100       6352 delete $attrs->{$attr} unless @{$attrs->{$attr}};
  3583         11291  
3636             }
3637             }
3638              
3639             # generate selections based on the prefetch helper
3640 9008         15472 my ($prefetch, @prefetch_select, @prefetch_as);
3641             $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} )
3642 9008 100       21751 if defined $attrs->{prefetch};
3643              
3644 9008 100       19487 if ($prefetch) {
3645              
3646             $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
3647 353 100       1141 if $attrs->{_dark_selector};
3648              
3649             $self->throw_exception("Specifying prefetch in conjunction with an explicit collapse => 0 is unsupported")
3650 352 50 33     1321 if defined $attrs->{collapse} and ! $attrs->{collapse};
3651              
3652 352         835 $attrs->{collapse} = 1;
3653              
3654             # this is a separate structure (we don't look in {from} directly)
3655             # as the resolver needs to shift things off the lists to work
3656             # properly (identical-prefetches on different branches)
3657 352         762 my $join_map = {};
3658 352 50       1389 if (ref $attrs->{from} eq 'ARRAY') {
3659              
3660 352   100     1788 my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0;
3661              
3662 352         887 for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
  352         1012  
  352         957  
3663 529 50       1523 next unless $j->[0]{-alias};
3664 529 50       1338 next unless $j->[0]{-join_path};
3665 529 100 50     1841 next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth;
3666              
3667 517         863 my @jpath = map { keys %$_ } @{$j->[0]{-join_path}};
  756         2391  
  517         1281  
3668              
3669 517         1060 my $p = $join_map;
3670 517   100     3476 $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries
3671 517         987 push @{$p->{-join_aliases} }, $j->[0]{-alias};
  517         1914  
3672             }
3673             }
3674              
3675 352         3099 my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map );
3676              
3677             # save these for after distinct resolution
3678 352         935 @prefetch_select = map { $_->[0] } @prefetch;
  1848         3129  
3679 352         879 @prefetch_as = map { $_->[1] } @prefetch;
  1848         3635  
3680             }
3681              
3682             # run through the resulting joinstructure (starting from our current slot)
3683             # and unset collapse if proven unnecessary
3684             #
3685             # also while we are at it find out if the current root source has
3686             # been premultiplied by previous related_source chaining
3687             #
3688             # this allows to predict whether a root object with all other relation
3689             # data set to NULL is in fact unique
3690 9007 100       19438 if ($attrs->{collapse}) {
3691              
3692 388 50       1501 if (ref $attrs->{from} eq 'ARRAY') {
3693              
3694 388 100       728 if (@{$attrs->{from}} == 1) {
  388         1260  
3695             # no joins - no collapse
3696 63         139 $attrs->{collapse} = 0;
3697             }
3698             else {
3699             # find where our table-spec starts
3700 325         623 my @fromlist = @{$attrs->{from}};
  325         903  
3701 325         1071 while (@fromlist) {
3702 373         762 my $t = shift @fromlist;
3703              
3704 373         661 my $is_multi;
3705             # me vs join from-spec distinction - a ref means non-root
3706 373 100       1120 if (ref $t eq 'ARRAY') {
3707 48         107 $t = $t->[0];
3708 48   66     220 $is_multi ||= ! $t->{-is_single};
3709             }
3710 373 100 66     2207 last if ($t->{-alias} && $t->{-alias} eq $alias);
3711 48   100     265 $attrs->{_main_source_premultiplied} ||= $is_multi;
3712             }
3713              
3714             # no non-singles remaining, nor any premultiplication - nothing to collapse
3715 325 100 100     2832 if (
3716             ! $attrs->{_main_source_premultiplied}
3717             and
3718 404     404   1750 ! List::Util::first { ! $_->[0]{-is_single} } @fromlist
3719             ) {
3720 95         305 $attrs->{collapse} = 0;
3721             }
3722             }
3723             }
3724              
3725             else {
3726             # if we can not analyze the from - err on the side of safety
3727 0         0 $attrs->{_main_source_premultiplied} = 1;
3728             }
3729             }
3730              
3731             # generate the distinct induced group_by before injecting the prefetched select/as parts
3732 9007 100       20349 if (delete $attrs->{distinct}) {
3733 70 100       273 if ($attrs->{group_by}) {
3734 1         5 carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
3735             }
3736             else {
3737 69         168 $attrs->{_grouped_by_distinct} = 1;
3738             # distinct affects only the main selection part, not what prefetch may add below
3739 69         294 ($attrs->{group_by}, my $new_order) = $source->storage->_group_over_selection($attrs);
3740              
3741             # FIXME possibly ignore a rewritten order_by (may turn out to be an issue)
3742             # The thinking is: if we are collapsing the subquerying prefetch engine will
3743             # rip stuff apart for us anyway, and we do not want to have a potentially
3744             # function-converted external order_by
3745             # ( there is an explicit if ( collapse && _grouped_by_distinct ) check in DBIHacks )
3746 69 100       351 $attrs->{order_by} = $new_order unless $attrs->{collapse};
3747             }
3748             }
3749              
3750             # inject prefetch-bound selection (if any)
3751 9007         13275 push @{$attrs->{select}}, @prefetch_select;
  9007         19702  
3752 9007         13386 push @{$attrs->{as}}, @prefetch_as;
  9007         16695  
3753              
3754             $attrs->{_simple_passthrough_construction} = !(
3755             $attrs->{collapse}
3756             or
3757 9007   100     26231 grep { $_ =~ /\./ } @{$attrs->{as}}
3758             );
3759              
3760             # if both page and offset are specified, produce a combined offset
3761             # even though it doesn't make much sense, this is what pre 081xx has
3762             # been doing
3763 9007 100       23154 if (my $page = delete $attrs->{page}) {
3764             $attrs->{offset} =
3765             ($attrs->{rows} * ($page - 1))
3766             +
3767 15   100     104 ($attrs->{offset} || 0)
3768             ;
3769             }
3770              
3771 9007         63479 return $self->{_attrs} = $attrs;
3772             }
3773              
3774             sub _rollout_attr {
3775 2038     2038   3600 my ($self, $attr) = @_;
3776              
3777 2038 100       5042 if (ref $attr eq 'HASH') {
    100          
3778 734         2043 return $self->_rollout_hash($attr);
3779             } elsif (ref $attr eq 'ARRAY') {
3780 940         1901 return $self->_rollout_array($attr);
3781             } else {
3782 364         969 return [$attr];
3783             }
3784             }
3785              
3786             sub _rollout_array {
3787 1280     1280   1966 my ($self, $attr) = @_;
3788              
3789 1280         1521 my @rolled_array;
3790 1280         1535 foreach my $element (@{$attr}) {
  1280         2307  
3791 1362 100       2799 if (ref $element eq 'HASH') {
    100          
3792 474         641 push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
  474         846  
3793             } elsif (ref $element eq 'ARRAY') {
3794             # XXX - should probably recurse here
3795 340         412 push( @rolled_array, @{$self->_rollout_array($element)} );
  340         541  
3796             } else {
3797 548         1086 push( @rolled_array, $element );
3798             }
3799             }
3800 1280         2520 return \@rolled_array;
3801             }
3802              
3803             sub _rollout_hash {
3804 1208     1208   2167 my ($self, $attr) = @_;
3805              
3806 1208         1676 my @rolled_array;
3807 1208         1615 foreach my $key (keys %{$attr}) {
  1208         2903  
3808 242         768 push( @rolled_array, { $key => $attr->{$key} } );
3809             }
3810 1208         2990 return \@rolled_array;
3811             }
3812              
3813             sub _calculate_score {
3814 324     324   767 my ($self, $a, $b) = @_;
3815              
3816 324 100 100     1778 if (defined $a xor defined $b) {
    100          
3817 44         86 return 0;
3818             }
3819             elsif (not defined $a) {
3820 10         33 return 1;
3821             }
3822              
3823 270 100       693 if (ref $b eq 'HASH') {
3824 92         150 my ($b_key) = keys %{$b};
  92         247  
3825 92 100       249 $b_key = '' if ! defined $b_key;
3826 92 100       222 if (ref $a eq 'HASH') {
3827 35         68 my ($a_key) = keys %{$a};
  35         89  
3828 35 100       94 $a_key = '' if ! defined $a_key;
3829 35 100       94 if ($a_key eq $b_key) {
3830 25         93 return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
3831             } else {
3832 10         25 return 0;
3833             }
3834             } else {
3835 57 100       167 return ($a eq $b_key) ? 1 : 0;
3836             }
3837             } else {
3838 178 100       454 if (ref $a eq 'HASH') {
3839 30         53 my ($a_key) = keys %{$a};
  30         82  
3840 30 100       112 return ($b eq $a_key) ? 1 : 0;
3841             } else {
3842 148 100       526 return ($b eq $a) ? 1 : 0;
3843             }
3844             }
3845             }
3846              
3847             sub _merge_joinpref_attr {
3848 2832     2832   24431 my ($self, $orig, $import) = @_;
3849              
3850 2832 100       9102 return $import unless defined($orig);
3851 1042 100       2209 return $orig unless defined($import);
3852              
3853 1019         2860 $orig = $self->_rollout_attr($orig);
3854 1019         1950 $import = $self->_rollout_attr($import);
3855              
3856 1019         1541 my $seen_keys;
3857 1019         1540 foreach my $import_element ( @{$import} ) {
  1019         1982  
3858             # find best candidate from $orig to merge $b_element into
3859 865         2473 my $best_candidate = { position => undef, score => 0 }; my $position = 0;
  865         1488  
3860 865         1311 foreach my $orig_element ( @{$orig} ) {
  865         1822  
3861 299         896 my $score = $self->_calculate_score( $orig_element, $import_element );
3862 299 100       822 if ($score > $best_candidate->{score}) {
3863 90         173 $best_candidate->{position} = $position;
3864 90         160 $best_candidate->{score} = $score;
3865             }
3866 299         628 $position++;
3867             }
3868 865 100       2462 my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
  176         474  
3869 865 100       2058 $import_key = '' if not defined $import_key;
3870              
3871 865 100 100     2805 if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
3872 794         1162 push( @{$orig}, $import_element );
  794         1712  
3873             } else {
3874 71         175 my $orig_best = $orig->[$best_candidate->{position}];
3875             # merge orig_best and b_element together and replace original with merged
3876 71 100       265 if (ref $orig_best ne 'HASH') {
    100          
3877 46         119 $orig->[$best_candidate->{position}] = $import_element;
3878             } elsif (ref $import_element eq 'HASH') {
3879 15         31 my ($key) = keys %{$orig_best};
  15         43  
3880 15         67 $orig->[$best_candidate->{position}] = { $key => $self->_merge_joinpref_attr($orig_best->{$key}, $import_element->{$key}) };
3881             }
3882             }
3883 865         3015 $seen_keys->{$import_key} = 1; # don't merge the same key twice
3884             }
3885              
3886 1019 100       3382 return @$orig ? $orig : ();
3887             }
3888              
3889             {
3890             my $hm;
3891              
3892             sub _merge_attr {
3893 17279   66 17279   47238 $hm ||= do {
3894 188         2138 my $hm = Hash::Merge->new;
3895              
3896             $hm->specify_behavior({
3897             SCALAR => {
3898             SCALAR => sub {
3899 74     74   2350 my ($defl, $defr) = map { defined $_ } (@_[0,1]);
  148         451  
3900              
3901 74 50 25     468 if ($defl xor $defr) {
    0          
3902 74 50       474 return [ $defl ? $_[0] : $_[1] ];
3903             }
3904             elsif (! $defl) {
3905 0         0 return [];
3906             }
3907             elsif (__HM_DEDUP and $_[0] eq $_[1]) {
3908             return [ $_[0] ];
3909             }
3910             else {
3911 0         0 return [$_[0], $_[1]];
3912             }
3913             },
3914             ARRAY => sub {
3915 5933 50   5933   241096 return $_[1] if !defined $_[0];
3916 0         0 return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
3917 0         0 return [$_[0], @{$_[1]}]
  0         0  
3918             },
3919             HASH => sub {
3920 870 100 66 870   43138 return [] if !defined $_[0] and !keys %{$_[1]};
  870         4363  
3921 869 50       5104 return [ $_[1] ] if !defined $_[0];
3922 0 0       0 return [ $_[0] ] if !keys %{$_[1]};
  0         0  
3923 0         0 return [$_[0], $_[1]]
3924             },
3925             },
3926             ARRAY => {
3927             SCALAR => sub {
3928 10277 100   10277   551973 return $_[0] if !defined $_[1];
3929 1         2 return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
3930 1         2 return [@{$_[0]}, $_[1]]
  1         6  
3931             },
3932             ARRAY => sub {
3933 125 100   125   6269 my @ret = @{$_[0]} or return $_[1];
  125         837  
3934 120         279 return [ @ret, @{$_[1]} ] unless __HM_DEDUP;
  120         697  
3935 0         0 my %idx = map { $_ => 1 } @ret;
  0         0  
3936 0         0 push @ret, grep { ! defined $idx{$_} } (@{$_[1]});
  0         0  
  0         0  
3937 0         0 \@ret;
3938             },
3939             HASH => sub {
3940 0 0   0   0 return [ $_[1] ] if ! @{$_[0]};
  0         0  
3941 0 0       0 return $_[0] if !keys %{$_[1]};
  0         0  
3942 0         0 return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
3943 0         0 return [ @{$_[0]}, $_[1] ];
  0         0  
3944             },
3945             },
3946             HASH => {
3947             SCALAR => sub {
3948 0 0 0 0   0 return [] if !keys %{$_[0]} and !defined $_[1];
  0         0  
3949 0 0       0 return [ $_[0] ] if !defined $_[1];
3950 0 0       0 return [ $_[1] ] if !keys %{$_[0]};
  0         0  
3951 0         0 return [$_[0], $_[1]]
3952             },
3953             ARRAY => sub {
3954 0 0 0 0   0 return [] if !keys %{$_[0]} and !@{$_[1]};
  0         0  
  0         0  
3955 0 0       0 return [ $_[0] ] if !@{$_[1]};
  0         0  
3956 0 0       0 return $_[1] if !keys %{$_[0]};
  0         0  
3957 0         0 return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
3958 0         0 return [ $_[0], @{$_[1]} ];
  0         0  
3959             },
3960             HASH => sub {
3961 0 0 0 0   0 return [] if !keys %{$_[0]} and !keys %{$_[1]};
  0         0  
  0         0  
3962 0 0       0 return [ $_[0] ] if !keys %{$_[1]};
  0         0  
3963 0 0       0 return [ $_[1] ] if !keys %{$_[0]};
  0         0  
3964 0 0       0 return [ $_[0] ] if $_[0] eq $_[1];
3965 0         0 return [ $_[0], $_[1] ];
3966             },
3967             }
3968 188         35185 } => 'DBIC_RS_ATTR_MERGER');
3969 188         10013 $hm;
3970             };
3971              
3972 17279         57454 return $hm->merge ($_[1], $_[2]);
3973             }
3974             }
3975              
3976             sub STORABLE_freeze {
3977 146     146 0 4131 my ($self, $cloning) = @_;
3978 146         888 my $to_serialize = { %$self };
3979              
3980             # A cursor in progress can't be serialized (and would make little sense anyway)
3981             # the parser can be regenerated (and can't be serialized)
3982 146         319 delete @{$to_serialize}{qw/cursor _row_parser _result_inflator/};
  146         429  
3983              
3984             # nor is it sensical to store a not-yet-fired-count pager
3985 146 100 100     477 if ($to_serialize->{pager} and ref $to_serialize->{pager}{total_entries} eq 'CODE') {
3986 1         3 delete $to_serialize->{pager};
3987             }
3988              
3989 146         393 Storable::nfreeze($to_serialize);
3990             }
3991              
3992             # need this hook for symmetry
3993             sub STORABLE_thaw {
3994 146     146 0 1471 my ($self, $cloning, $serialized) = @_;
3995              
3996 146         249 %$self = %{ Storable::thaw($serialized) };
  146         359  
3997              
3998 146         3255 $self;
3999             }
4000              
4001              
4002             =head2 throw_exception
4003              
4004             See L<DBIx::Class::Schema/throw_exception> for details.
4005              
4006             =cut
4007              
4008             sub throw_exception {
4009 57     57 1 2255 my $self=shift;
4010              
4011 57 100 66     363 if (ref $self and my $rsrc = $self->result_source) {
4012 56         292 $rsrc->throw_exception(@_)
4013             }
4014             else {
4015 1         6 DBIx::Class::Exception->throw(@_);
4016             }
4017             }
4018              
4019             1;
4020              
4021             __END__
4022              
4023             # XXX: FIXME: Attributes docs need clearing up
4024              
4025             =head1 ATTRIBUTES
4026              
4027             Attributes are used to refine a ResultSet in various ways when
4028             searching for data. They can be passed to any method which takes an
4029             C<\%attrs> argument. See L</search>, L</search_rs>, L</find>,
4030             L</count>.
4031              
4032             Default attributes can be set on the result class using
4033             L<DBIx::Class::ResultSource/resultset_attributes>. (Please read
4034             the CAVEATS on that feature before using it!)
4035              
4036             These are in no particular order:
4037              
4038             =head2 order_by
4039              
4040             =over 4
4041              
4042             =item Value: ( $order_by | \@order_by | \%order_by )
4043              
4044             =back
4045              
4046             Which column(s) to order the results by.
4047              
4048             [The full list of suitable values is documented in
4049             L<SQL::Abstract/"ORDER BY CLAUSES">; the following is a summary of
4050             common options.]
4051              
4052             If a single column name, or an arrayref of names is supplied, the
4053             argument is passed through directly to SQL. The hashref syntax allows
4054             for connection-agnostic specification of ordering direction:
4055              
4056             For descending order:
4057              
4058             order_by => { -desc => [qw/col1 col2 col3/] }
4059              
4060             For explicit ascending order:
4061              
4062             order_by => { -asc => 'col' }
4063              
4064             The old scalarref syntax (i.e. order_by => \'year DESC') is still
4065             supported, although you are strongly encouraged to use the hashref
4066             syntax as outlined above.
4067              
4068             =head2 columns
4069              
4070             =over 4
4071              
4072             =item Value: \@columns | \%columns | $column
4073              
4074             =back
4075              
4076             Shortcut to request a particular set of columns to be retrieved. Each
4077             column spec may be a string (a table column name), or a hash (in which
4078             case the key is the C<as> value, and the value is used as the C<select>
4079             expression). Adds the L</current_source_alias> onto the start of any column without a C<.> in
4080             it and sets C<select> from that, then auto-populates C<as> from
4081             C<select> as normal. (You may also use the C<cols> attribute, as in
4082             earlier versions of DBIC, but this is deprecated)
4083              
4084             Essentially C<columns> does the same as L</select> and L</as>.
4085              
4086             columns => [ 'some_column', { dbic_slot => 'another_column' } ]
4087              
4088             is the same as
4089              
4090             select => [qw(some_column another_column)],
4091             as => [qw(some_column dbic_slot)]
4092              
4093             If you want to individually retrieve related columns (in essence perform
4094             manual L</prefetch>) you have to make sure to specify the correct inflation slot
4095             chain such that it matches existing relationships:
4096              
4097             my $rs = $schema->resultset('Artist')->search({}, {
4098             # required to tell DBIC to collapse has_many relationships
4099             collapse => 1,
4100             join => { cds => 'tracks' },
4101             '+columns' => {
4102             'cds.cdid' => 'cds.cdid',
4103             'cds.tracks.title' => 'tracks.title',
4104             },
4105             });
4106              
4107             Like elsewhere, literal SQL or literal values can be included by using a
4108             scalar reference or a literal bind value, and these values will be available
4109             in the result with C<get_column> (see also
4110             L<SQL::Abstract/Literal SQL and value type operators>):
4111              
4112             # equivalent SQL: SELECT 1, 'a string', IF(my_column,?,?) ...
4113             # bind values: $true_value, $false_value
4114             columns => [
4115             {
4116             foo => \1,
4117             bar => \q{'a string'},
4118             baz => \[ 'IF(my_column,?,?)', $true_value, $false_value ],
4119             }
4120             ]
4121              
4122             =head2 +columns
4123              
4124             B<NOTE:> You B<MUST> explicitly quote C<'+columns'> when using this attribute.
4125             Not doing so causes Perl to incorrectly interpret C<+columns> as a bareword
4126             with a unary plus operator before it, which is the same as simply C<columns>.
4127              
4128             =over 4
4129              
4130             =item Value: \@extra_columns
4131              
4132             =back
4133              
4134             Indicates additional columns to be selected from storage. Works the same as
4135             L</columns> but adds columns to the current selection. (You may also use the
4136             C<include_columns> attribute, as in earlier versions of DBIC, but this is
4137             deprecated)
4138              
4139             $schema->resultset('CD')->search(undef, {
4140             '+columns' => ['artist.name'],
4141             join => ['artist']
4142             });
4143              
4144             would return all CDs and include a 'name' column to the information
4145             passed to object inflation. Note that the 'artist' is the name of the
4146             column (or relationship) accessor, and 'name' is the name of the column
4147             accessor in the related table.
4148              
4149             =head2 select
4150              
4151             =over 4
4152              
4153             =item Value: \@select_columns
4154              
4155             =back
4156              
4157             Indicates which columns should be selected from the storage. You can use
4158             column names, or in the case of RDBMS back ends, function or stored procedure
4159             names:
4160              
4161             $rs = $schema->resultset('Employee')->search(undef, {
4162             select => [
4163             'name',
4164             { count => 'employeeid' },
4165             { max => { length => 'name' }, -as => 'longest_name' }
4166             ]
4167             });
4168              
4169             # Equivalent SQL
4170             SELECT name, COUNT( employeeid ), MAX( LENGTH( name ) ) AS longest_name FROM employee
4171              
4172             B<NOTE:> You will almost always need a corresponding L</as> attribute when you
4173             use L</select>, to instruct DBIx::Class how to store the result of the column.
4174              
4175             Also note that the L</as> attribute has B<nothing to do> with the SQL-side
4176             C<AS> identifier aliasing. You B<can> alias a function (so you can use it e.g.
4177             in an C<ORDER BY> clause), however this is done via the C<-as> B<select
4178             function attribute> supplied as shown in the example above.
4179              
4180             =head2 +select
4181              
4182             B<NOTE:> You B<MUST> explicitly quote C<'+select'> when using this attribute.
4183             Not doing so causes Perl to incorrectly interpret C<+select> as a bareword
4184             with a unary plus operator before it, which is the same as simply C<select>.
4185              
4186             =over 4
4187              
4188             =item Value: \@extra_select_columns
4189              
4190             =back
4191              
4192             Indicates additional columns to be selected from storage. Works the same as
4193             L</select> but adds columns to the current selection, instead of specifying
4194             a new explicit list.
4195              
4196             =head2 as
4197              
4198             =over 4
4199              
4200             =item Value: \@inflation_names
4201              
4202             =back
4203              
4204             Indicates DBIC-side names for object inflation. That is L</as> indicates the
4205             slot name in which the column value will be stored within the
4206             L<Row|DBIx::Class::Row> object. The value will then be accessible via this
4207             identifier by the C<get_column> method (or via the object accessor B<if one
4208             with the same name already exists>) as shown below.
4209              
4210             The L</as> attribute has B<nothing to do> with the SQL-side identifier
4211             aliasing C<AS>. See L</select> for details.
4212              
4213             $rs = $schema->resultset('Employee')->search(undef, {
4214             select => [
4215             'name',
4216             { count => 'employeeid' },
4217             { max => { length => 'name' }, -as => 'longest_name' }
4218             ],
4219             as => [qw/
4220             name
4221             employee_count
4222             max_name_length
4223             /],
4224             });
4225              
4226             If the object against which the search is performed already has an accessor
4227             matching a column name specified in C<as>, the value can be retrieved using
4228             the accessor as normal:
4229              
4230             my $name = $employee->name();
4231              
4232             If on the other hand an accessor does not exist in the object, you need to
4233             use C<get_column> instead:
4234              
4235             my $employee_count = $employee->get_column('employee_count');
4236              
4237             You can create your own accessors if required - see
4238             L<DBIx::Class::Manual::Cookbook> for details.
4239              
4240             =head2 +as
4241              
4242             B<NOTE:> You B<MUST> explicitly quote C<'+as'> when using this attribute.
4243             Not doing so causes Perl to incorrectly interpret C<+as> as a bareword
4244             with a unary plus operator before it, which is the same as simply C<as>.
4245              
4246             =over 4
4247              
4248             =item Value: \@extra_inflation_names
4249              
4250             =back
4251              
4252             Indicates additional inflation names for selectors added via L</+select>. See L</as>.
4253              
4254             =head2 join
4255              
4256             =over 4
4257              
4258             =item Value: ($rel_name | \@rel_names | \%rel_names)
4259              
4260             =back
4261              
4262             Contains a list of relationships that should be joined for this query. For
4263             example:
4264              
4265             # Get CDs by Nine Inch Nails
4266             my $rs = $schema->resultset('CD')->search(
4267             { 'artist.name' => 'Nine Inch Nails' },
4268             { join => 'artist' }
4269             );
4270              
4271             Can also contain a hash reference to refer to the other relation's relations.
4272             For example:
4273              
4274             package MyApp::Schema::Track;
4275             use base qw/DBIx::Class/;
4276             __PACKAGE__->table('track');
4277             __PACKAGE__->add_columns(qw/trackid cd position title/);
4278             __PACKAGE__->set_primary_key('trackid');
4279             __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
4280             1;
4281              
4282             # In your application
4283             my $rs = $schema->resultset('Artist')->search(
4284             { 'track.title' => 'Teardrop' },
4285             {
4286             join => { cd => 'track' },
4287             order_by => 'artist.name',
4288             }
4289             );
4290              
4291             You need to use the relationship (not the table) name in conditions,
4292             because they are aliased as such. The current table is aliased as "me", so
4293             you need to use me.column_name in order to avoid ambiguity. For example:
4294              
4295             # Get CDs from 1984 with a 'Foo' track
4296             my $rs = $schema->resultset('CD')->search(
4297             {
4298             'me.year' => 1984,
4299             'tracks.name' => 'Foo'
4300             },
4301             { join => 'tracks' }
4302             );
4303              
4304             If the same join is supplied twice, it will be aliased to <rel>_2 (and
4305             similarly for a third time). For e.g.
4306              
4307             my $rs = $schema->resultset('Artist')->search({
4308             'cds.title' => 'Down to Earth',
4309             'cds_2.title' => 'Popular',
4310             }, {
4311             join => [ qw/cds cds/ ],
4312             });
4313              
4314             will return a set of all artists that have both a cd with title 'Down
4315             to Earth' and a cd with title 'Popular'.
4316              
4317             If you want to fetch related objects from other tables as well, see L</prefetch>
4318             below.
4319              
4320             NOTE: An internal join-chain pruner will discard certain joins while
4321             constructing the actual SQL query, as long as the joins in question do not
4322             affect the retrieved result. This for example includes 1:1 left joins
4323             that are not part of the restriction specification (WHERE/HAVING) nor are
4324             a part of the query selection.
4325              
4326             For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
4327              
4328             =head2 collapse
4329              
4330             =over 4
4331              
4332             =item Value: (0 | 1)
4333              
4334             =back
4335              
4336             When set to a true value, indicates that any rows fetched from joined has_many
4337             relationships are to be aggregated into the corresponding "parent" object. For
4338             example, the resultset:
4339              
4340             my $rs = $schema->resultset('CD')->search({}, {
4341             '+columns' => [ qw/ tracks.title tracks.position / ],
4342             join => 'tracks',
4343             collapse => 1,
4344             });
4345              
4346             While executing the following query:
4347              
4348             SELECT me.*, tracks.title, tracks.position
4349             FROM cd me
4350             LEFT JOIN track tracks
4351             ON tracks.cdid = me.cdid
4352              
4353             Will return only as many objects as there are rows in the CD source, even
4354             though the result of the query may span many rows. Each of these CD objects
4355             will in turn have multiple "Track" objects hidden behind the has_many
4356             generated accessor C<tracks>. Without C<< collapse => 1 >>, the return values
4357             of this resultset would be as many CD objects as there are tracks (a "Cartesian
4358             product"), with each CD object containing exactly one of all fetched Track data.
4359              
4360             When a collapse is requested on a non-ordered resultset, an order by some
4361             unique part of the main source (the left-most table) is inserted automatically.
4362             This is done so that the resultset is allowed to be "lazy" - calling
4363             L<< $rs->next|/next >> will fetch only as many rows as it needs to build the next
4364             object with all of its related data.
4365              
4366             If an L</order_by> is already declared, and orders the resultset in a way that
4367             makes collapsing as described above impossible (e.g. C<< ORDER BY
4368             has_many_rel.column >> or C<ORDER BY RANDOM()>), DBIC will automatically
4369             switch to "eager" mode and slurp the entire resultset before constructing the
4370             first object returned by L</next>.
4371              
4372             Setting this attribute on a resultset that does not join any has_many
4373             relations is a no-op.
4374              
4375             For a more in-depth discussion, see L</PREFETCHING>.
4376              
4377             =head2 prefetch
4378              
4379             =over 4
4380              
4381             =item Value: ($rel_name | \@rel_names | \%rel_names)
4382              
4383             =back
4384              
4385             This attribute is a shorthand for specifying a L</join> spec, adding all
4386             columns from the joined related sources as L</+columns> and setting
4387             L</collapse> to a true value. It can be thought of as a rough B<superset>
4388             of the L</join> attribute.
4389              
4390             For example, the following two queries are equivalent:
4391              
4392             my $rs = $schema->resultset('Artist')->search({}, {
4393             prefetch => { cds => ['genre', 'tracks' ] },
4394             });
4395              
4396             and
4397              
4398             my $rs = $schema->resultset('Artist')->search({}, {
4399             join => { cds => ['genre', 'tracks' ] },
4400             collapse => 1,
4401             '+columns' => [
4402             (map
4403             { +{ "cds.$_" => "cds.$_" } }
4404             $schema->source('Artist')->related_source('cds')->columns
4405             ),
4406             (map
4407             { +{ "cds.genre.$_" => "genre.$_" } }
4408             $schema->source('Artist')->related_source('cds')->related_source('genre')->columns
4409             ),
4410             (map
4411             { +{ "cds.tracks.$_" => "tracks.$_" } }
4412             $schema->source('Artist')->related_source('cds')->related_source('tracks')->columns
4413             ),
4414             ],
4415             });
4416              
4417             Both producing the following SQL:
4418              
4419             SELECT me.artistid, me.name, me.rank, me.charfield,
4420             cds.cdid, cds.artist, cds.title, cds.year, cds.genreid, cds.single_track,
4421             genre.genreid, genre.name,
4422             tracks.trackid, tracks.cd, tracks.position, tracks.title, tracks.last_updated_on, tracks.last_updated_at
4423             FROM artist me
4424             LEFT JOIN cd cds
4425             ON cds.artist = me.artistid
4426             LEFT JOIN genre genre
4427             ON genre.genreid = cds.genreid
4428             LEFT JOIN track tracks
4429             ON tracks.cd = cds.cdid
4430             ORDER BY me.artistid
4431              
4432             While L</prefetch> implies a L</join>, it is ok to mix the two together, as
4433             the arguments are properly merged and generally do the right thing. For
4434             example, you may want to do the following:
4435              
4436             my $artists_and_cds_without_genre = $schema->resultset('Artist')->search(
4437             { 'genre.genreid' => undef },
4438             {
4439             join => { cds => 'genre' },
4440             prefetch => 'cds',
4441             }
4442             );
4443              
4444             Which generates the following SQL:
4445              
4446             SELECT me.artistid, me.name, me.rank, me.charfield,
4447             cds.cdid, cds.artist, cds.title, cds.year, cds.genreid, cds.single_track
4448             FROM artist me
4449             LEFT JOIN cd cds
4450             ON cds.artist = me.artistid
4451             LEFT JOIN genre genre
4452             ON genre.genreid = cds.genreid
4453             WHERE genre.genreid IS NULL
4454             ORDER BY me.artistid
4455              
4456             For a more in-depth discussion, see L</PREFETCHING>.
4457              
4458             =head2 alias
4459              
4460             =over 4
4461              
4462             =item Value: $source_alias
4463              
4464             =back
4465              
4466             Sets the source alias for the query. Normally, this defaults to C<me>, but
4467             nested search queries (sub-SELECTs) might need specific aliases set to
4468             reference inner queries. For example:
4469              
4470             my $q = $rs
4471             ->related_resultset('CDs')
4472             ->related_resultset('Tracks')
4473             ->search({
4474             'track.id' => { -ident => 'none_search.id' },
4475             })
4476             ->as_query;
4477              
4478             my $ids = $self->search({
4479             -not_exists => $q,
4480             }, {
4481             alias => 'none_search',
4482             group_by => 'none_search.id',
4483             })->get_column('id')->as_query;
4484              
4485             $self->search({ id => { -in => $ids } })
4486              
4487             This attribute is directly tied to L</current_source_alias>.
4488              
4489             =head2 page
4490              
4491             =over 4
4492              
4493             =item Value: $page
4494              
4495             =back
4496              
4497             Makes the resultset paged and specifies the page to retrieve. Effectively
4498             identical to creating a non-pages resultset and then calling ->page($page)
4499             on it.
4500              
4501             If L</rows> attribute is not specified it defaults to 10 rows per page.
4502              
4503             When you have a paged resultset, L</count> will only return the number
4504             of rows in the page. To get the total, use the L</pager> and call
4505             C<total_entries> on it.
4506              
4507             =head2 rows
4508              
4509             =over 4
4510              
4511             =item Value: $rows
4512              
4513             =back
4514              
4515             Specifies the maximum number of rows for direct retrieval or the number of
4516             rows per page if the page attribute or method is used.
4517              
4518             =head2 offset
4519              
4520             =over 4
4521              
4522             =item Value: $offset
4523              
4524             =back
4525              
4526             Specifies the (zero-based) row number for the first row to be returned, or the
4527             of the first row of the first page if paging is used.
4528              
4529             =head2 software_limit
4530              
4531             =over 4
4532              
4533             =item Value: (0 | 1)
4534              
4535             =back
4536              
4537             When combined with L</rows> and/or L</offset> the generated SQL will not
4538             include any limit dialect stanzas. Instead the entire result will be selected
4539             as if no limits were specified, and DBIC will perform the limit locally, by
4540             artificially advancing and finishing the resulting L</cursor>.
4541              
4542             This is the recommended way of performing resultset limiting when no sane RDBMS
4543             implementation is available (e.g.
4544             L<Sybase ASE|DBIx::Class::Storage::DBI::Sybase::ASE> using the
4545             L<Generic Sub Query|DBIx::Class::SQLMaker::LimitDialects/GenericSubQ> hack)
4546              
4547             =head2 group_by
4548              
4549             =over 4
4550              
4551             =item Value: \@columns
4552              
4553             =back
4554              
4555             A arrayref of columns to group by. Can include columns of joined tables.
4556              
4557             group_by => [qw/ column1 column2 ... /]
4558              
4559             =head2 having
4560              
4561             =over 4
4562              
4563             =item Value: $condition
4564              
4565             =back
4566              
4567             The HAVING operator specifies a B<secondary> condition applied to the set
4568             after the grouping calculations have been done. In other words it is a
4569             constraint just like L</where> (and accepting the same
4570             L<SQL::Abstract syntax|SQL::Abstract/WHERE CLAUSES>) applied to the data
4571             as it exists after GROUP BY has taken place. Specifying L</having> without
4572             L</group_by> is a logical mistake, and a fatal error on most RDBMS engines.
4573              
4574             E.g.
4575              
4576             having => { 'count_employee' => { '>=', 100 } }
4577              
4578             or with an in-place function in which case literal SQL is required:
4579              
4580             having => \[ 'count(employee) >= ?', 100 ]
4581              
4582             =head2 distinct
4583              
4584             =over 4
4585              
4586             =item Value: (0 | 1)
4587              
4588             =back
4589              
4590             Set to 1 to automatically generate a L</group_by> clause based on the selection
4591             (including intelligent handling of L</order_by> contents). Note that the group
4592             criteria calculation takes place over the B<final> selection. This includes
4593             any L</+columns>, L</+select> or L</order_by> additions in subsequent
4594             L</search> calls, and standalone columns selected via
4595             L<DBIx::Class::ResultSetColumn> (L</get_column>). A notable exception are the
4596             extra selections specified via L</prefetch> - such selections are explicitly
4597             excluded from group criteria calculations.
4598              
4599             If the final ResultSet also explicitly defines a L</group_by> attribute, this
4600             setting is ignored and an appropriate warning is issued.
4601              
4602             =head2 where
4603              
4604             =over 4
4605              
4606             Adds to the WHERE clause.
4607              
4608             # only return rows WHERE deleted IS NULL for all searches
4609             __PACKAGE__->resultset_attributes({ where => { deleted => undef } });
4610              
4611             Can be overridden by passing C<< { where => undef } >> as an attribute
4612             to a resultset.
4613              
4614             For more complicated where clauses see L<SQL::Abstract/WHERE CLAUSES>.
4615              
4616             =back
4617              
4618             =head2 cache
4619              
4620             Set to 1 to cache search results. This prevents extra SQL queries if you
4621             revisit rows in your ResultSet:
4622              
4623             my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
4624              
4625             while( my $artist = $resultset->next ) {
4626             ... do stuff ...
4627             }
4628              
4629             $rs->first; # without cache, this would issue a query
4630              
4631             By default, searches are not cached.
4632              
4633             For more examples of using these attributes, see
4634             L<DBIx::Class::Manual::Cookbook>.
4635              
4636             =head2 for
4637              
4638             =over 4
4639              
4640             =item Value: ( 'update' | 'shared' | \$scalar )
4641              
4642             =back
4643              
4644             Set to 'update' for a SELECT ... FOR UPDATE or 'shared' for a SELECT
4645             ... FOR SHARED. If \$scalar is passed, this is taken directly and embedded in the
4646             query.
4647              
4648             =head1 PREFETCHING
4649              
4650             DBIx::Class supports arbitrary related data prefetching from multiple related
4651             sources. Any combination of relationship types and column sets are supported.
4652             If L<collapsing|/collapse> is requested, there is an additional requirement of
4653             selecting enough data to make every individual object uniquely identifiable.
4654              
4655             Here are some more involved examples, based on the following relationship map:
4656              
4657             # Assuming:
4658             My::Schema::CD->belongs_to( artist => 'My::Schema::Artist' );
4659             My::Schema::CD->might_have( liner_note => 'My::Schema::LinerNotes' );
4660             My::Schema::CD->has_many( tracks => 'My::Schema::Track' );
4661              
4662             My::Schema::Artist->belongs_to( record_label => 'My::Schema::RecordLabel' );
4663              
4664             My::Schema::Track->has_many( guests => 'My::Schema::Guest' );
4665              
4666              
4667              
4668             my $rs = $schema->resultset('Tag')->search(
4669             undef,
4670             {
4671             prefetch => {
4672             cd => 'artist'
4673             }
4674             }
4675             );
4676              
4677             The initial search results in SQL like the following:
4678              
4679             SELECT tag.*, cd.*, artist.* FROM tag
4680             JOIN cd ON tag.cd = cd.cdid
4681             JOIN artist ON cd.artist = artist.artistid
4682              
4683             L<DBIx::Class> has no need to go back to the database when we access the
4684             C<cd> or C<artist> relationships, which saves us two SQL statements in this
4685             case.
4686              
4687             Simple prefetches will be joined automatically, so there is no need
4688             for a C<join> attribute in the above search.
4689              
4690             The L</prefetch> attribute can be used with any of the relationship types
4691             and multiple prefetches can be specified together. Below is a more complex
4692             example that prefetches a CD's artist, its liner notes (if present),
4693             the cover image, the tracks on that CD, and the guests on those
4694             tracks.
4695              
4696             my $rs = $schema->resultset('CD')->search(
4697             undef,
4698             {
4699             prefetch => [
4700             { artist => 'record_label'}, # belongs_to => belongs_to
4701             'liner_note', # might_have
4702             'cover_image', # has_one
4703             { tracks => 'guests' }, # has_many => has_many
4704             ]
4705             }
4706             );
4707              
4708             This will produce SQL like the following:
4709              
4710             SELECT cd.*, artist.*, record_label.*, liner_note.*, cover_image.*,
4711             tracks.*, guests.*
4712             FROM cd me
4713             JOIN artist artist
4714             ON artist.artistid = me.artistid
4715             JOIN record_label record_label
4716             ON record_label.labelid = artist.labelid
4717             LEFT JOIN track tracks
4718             ON tracks.cdid = me.cdid
4719             LEFT JOIN guest guests
4720             ON guests.trackid = track.trackid
4721             LEFT JOIN liner_notes liner_note
4722             ON liner_note.cdid = me.cdid
4723             JOIN cd_artwork cover_image
4724             ON cover_image.cdid = me.cdid
4725             ORDER BY tracks.cd
4726              
4727             Now the C<artist>, C<record_label>, C<liner_note>, C<cover_image>,
4728             C<tracks>, and C<guests> of the CD will all be available through the
4729             relationship accessors without the need for additional queries to the
4730             database.
4731              
4732             =head3 CAVEATS
4733              
4734             Prefetch does a lot of deep magic. As such, it may not behave exactly
4735             as you might expect.
4736              
4737             =over 4
4738              
4739             =item *
4740              
4741             Prefetch uses the L</cache> to populate the prefetched relationships. This
4742             may or may not be what you want.
4743              
4744             =item *
4745              
4746             If you specify a condition on a prefetched relationship, ONLY those
4747             rows that match the prefetched condition will be fetched into that relationship.
4748             This means that adding prefetch to a search() B<may alter> what is returned by
4749             traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
4750              
4751             my $artist_rs = $schema->resultset('Artist')->search({
4752             'cds.year' => 2008,
4753             }, {
4754             join => 'cds',
4755             });
4756              
4757             my $count = $artist_rs->first->cds->count;
4758              
4759             my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
4760              
4761             my $prefetch_count = $artist_rs_prefetch->first->cds->count;
4762              
4763             cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
4764              
4765             That cmp_ok() may or may not pass depending on the datasets involved. In other
4766             words the C<WHERE> condition would apply to the entire dataset, just like
4767             it would in regular SQL. If you want to add a condition only to the "right side"
4768             of a C<LEFT JOIN> - consider declaring and using a L<relationship with a custom
4769             condition|DBIx::Class::Relationship::Base/condition>
4770              
4771             =back
4772              
4773             =head1 DBIC BIND VALUES
4774              
4775             Because DBIC may need more information to bind values than just the column name
4776             and value itself, it uses a special format for both passing and receiving bind
4777             values. Each bind value should be composed of an arrayref of
4778             C<< [ \%args => $val ] >>. The format of C<< \%args >> is currently:
4779              
4780             =over 4
4781              
4782             =item dbd_attrs
4783              
4784             If present (in any form), this is what is being passed directly to bind_param.
4785             Note that different DBD's expect different bind args. (e.g. DBD::SQLite takes
4786             a single numerical type, while DBD::Pg takes a hashref if bind options.)
4787              
4788             If this is specified, all other bind options described below are ignored.
4789              
4790             =item sqlt_datatype
4791              
4792             If present, this is used to infer the actual bind attribute by passing to
4793             C<< $resolved_storage->bind_attribute_by_data_type() >>. Defaults to the
4794             "data_type" from the L<add_columns column info|DBIx::Class::ResultSource/add_columns>.
4795              
4796             Note that the data type is somewhat freeform (hence the sqlt_ prefix);
4797             currently drivers are expected to "Do the Right Thing" when given a common
4798             datatype name. (Not ideal, but that's what we got at this point.)
4799              
4800             =item sqlt_size
4801              
4802             Currently used to correctly allocate buffers for bind_param_inout().
4803             Defaults to "size" from the L<add_columns column info|DBIx::Class::ResultSource/add_columns>,
4804             or to a sensible value based on the "data_type".
4805              
4806             =item dbic_colname
4807              
4808             Used to fill in missing sqlt_datatype and sqlt_size attributes (if they are
4809             explicitly specified they are never overridden). Also used by some weird DBDs,
4810             where the column name should be available at bind_param time (e.g. Oracle).
4811              
4812             =back
4813              
4814             For backwards compatibility and convenience, the following shortcuts are
4815             supported:
4816              
4817             [ $name => $val ] === [ { dbic_colname => $name }, $val ]
4818             [ \$dt => $val ] === [ { sqlt_datatype => $dt }, $val ]
4819             [ undef, $val ] === [ {}, $val ]
4820             $val === [ {}, $val ]
4821              
4822             =head1 FURTHER QUESTIONS?
4823              
4824             Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
4825              
4826             =head1 COPYRIGHT AND LICENSE
4827              
4828             This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
4829             by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
4830             redistribute it and/or modify it under the same terms as the
4831             L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
4832              
4833             =cut