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