* change count with group_by (distinct) to use a subquery
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
1 package DBIx::Class::ResultSet;
2
3 use strict;
4 use warnings;
5 use overload
6         '0+'     => "count",
7         'bool'   => "_bool",
8         fallback => 1;
9 use Carp::Clan qw/^DBIx::Class/;
10 use Data::Page;
11 use Storable;
12 use DBIx::Class::ResultSetColumn;
13 use DBIx::Class::ResultSourceHandle;
14 use List::Util ();
15 use Scalar::Util ();
16 use base qw/DBIx::Class/;
17
18 __PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/);
19
20 =head1 NAME
21
22 DBIx::Class::ResultSet - Represents a query used for fetching a set of results.
23
24 =head1 SYNOPSIS
25
26   my $users_rs   = $schema->resultset('User');
27   my $registered_users_rs   = $schema->resultset('User')->search({ registered => 1 });
28   my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all();
29
30 =head1 DESCRIPTION
31
32 A ResultSet is an object which stores a set of conditions representing
33 a query. It is the backbone of DBIx::Class (i.e. the really
34 important/useful bit).
35
36 No SQL is executed on the database when a ResultSet is created, it
37 just stores all the conditions needed to create the query.
38
39 A basic ResultSet representing the data of an entire table is returned
40 by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
41 L<Source|DBIx::Class::Manual::Glossary/Source> name.
42
43   my $users_rs = $schema->resultset('User');
44
45 A new ResultSet is returned from calling L</search> on an existing
46 ResultSet. The new one will contain all the conditions of the
47 original, plus any new conditions added in the C<search> call.
48
49 A ResultSet is also an iterator. L</next> is used to return all the
50 L<DBIx::Class::Row>s the ResultSet represents.
51
52 The query that the ResultSet represents is B<only> executed against
53 the database when these methods are called:
54
55 =over
56
57 =item L</find>
58
59 =item L</next>
60
61 =item L</all>
62
63 =item L</count>
64
65 =item L</single>
66
67 =item L</first>
68
69 =back
70
71 =head1 EXAMPLES 
72
73 =head2 Chaining resultsets
74
75 Let's say you've got a query that needs to be run to return some data
76 to the user. But, you have an authorization system in place that
77 prevents certain users from seeing certain information. So, you want
78 to construct the basic query in one method, but add constraints to it in
79 another.
80
81   sub get_data {
82     my $self = shift;
83     my $request = $self->get_request; # Get a request object somehow.
84     my $schema = $self->get_schema;   # Get the DBIC schema object somehow.
85
86     my $cd_rs = $schema->resultset('CD')->search({
87       title => $request->param('title'),
88       year => $request->param('year'),
89     });
90
91     $self->apply_security_policy( $cd_rs );
92
93     return $cd_rs->all();
94   }
95
96   sub apply_security_policy {
97     my $self = shift;
98     my ($rs) = @_;
99
100     return $rs->search({
101       subversive => 0,
102     });
103   }
104
105 =head3 Resolving conditions and attributes
106
107 When a resultset is chained from another resultset, conditions and
108 attributes with the same keys need resolving.
109
110 L</join>, L</prefetch>, L</+select>, L</+as> attributes are merged
111 into the existing ones from the original resultset.
112
113 The L</where>, L</having> attribute, and any search conditions are
114 merged with an SQL C<AND> to the existing condition from the original
115 resultset.
116
117 All other attributes are overridden by any new ones supplied in the
118 search attributes.
119
120 =head2 Multiple queries
121
122 Since a resultset just defines a query, you can do all sorts of
123 things with it with the same object.
124
125   # Don't hit the DB yet.
126   my $cd_rs = $schema->resultset('CD')->search({
127     title => 'something',
128     year => 2009,
129   });
130
131   # Each of these hits the DB individually.
132   my $count = $cd_rs->count;
133   my $most_recent = $cd_rs->get_column('date_released')->max();
134   my @records = $cd_rs->all;
135
136 And it's not just limited to SELECT statements.
137
138   $cd_rs->delete();
139
140 This is even cooler:
141
142   $cd_rs->create({ artist => 'Fred' });
143
144 Which is the same as:
145
146   $schema->resultset('CD')->create({
147     title => 'something',
148     year => 2009,
149     artist => 'Fred'
150   });
151
152 See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
153
154 =head1 OVERLOADING
155
156 If a resultset is used in a numeric context it returns the L</count>.
157 However, if it is used in a booleand context it is always true.  So if
158 you want to check if a resultset has any results use C<if $rs != 0>.
159 C<if $rs> will always be true.
160
161 =head1 METHODS
162
163 =head2 new
164
165 =over 4
166
167 =item Arguments: $source, \%$attrs
168
169 =item Return Value: $rs
170
171 =back
172
173 The resultset constructor. Takes a source object (usually a
174 L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
175 L</ATTRIBUTES> below).  Does not perform any queries -- these are
176 executed as needed by the other methods.
177
178 Generally you won't need to construct a resultset manually.  You'll
179 automatically get one from e.g. a L</search> called in scalar context:
180
181   my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
182
183 IMPORTANT: If called on an object, proxies to new_result instead so
184
185   my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
186
187 will return a CD object, not a ResultSet.
188
189 =cut
190
191 sub new {
192   my $class = shift;
193   return $class->new_result(@_) if ref $class;
194
195   my ($source, $attrs) = @_;
196   $source = $source->handle 
197     unless $source->isa('DBIx::Class::ResultSourceHandle');
198   $attrs = { %{$attrs||{}} };
199
200   if ($attrs->{page}) {
201     $attrs->{rows} ||= 10;
202   }
203
204   $attrs->{alias} ||= 'me';
205
206   # Creation of {} and bless separated to mitigate RH perl bug
207   # see https://bugzilla.redhat.com/show_bug.cgi?id=196836
208   my $self = {
209     _source_handle => $source,
210     cond => $attrs->{where},
211     count => undef,
212     pager => undef,
213     attrs => $attrs
214   };
215
216   bless $self, $class;
217
218   $self->result_class(
219     $attrs->{result_class} || $source->resolve->result_class
220   );
221
222   return $self;
223 }
224
225 =head2 search
226
227 =over 4
228
229 =item Arguments: $cond, \%attrs?
230
231 =item Return Value: $resultset (scalar context), @row_objs (list context)
232
233 =back
234
235   my @cds    = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
236   my $new_rs = $cd_rs->search({ year => 2005 });
237
238   my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
239                  # year = 2005 OR year = 2004
240
241 If you need to pass in additional attributes but no additional condition,
242 call it as C<search(undef, \%attrs)>.
243
244   # "SELECT name, artistid FROM $artist_table"
245   my @all_artists = $schema->resultset('Artist')->search(undef, {
246     columns => [qw/name artistid/],
247   });
248
249 For a list of attributes that can be passed to C<search>, see
250 L</ATTRIBUTES>. For more examples of using this function, see
251 L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
252 documentation for the first argument, see L<SQL::Abstract>.
253
254 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
255
256 =cut
257
258 sub search {
259   my $self = shift;
260   my $rs = $self->search_rs( @_ );
261   return (wantarray ? $rs->all : $rs);
262 }
263
264 =head2 search_rs
265
266 =over 4
267
268 =item Arguments: $cond, \%attrs?
269
270 =item Return Value: $resultset
271
272 =back
273
274 This method does the same exact thing as search() except it will
275 always return a resultset, even in list context.
276
277 =cut
278
279 sub search_rs {
280   my $self = shift;
281
282   my $attrs = {};
283   $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
284   my $our_attrs = { %{$self->{attrs}} };
285   my $having = delete $our_attrs->{having};
286   my $where = delete $our_attrs->{where};
287
288   my $rows;
289
290   my %safe = (alias => 1, cache => 1);
291
292   unless (
293     (@_ && defined($_[0])) # @_ == () or (undef)
294     || 
295     (keys %$attrs # empty attrs or only 'safe' attrs
296     && List::Util::first { !$safe{$_} } keys %$attrs)
297   ) {
298     # no search, effectively just a clone
299     $rows = $self->get_cache;
300   }
301
302   my $new_attrs = { %{$our_attrs}, %{$attrs} };
303
304   # merge new attrs into inherited
305   foreach my $key (qw/join prefetch +select +as/) {
306     next unless exists $attrs->{$key};
307     $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
308   }
309
310   my $cond = (@_
311     ? (
312         (@_ == 1 || ref $_[0] eq "HASH")
313           ? (
314               (ref $_[0] eq 'HASH')
315                 ? (
316                     (keys %{ $_[0] }  > 0)
317                       ? shift
318                       : undef
319                    )
320                 :  shift
321              )
322           : (
323               (@_ % 2)
324                 ? $self->throw_exception("Odd number of arguments to search")
325                 : {@_}
326              )
327       )
328     : undef
329   );
330
331   if (defined $where) {
332     $new_attrs->{where} = (
333       defined $new_attrs->{where}
334         ? { '-and' => [
335               map {
336                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
337               } $where, $new_attrs->{where}
338             ]
339           }
340         : $where);
341   }
342
343   if (defined $cond) {
344     $new_attrs->{where} = (
345       defined $new_attrs->{where}
346         ? { '-and' => [
347               map {
348                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
349               } $cond, $new_attrs->{where}
350             ]
351           }
352         : $cond);
353   }
354
355   if (defined $having) {
356     $new_attrs->{having} = (
357       defined $new_attrs->{having}
358         ? { '-and' => [
359               map {
360                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
361               } $having, $new_attrs->{having}
362             ]
363           }
364         : $having);
365   }
366
367   my $rs = (ref $self)->new($self->result_source, $new_attrs);
368   if ($rows) {
369     $rs->set_cache($rows);
370   }
371   return $rs;
372 }
373
374 =head2 search_literal
375
376 =over 4
377
378 =item Arguments: $sql_fragment, @bind_values
379
380 =item Return Value: $resultset (scalar context), @row_objs (list context)
381
382 =back
383
384   my @cds   = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
385   my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
386
387 Pass a literal chunk of SQL to be added to the conditional part of the
388 resultset query.
389
390 CAVEAT: C<search_literal> is provided for Class::DBI compatibility and should
391 only be used in that context. There are known problems using C<search_literal>
392 in chained queries; it can result in bind values in the wrong order.  See
393 L<DBIx::Class::Manual::Cookbook/Searching> and
394 L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
395 require C<search_literal>.
396
397 =cut
398
399 sub search_literal {
400   my ($self, $cond, @vals) = @_;
401   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
402   $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ];
403   return $self->search(\$cond, $attrs);
404 }
405
406 =head2 find
407
408 =over 4
409
410 =item Arguments: @values | \%cols, \%attrs?
411
412 =item Return Value: $row_object | undef
413
414 =back
415
416 Finds a row based on its primary key or unique constraint. For example, to find
417 a row by its primary key:
418
419   my $cd = $schema->resultset('CD')->find(5);
420
421 You can also find a row by a specific unique constraint using the C<key>
422 attribute. For example:
423
424   my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', {
425     key => 'cd_artist_title'
426   });
427
428 Additionally, you can specify the columns explicitly by name:
429
430   my $cd = $schema->resultset('CD')->find(
431     {
432       artist => 'Massive Attack',
433       title  => 'Mezzanine',
434     },
435     { key => 'cd_artist_title' }
436   );
437
438 If the C<key> is specified as C<primary>, it searches only on the primary key.
439
440 If no C<key> is specified, it searches on all unique constraints defined on the
441 source for which column data is provided, including the primary key.
442
443 If your table does not have a primary key, you B<must> provide a value for the
444 C<key> attribute matching one of the unique constraints on the source.
445
446 In addition to C<key>, L</find> recognizes and applies standard
447 L<resultset attributes|/ATTRIBUTES> in the same way as L</search> does.
448
449 Note: If your query does not return only one row, a warning is generated:
450
451   Query returned more than one row
452
453 See also L</find_or_create> and L</update_or_create>. For information on how to
454 declare unique constraints, see
455 L<DBIx::Class::ResultSource/add_unique_constraint>.
456
457 =cut
458
459 sub find {
460   my $self = shift;
461   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
462
463   # Default to the primary key, but allow a specific key
464   my @cols = exists $attrs->{key}
465     ? $self->result_source->unique_constraint_columns($attrs->{key})
466     : $self->result_source->primary_columns;
467   $self->throw_exception(
468     "Can't find unless a primary key is defined or unique constraint is specified"
469   ) unless @cols;
470
471   # Parse out a hashref from input
472   my $input_query;
473   if (ref $_[0] eq 'HASH') {
474     $input_query = { %{$_[0]} };
475   }
476   elsif (@_ == @cols) {
477     $input_query = {};
478     @{$input_query}{@cols} = @_;
479   }
480   else {
481     # Compatibility: Allow e.g. find(id => $value)
482     carp "Find by key => value deprecated; please use a hashref instead";
483     $input_query = {@_};
484   }
485
486   my (%related, $info);
487
488   KEY: foreach my $key (keys %$input_query) {
489     if (ref($input_query->{$key})
490         && ($info = $self->result_source->relationship_info($key))) {
491       my $val = delete $input_query->{$key};
492       next KEY if (ref($val) eq 'ARRAY'); # has_many for multi_create
493       my $rel_q = $self->result_source->resolve_condition(
494                     $info->{cond}, $val, $key
495                   );
496       die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY';
497       @related{keys %$rel_q} = values %$rel_q;
498     }
499   }
500   if (my @keys = keys %related) {
501     @{$input_query}{@keys} = values %related;
502   }
503
504
505   # Build the final query: Default to the disjunction of the unique queries,
506   # but allow the input query in case the ResultSet defines the query or the
507   # user is abusing find
508   my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
509   my $query;
510   if (exists $attrs->{key}) {
511     my @unique_cols = $self->result_source->unique_constraint_columns($attrs->{key});
512     my $unique_query = $self->_build_unique_query($input_query, \@unique_cols);
513     $query = $self->_add_alias($unique_query, $alias);
514   }
515   else {
516     my @unique_queries = $self->_unique_queries($input_query, $attrs);
517     $query = @unique_queries
518       ? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
519       : $self->_add_alias($input_query, $alias);
520   }
521
522   # Run the query
523   if (keys %$attrs) {
524     my $rs = $self->search($query, $attrs);
525     if (keys %{$rs->_resolved_attrs->{collapse}}) {
526       my $row = $rs->next;
527       carp "Query returned more than one row" if $rs->next;
528       return $row;
529     }
530     else {
531       return $rs->single;
532     }
533   }
534   else {
535     if (keys %{$self->_resolved_attrs->{collapse}}) {
536       my $rs = $self->search($query);
537       my $row = $rs->next;
538       carp "Query returned more than one row" if $rs->next;
539       return $row;
540     }
541     else {
542       return $self->single($query);
543     }
544   }
545 }
546
547 # _add_alias
548 #
549 # Add the specified alias to the specified query hash. A copy is made so the
550 # original query is not modified.
551
552 sub _add_alias {
553   my ($self, $query, $alias) = @_;
554
555   my %aliased = %$query;
556   foreach my $col (grep { ! m/\./ } keys %aliased) {
557     $aliased{"$alias.$col"} = delete $aliased{$col};
558   }
559
560   return \%aliased;
561 }
562
563 # _unique_queries
564 #
565 # Build a list of queries which satisfy unique constraints.
566
567 sub _unique_queries {
568   my ($self, $query, $attrs) = @_;
569
570   my @constraint_names = exists $attrs->{key}
571     ? ($attrs->{key})
572     : $self->result_source->unique_constraint_names;
573
574   my $where = $self->_collapse_cond($self->{attrs}{where} || {});
575   my $num_where = scalar keys %$where;
576
577   my @unique_queries;
578   foreach my $name (@constraint_names) {
579     my @unique_cols = $self->result_source->unique_constraint_columns($name);
580     my $unique_query = $self->_build_unique_query($query, \@unique_cols);
581
582     my $num_cols = scalar @unique_cols;
583     my $num_query = scalar keys %$unique_query;
584
585     my $total = $num_query + $num_where;
586     if ($num_query && ($num_query == $num_cols || $total == $num_cols)) {
587       # The query is either unique on its own or is unique in combination with
588       # the existing where clause
589       push @unique_queries, $unique_query;
590     }
591   }
592
593   return @unique_queries;
594 }
595
596 # _build_unique_query
597 #
598 # Constrain the specified query hash based on the specified column names.
599
600 sub _build_unique_query {
601   my ($self, $query, $unique_cols) = @_;
602
603   return {
604     map  { $_ => $query->{$_} }
605     grep { exists $query->{$_} }
606       @$unique_cols
607   };
608 }
609
610 =head2 search_related
611
612 =over 4
613
614 =item Arguments: $rel, $cond, \%attrs?
615
616 =item Return Value: $new_resultset
617
618 =back
619
620   $new_rs = $cd_rs->search_related('artist', {
621     name => 'Emo-R-Us',
622   });
623
624 Searches the specified relationship, optionally specifying a condition and
625 attributes for matching records. See L</ATTRIBUTES> for more information.
626
627 =cut
628
629 sub search_related {
630   return shift->related_resultset(shift)->search(@_);
631 }
632
633 =head2 search_related_rs
634
635 This method works exactly the same as search_related, except that
636 it guarantees a restultset, even in list context.
637
638 =cut
639
640 sub search_related_rs {
641   return shift->related_resultset(shift)->search_rs(@_);
642 }
643
644 =head2 cursor
645
646 =over 4
647
648 =item Arguments: none
649
650 =item Return Value: $cursor
651
652 =back
653
654 Returns a storage-driven cursor to the given resultset. See
655 L<DBIx::Class::Cursor> for more information.
656
657 =cut
658
659 sub cursor {
660   my ($self) = @_;
661
662   my $attrs = { %{$self->_resolved_attrs} };
663   return $self->{cursor}
664     ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
665           $attrs->{where},$attrs);
666 }
667
668 =head2 single
669
670 =over 4
671
672 =item Arguments: $cond?
673
674 =item Return Value: $row_object?
675
676 =back
677
678   my $cd = $schema->resultset('CD')->single({ year => 2001 });
679
680 Inflates the first result without creating a cursor if the resultset has
681 any records in it; if not returns nothing. Used by L</find> as a lean version of
682 L</search>.
683
684 While this method can take an optional search condition (just like L</search>)
685 being a fast-code-path it does not recognize search attributes. If you need to
686 add extra joins or similar, call L</search> and then chain-call L</single> on the
687 L<DBIx::Class::ResultSet> returned.
688
689 =over
690
691 =item B<Note>
692
693 As of 0.08100, this method enforces the assumption that the preceeding
694 query returns only one row. If more than one row is returned, you will receive
695 a warning:
696
697   Query returned more than one row
698
699 In this case, you should be using L</first> or L</find> instead, or if you really
700 know what you are doing, use the L</rows> attribute to explicitly limit the size 
701 of the resultset.
702
703 =back
704
705 =cut
706
707 sub single {
708   my ($self, $where) = @_;
709   if(@_ > 2) {
710       $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()');
711   }
712
713   my $attrs = { %{$self->_resolved_attrs} };
714   if ($where) {
715     if (defined $attrs->{where}) {
716       $attrs->{where} = {
717         '-and' =>
718             [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
719                $where, delete $attrs->{where} ]
720       };
721     } else {
722       $attrs->{where} = $where;
723     }
724   }
725
726 #  XXX: Disabled since it doesn't infer uniqueness in all cases
727 #  unless ($self->_is_unique_query($attrs->{where})) {
728 #    carp "Query not guaranteed to return a single row"
729 #      . "; please declare your unique constraints or use search instead";
730 #  }
731
732   my @data = $self->result_source->storage->select_single(
733     $attrs->{from}, $attrs->{select},
734     $attrs->{where}, $attrs
735   );
736
737   return (@data ? ($self->_construct_object(@data))[0] : undef);
738 }
739
740 # _is_unique_query
741 #
742 # Try to determine if the specified query is guaranteed to be unique, based on
743 # the declared unique constraints.
744
745 sub _is_unique_query {
746   my ($self, $query) = @_;
747
748   my $collapsed = $self->_collapse_query($query);
749   my $alias = $self->{attrs}{alias};
750
751   foreach my $name ($self->result_source->unique_constraint_names) {
752     my @unique_cols = map {
753       "$alias.$_"
754     } $self->result_source->unique_constraint_columns($name);
755
756     # Count the values for each unique column
757     my %seen = map { $_ => 0 } @unique_cols;
758
759     foreach my $key (keys %$collapsed) {
760       my $aliased = $key =~ /\./ ? $key : "$alias.$key";
761       next unless exists $seen{$aliased};  # Additional constraints are okay
762       $seen{$aliased} = scalar keys %{ $collapsed->{$key} };
763     }
764
765     # If we get 0 or more than 1 value for a column, it's not necessarily unique
766     return 1 unless grep { $_ != 1 } values %seen;
767   }
768
769   return 0;
770 }
771
772 # _collapse_query
773 #
774 # Recursively collapse the query, accumulating values for each column.
775
776 sub _collapse_query {
777   my ($self, $query, $collapsed) = @_;
778
779   $collapsed ||= {};
780
781   if (ref $query eq 'ARRAY') {
782     foreach my $subquery (@$query) {
783       next unless ref $subquery;  # -or
784 #      warn "ARRAY: " . Dumper $subquery;
785       $collapsed = $self->_collapse_query($subquery, $collapsed);
786     }
787   }
788   elsif (ref $query eq 'HASH') {
789     if (keys %$query and (keys %$query)[0] eq '-and') {
790       foreach my $subquery (@{$query->{-and}}) {
791 #        warn "HASH: " . Dumper $subquery;
792         $collapsed = $self->_collapse_query($subquery, $collapsed);
793       }
794     }
795     else {
796 #      warn "LEAF: " . Dumper $query;
797       foreach my $col (keys %$query) {
798         my $value = $query->{$col};
799         $collapsed->{$col}{$value}++;
800       }
801     }
802   }
803
804   return $collapsed;
805 }
806
807 =head2 get_column
808
809 =over 4
810
811 =item Arguments: $cond?
812
813 =item Return Value: $resultsetcolumn
814
815 =back
816
817   my $max_length = $rs->get_column('length')->max;
818
819 Returns a L<DBIx::Class::ResultSetColumn> instance for a column of the ResultSet.
820
821 =cut
822
823 sub get_column {
824   my ($self, $column) = @_;
825   my $new = DBIx::Class::ResultSetColumn->new($self, $column);
826   return $new;
827 }
828
829 =head2 search_like
830
831 =over 4
832
833 =item Arguments: $cond, \%attrs?
834
835 =item Return Value: $resultset (scalar context), @row_objs (list context)
836
837 =back
838
839   # WHERE title LIKE '%blue%'
840   $cd_rs = $rs->search_like({ title => '%blue%'});
841
842 Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
843 that this is simply a convenience method retained for ex Class::DBI users.
844 You most likely want to use L</search> with specific operators.
845
846 For more information, see L<DBIx::Class::Manual::Cookbook>.
847
848 =cut
849
850 sub search_like {
851   my $class = shift;
852   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
853   my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
854   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
855   return $class->search($query, { %$attrs });
856 }
857
858 =head2 slice
859
860 =over 4
861
862 =item Arguments: $first, $last
863
864 =item Return Value: $resultset (scalar context), @row_objs (list context)
865
866 =back
867
868 Returns a resultset or object list representing a subset of elements from the
869 resultset slice is called on. Indexes are from 0, i.e., to get the first
870 three records, call:
871
872   my ($one, $two, $three) = $rs->slice(0, 2);
873
874 =cut
875
876 sub slice {
877   my ($self, $min, $max) = @_;
878   my $attrs = {}; # = { %{ $self->{attrs} || {} } };
879   $attrs->{offset} = $self->{attrs}{offset} || 0;
880   $attrs->{offset} += $min;
881   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
882   return $self->search(undef(), $attrs);
883   #my $slice = (ref $self)->new($self->result_source, $attrs);
884   #return (wantarray ? $slice->all : $slice);
885 }
886
887 =head2 next
888
889 =over 4
890
891 =item Arguments: none
892
893 =item Return Value: $result?
894
895 =back
896
897 Returns the next element in the resultset (C<undef> is there is none).
898
899 Can be used to efficiently iterate over records in the resultset:
900
901   my $rs = $schema->resultset('CD')->search;
902   while (my $cd = $rs->next) {
903     print $cd->title;
904   }
905
906 Note that you need to store the resultset object, and call C<next> on it.
907 Calling C<< resultset('Table')->next >> repeatedly will always return the
908 first record from the resultset.
909
910 =cut
911
912 sub next {
913   my ($self) = @_;
914   if (my $cache = $self->get_cache) {
915     $self->{all_cache_position} ||= 0;
916     return $cache->[$self->{all_cache_position}++];
917   }
918   if ($self->{attrs}{cache}) {
919     $self->{all_cache_position} = 1;
920     return ($self->all)[0];
921   }
922   if ($self->{stashed_objects}) {
923     my $obj = shift(@{$self->{stashed_objects}});
924     delete $self->{stashed_objects} unless @{$self->{stashed_objects}};
925     return $obj;
926   }
927   my @row = (
928     exists $self->{stashed_row}
929       ? @{delete $self->{stashed_row}}
930       : $self->cursor->next
931   );
932   return undef unless (@row);
933   my ($row, @more) = $self->_construct_object(@row);
934   $self->{stashed_objects} = \@more if @more;
935   return $row;
936 }
937
938 sub _construct_object {
939   my ($self, @row) = @_;
940   my $info = $self->_collapse_result($self->{_attrs}{as}, \@row);
941   my @new = $self->result_class->inflate_result($self->result_source, @$info);
942   @new = $self->{_attrs}{record_filter}->(@new)
943     if exists $self->{_attrs}{record_filter};
944   return @new;
945 }
946
947 sub _collapse_result {
948   my ($self, $as_proto, $row) = @_;
949
950   my @copy = @$row;
951
952   # 'foo'         => [ undef, 'foo' ]
953   # 'foo.bar'     => [ 'foo', 'bar' ]
954   # 'foo.bar.baz' => [ 'foo.bar', 'baz' ]
955
956   my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto;
957
958   my %collapse = %{$self->{_attrs}{collapse}||{}};
959
960   my @pri_index;
961
962   # if we're doing collapsing (has_many prefetch) we need to grab records
963   # until the PK changes, so fill @pri_index. if not, we leave it empty so
964   # we know we don't have to bother.
965
966   # the reason for not using the collapse stuff directly is because if you
967   # had for e.g. two artists in a row with no cds, the collapse info for
968   # both would be NULL (undef) so you'd lose the second artist
969
970   # store just the index so we can check the array positions from the row
971   # without having to contruct the full hash
972
973   if (keys %collapse) {
974     my %pri = map { ($_ => 1) } $self->result_source->primary_columns;
975     foreach my $i (0 .. $#construct_as) {
976       next if defined($construct_as[$i][0]); # only self table
977       if (delete $pri{$construct_as[$i][1]}) {
978         push(@pri_index, $i);
979       }
980       last unless keys %pri; # short circuit (Johnny Five Is Alive!)
981     }
982   }
983
984   # no need to do an if, it'll be empty if @pri_index is empty anyway
985
986   my %pri_vals = map { ($_ => $copy[$_]) } @pri_index;
987
988   my @const_rows;
989
990   do { # no need to check anything at the front, we always want the first row
991
992     my %const;
993   
994     foreach my $this_as (@construct_as) {
995       $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy);
996     }
997
998     push(@const_rows, \%const);
999
1000   } until ( # no pri_index => no collapse => drop straight out
1001       !@pri_index
1002     or
1003       do { # get another row, stash it, drop out if different PK
1004
1005         @copy = $self->cursor->next;
1006         $self->{stashed_row} = \@copy;
1007
1008         # last thing in do block, counts as true if anything doesn't match
1009
1010         # check xor defined first for NULL vs. NOT NULL then if one is
1011         # defined the other must be so check string equality
1012
1013         grep {
1014           (defined $pri_vals{$_} ^ defined $copy[$_])
1015           || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_]))
1016         } @pri_index;
1017       }
1018   );
1019
1020   my $alias = $self->{attrs}{alias};
1021   my $info = [];
1022
1023   my %collapse_pos;
1024
1025   my @const_keys;
1026
1027   foreach my $const (@const_rows) {
1028     scalar @const_keys or do {
1029       @const_keys = sort { length($a) <=> length($b) } keys %$const;
1030     };
1031     foreach my $key (@const_keys) {
1032       if (length $key) {
1033         my $target = $info;
1034         my @parts = split(/\./, $key);
1035         my $cur = '';
1036         my $data = $const->{$key};
1037         foreach my $p (@parts) {
1038           $target = $target->[1]->{$p} ||= [];
1039           $cur .= ".${p}";
1040           if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) { 
1041             # collapsing at this point and on final part
1042             my $pos = $collapse_pos{$cur};
1043             CK: foreach my $ck (@ckey) {
1044               if (!defined $pos->{$ck} || $pos->{$ck} ne $data->{$ck}) {
1045                 $collapse_pos{$cur} = $data;
1046                 delete @collapse_pos{ # clear all positioning for sub-entries
1047                   grep { m/^\Q${cur}.\E/ } keys %collapse_pos
1048                 };
1049                 push(@$target, []);
1050                 last CK;
1051               }
1052             }
1053           }
1054           if (exists $collapse{$cur}) {
1055             $target = $target->[-1];
1056           }
1057         }
1058         $target->[0] = $data;
1059       } else {
1060         $info->[0] = $const->{$key};
1061       }
1062     }
1063   }
1064
1065   return $info;
1066 }
1067
1068 =head2 result_source
1069
1070 =over 4
1071
1072 =item Arguments: $result_source?
1073
1074 =item Return Value: $result_source
1075
1076 =back
1077
1078 An accessor for the primary ResultSource object from which this ResultSet
1079 is derived.
1080
1081 =head2 result_class
1082
1083 =over 4
1084
1085 =item Arguments: $result_class?
1086
1087 =item Return Value: $result_class
1088
1089 =back
1090
1091 An accessor for the class to use when creating row objects. Defaults to 
1092 C<< result_source->result_class >> - which in most cases is the name of the 
1093 L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
1094
1095 =cut
1096
1097 sub result_class {
1098   my ($self, $result_class) = @_;
1099   if ($result_class) {
1100     $self->ensure_class_loaded($result_class);
1101     $self->_result_class($result_class);
1102   }
1103   $self->_result_class;
1104 }
1105
1106 =head2 count
1107
1108 =over 4
1109
1110 =item Arguments: $cond, \%attrs??
1111
1112 =item Return Value: $count
1113
1114 =back
1115
1116 Performs an SQL C<COUNT> with the same query as the resultset was built
1117 with to find the number of elements. If passed arguments, does a search
1118 on the resultset and counts the results of that.
1119
1120 Note: When using C<count> with C<group_by>, L<DBIx::Class> emulates C<GROUP BY>
1121 using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
1122 not support C<DISTINCT> with multiple columns. If you are using such a
1123 database, you should only use columns from the main table in your C<group_by>
1124 clause.
1125
1126 =cut
1127
1128 sub count {
1129   my $self = shift;
1130   return $self->search(@_)->count if @_ and defined $_[0];
1131   return scalar @{ $self->get_cache } if $self->get_cache;
1132   my $count = $self->_count;
1133   return 0 unless $count;
1134
1135   # need to take offset from resolved attrs
1136
1137   $count -= $self->{_attrs}{offset} if $self->{_attrs}{offset};
1138   $count = $self->{attrs}{rows} if
1139     $self->{attrs}{rows} and $self->{attrs}{rows} < $count;
1140   $count = 0 if ($count < 0);
1141   return $count;
1142 }
1143
1144 sub _count { # Separated out so pager can get the full count
1145   my $self = shift;
1146   my $attrs = { %{$self->_resolved_attrs} };
1147
1148   if (my $group_by = $attrs->{group_by}) {
1149     delete $attrs->{having};
1150     delete $attrs->{order_by};
1151     my @distinct = (ref $group_by ?  @$group_by : ($group_by));
1152     # todo: try CONCAT for multi-column pk
1153     my @pk = $self->result_source->primary_columns;
1154     if (@pk == 1) {
1155       my $alias = $attrs->{alias};
1156       foreach my $column (@distinct) {
1157         if ($column =~ qr/^(?:\Q${alias}.\E)?$pk[0]$/) {
1158           @distinct = ($column);
1159           last;
1160         }
1161       }
1162     }
1163
1164     $attrs->{select} = $group_by; 
1165     $attrs->{from} = [ { 'mesub' => (ref $self)->new($self->result_source, $attrs)->cursor->as_query } ];
1166   }
1167
1168   $attrs->{select} = { count => '*' };
1169   $attrs->{as} = [qw/count/];
1170
1171   # offset, order by, group by, where and page are not needed to count. record_filter is cdbi
1172   delete $attrs->{$_} for qw/rows offset order_by group_by where page pager record_filter/;
1173
1174   my $tmp_rs = (ref $self)->new($self->result_source, $attrs);
1175   my ($count) = $tmp_rs->cursor->next;
1176   return $count;
1177 }
1178
1179 sub _bool {
1180   return 1;
1181 }
1182
1183 =head2 count_literal
1184
1185 =over 4
1186
1187 =item Arguments: $sql_fragment, @bind_values
1188
1189 =item Return Value: $count
1190
1191 =back
1192
1193 Counts the results in a literal query. Equivalent to calling L</search_literal>
1194 with the passed arguments, then L</count>.
1195
1196 =cut
1197
1198 sub count_literal { shift->search_literal(@_)->count; }
1199
1200 =head2 all
1201
1202 =over 4
1203
1204 =item Arguments: none
1205
1206 =item Return Value: @objects
1207
1208 =back
1209
1210 Returns all elements in the resultset. Called implicitly if the resultset
1211 is returned in list context.
1212
1213 =cut
1214
1215 sub all {
1216   my $self = shift;
1217   if(@_) {
1218       $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
1219   }
1220
1221   return @{ $self->get_cache } if $self->get_cache;
1222
1223   my @obj;
1224
1225   # TODO: don't call resolve here
1226   if (keys %{$self->_resolved_attrs->{collapse}}) {
1227 #  if ($self->{attrs}{prefetch}) {
1228       # Using $self->cursor->all is really just an optimisation.
1229       # If we're collapsing has_many prefetches it probably makes
1230       # very little difference, and this is cleaner than hacking
1231       # _construct_object to survive the approach
1232     my @row = $self->cursor->next;
1233     while (@row) {
1234       push(@obj, $self->_construct_object(@row));
1235       @row = (exists $self->{stashed_row}
1236                ? @{delete $self->{stashed_row}}
1237                : $self->cursor->next);
1238     }
1239   } else {
1240     @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
1241   }
1242
1243   $self->set_cache(\@obj) if $self->{attrs}{cache};
1244   return @obj;
1245 }
1246
1247 =head2 reset
1248
1249 =over 4
1250
1251 =item Arguments: none
1252
1253 =item Return Value: $self
1254
1255 =back
1256
1257 Resets the resultset's cursor, so you can iterate through the elements again.
1258
1259 =cut
1260
1261 sub reset {
1262   my ($self) = @_;
1263   delete $self->{_attrs} if exists $self->{_attrs};
1264   $self->{all_cache_position} = 0;
1265   $self->cursor->reset;
1266   return $self;
1267 }
1268
1269 =head2 first
1270
1271 =over 4
1272
1273 =item Arguments: none
1274
1275 =item Return Value: $object?
1276
1277 =back
1278
1279 Resets the resultset and returns an object for the first result (if the
1280 resultset returns anything).
1281
1282 =cut
1283
1284 sub first {
1285   return $_[0]->reset->next;
1286 }
1287
1288 # _cond_for_update_delete
1289 #
1290 # update/delete require the condition to be modified to handle
1291 # the differing SQL syntax available.  This transforms the $self->{cond}
1292 # appropriately, returning the new condition.
1293
1294 sub _cond_for_update_delete {
1295   my ($self, $full_cond) = @_;
1296   my $cond = {};
1297
1298   $full_cond ||= $self->{cond};
1299   # No-op. No condition, we're updating/deleting everything
1300   return $cond unless ref $full_cond;
1301
1302   if (ref $full_cond eq 'ARRAY') {
1303     $cond = [
1304       map {
1305         my %hash;
1306         foreach my $key (keys %{$_}) {
1307           $key =~ /([^.]+)$/;
1308           $hash{$1} = $_->{$key};
1309         }
1310         \%hash;
1311       } @{$full_cond}
1312     ];
1313   }
1314   elsif (ref $full_cond eq 'HASH') {
1315     if ((keys %{$full_cond})[0] eq '-and') {
1316       $cond->{-and} = [];
1317
1318       my @cond = @{$full_cond->{-and}};
1319       for (my $i = 0; $i < @cond; $i++) {
1320         my $entry = $cond[$i];
1321
1322         my $hash;
1323         if (ref $entry eq 'HASH') {
1324           $hash = $self->_cond_for_update_delete($entry);
1325         }
1326         else {
1327           $entry =~ /([^.]+)$/;
1328           $hash->{$1} = $cond[++$i];
1329         }
1330
1331         push @{$cond->{-and}}, $hash;
1332       }
1333     }
1334     else {
1335       foreach my $key (keys %{$full_cond}) {
1336         $key =~ /([^.]+)$/;
1337         $cond->{$1} = $full_cond->{$key};
1338       }
1339     }
1340   }
1341   else {
1342     $self->throw_exception(
1343       "Can't update/delete on resultset with condition unless hash or array"
1344     );
1345   }
1346
1347   return $cond;
1348 }
1349
1350
1351 =head2 update
1352
1353 =over 4
1354
1355 =item Arguments: \%values
1356
1357 =item Return Value: $storage_rv
1358
1359 =back
1360
1361 Sets the specified columns in the resultset to the supplied values in a
1362 single query. Return value will be true if the update succeeded or false
1363 if no records were updated; exact type of success value is storage-dependent.
1364
1365 =cut
1366
1367 sub update {
1368   my ($self, $values) = @_;
1369   $self->throw_exception("Values for update must be a hash")
1370     unless ref $values eq 'HASH';
1371
1372   carp(   'WARNING! Currently $rs->update() does not generate proper SQL'
1373         . ' on joined resultsets, and may affect rows well outside of the'
1374         . ' contents of $rs. Use at your own risk' )
1375     if ( $self->{attrs}{seen_join} );
1376
1377   my $cond = $self->_cond_for_update_delete;
1378    
1379   return $self->result_source->storage->update(
1380     $self->result_source, $values, $cond
1381   );
1382 }
1383
1384 =head2 update_all
1385
1386 =over 4
1387
1388 =item Arguments: \%values
1389
1390 =item Return Value: 1
1391
1392 =back
1393
1394 Fetches all objects and updates them one at a time. Note that C<update_all>
1395 will run DBIC cascade triggers, while L</update> will not.
1396
1397 =cut
1398
1399 sub update_all {
1400   my ($self, $values) = @_;
1401   $self->throw_exception("Values for update must be a hash")
1402     unless ref $values eq 'HASH';
1403   foreach my $obj ($self->all) {
1404     $obj->set_columns($values)->update;
1405   }
1406   return 1;
1407 }
1408
1409 =head2 delete
1410
1411 =over 4
1412
1413 =item Arguments: none
1414
1415 =item Return Value: 1
1416
1417 =back
1418
1419 Deletes the contents of the resultset from its result source. Note that this
1420 will not run DBIC cascade triggers. See L</delete_all> if you need triggers
1421 to run. See also L<DBIx::Class::Row/delete>.
1422
1423 delete may not generate correct SQL for a query with joins or a resultset
1424 chained from a related resultset.  In this case it will generate a warning:-
1425
1426   WARNING! Currently $rs->delete() does not generate proper SQL on
1427   joined resultsets, and may delete rows well outside of the contents
1428   of $rs. Use at your own risk
1429
1430 In these cases you may find that delete_all is more appropriate, or you
1431 need to respecify your query in a way that can be expressed without a join.
1432
1433 =cut
1434
1435 sub delete {
1436   my ($self) = @_;
1437   $self->throw_exception("Delete should not be passed any arguments")
1438     if $_[1];
1439   carp(   'WARNING! Currently $rs->delete() does not generate proper SQL'
1440         . ' on joined resultsets, and may delete rows well outside of the'
1441         . ' contents of $rs. Use at your own risk' )
1442     if ( $self->{attrs}{seen_join} );
1443   my $cond = $self->_cond_for_update_delete;
1444
1445   $self->result_source->storage->delete($self->result_source, $cond);
1446   return 1;
1447 }
1448
1449 =head2 delete_all
1450
1451 =over 4
1452
1453 =item Arguments: none
1454
1455 =item Return Value: 1
1456
1457 =back
1458
1459 Fetches all objects and deletes them one at a time. Note that C<delete_all>
1460 will run DBIC cascade triggers, while L</delete> will not.
1461
1462 =cut
1463
1464 sub delete_all {
1465   my ($self) = @_;
1466   $_->delete for $self->all;
1467   return 1;
1468 }
1469
1470 =head2 populate
1471
1472 =over 4
1473
1474 =item Arguments: \@data;
1475
1476 =back
1477
1478 Accepts either an arrayref of hashrefs or alternatively an arrayref of arrayrefs.
1479 For the arrayref of hashrefs style each hashref should be a structure suitable
1480 forsubmitting to a $resultset->create(...) method.
1481
1482 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
1483 to insert the data, as this is a faster method.  
1484
1485 Otherwise, each set of data is inserted into the database using
1486 L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
1487 objects is returned.
1488
1489 Example:  Assuming an Artist Class that has many CDs Classes relating:
1490
1491   my $Artist_rs = $schema->resultset("Artist");
1492   
1493   ## Void Context Example 
1494   $Artist_rs->populate([
1495      { artistid => 4, name => 'Manufactured Crap', cds => [ 
1496         { title => 'My First CD', year => 2006 },
1497         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
1498       ],
1499      },
1500      { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
1501         { title => 'My parents sold me to a record company' ,year => 2005 },
1502         { title => 'Why Am I So Ugly?', year => 2006 },
1503         { title => 'I Got Surgery and am now Popular', year => 2007 }
1504       ],
1505      },
1506   ]);
1507   
1508   ## Array Context Example
1509   my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([
1510     { name => "Artist One"},
1511     { name => "Artist Two"},
1512     { name => "Artist Three", cds=> [
1513     { title => "First CD", year => 2007},
1514     { title => "Second CD", year => 2008},
1515   ]}
1516   ]);
1517   
1518   print $ArtistOne->name; ## response is 'Artist One'
1519   print $ArtistThree->cds->count ## reponse is '2'
1520
1521 For the arrayref of arrayrefs style,  the first element should be a list of the
1522 fieldsnames to which the remaining elements are rows being inserted.  For
1523 example:
1524
1525   $Arstist_rs->populate([
1526     [qw/artistid name/],
1527     [100, 'A Formally Unknown Singer'],
1528     [101, 'A singer that jumped the shark two albums ago'],
1529     [102, 'An actually cool singer.'],
1530   ]);
1531
1532 Please note an important effect on your data when choosing between void and
1533 wantarray context. Since void context goes straight to C<insert_bulk> in 
1534 L<DBIx::Class::Storage::DBI> this will skip any component that is overriding
1535 c<insert>.  So if you are using something like L<DBIx-Class-UUIDColumns> to 
1536 create primary keys for you, you will find that your PKs are empty.  In this 
1537 case you will have to use the wantarray context in order to create those 
1538 values.
1539
1540 =cut
1541
1542 sub populate {
1543   my $self = shift @_;
1544   my $data = ref $_[0][0] eq 'HASH'
1545     ? $_[0] : ref $_[0][0] eq 'ARRAY' ? $self->_normalize_populate_args($_[0]) :
1546     $self->throw_exception('Populate expects an arrayref of hashes or arrayref of arrayrefs');
1547   
1548   if(defined wantarray) {
1549     my @created;
1550     foreach my $item (@$data) {
1551       push(@created, $self->create($item));
1552     }
1553     return @created;
1554   } else {
1555     my ($first, @rest) = @$data;
1556
1557     my @names = grep {!ref $first->{$_}} keys %$first;
1558     my @rels = grep { $self->result_source->has_relationship($_) } keys %$first;
1559     my @pks = $self->result_source->primary_columns;  
1560
1561     ## do the belongs_to relationships  
1562     foreach my $index (0..$#$data) {
1563       if( grep { !defined $data->[$index]->{$_} } @pks ) {
1564         my @ret = $self->populate($data);
1565         return;
1566       }
1567     
1568       foreach my $rel (@rels) {
1569         next unless $data->[$index]->{$rel} && ref $data->[$index]->{$rel} eq "HASH";
1570         my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
1571         my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)};
1572         my $related = $result->result_source->resolve_condition(
1573           $result->result_source->relationship_info($reverse)->{cond},
1574           $self,        
1575           $result,        
1576         );
1577
1578         delete $data->[$index]->{$rel};
1579         $data->[$index] = {%{$data->[$index]}, %$related};
1580       
1581         push @names, keys %$related if $index == 0;
1582       }
1583     }
1584
1585     ## do bulk insert on current row
1586     my @values = map { [ @$_{@names} ] } @$data;
1587
1588     $self->result_source->storage->insert_bulk(
1589       $self->result_source, 
1590       \@names, 
1591       \@values,
1592     );
1593
1594     ## do the has_many relationships
1595     foreach my $item (@$data) {
1596
1597       foreach my $rel (@rels) {
1598         next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY";
1599
1600         my $parent = $self->find(map {{$_=>$item->{$_}} } @pks) 
1601      || $self->throw_exception('Cannot find the relating object.');
1602      
1603         my $child = $parent->$rel;
1604     
1605         my $related = $child->result_source->resolve_condition(
1606           $parent->result_source->relationship_info($rel)->{cond},
1607           $child,
1608           $parent,
1609         );
1610
1611         my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
1612         my @populate = map { {%$_, %$related} } @rows_to_add;
1613
1614         $child->populate( \@populate );
1615       }
1616     }
1617   }
1618 }
1619
1620 =head2 _normalize_populate_args ($args)
1621
1622 Private method used by L</populate> to normalize its incoming arguments.  Factored
1623 out in case you want to subclass and accept new argument structures to the
1624 L</populate> method.
1625
1626 =cut
1627
1628 sub _normalize_populate_args {
1629   my ($self, $data) = @_;
1630   my @names = @{shift(@$data)};
1631   my @results_to_create;
1632   foreach my $datum (@$data) {
1633     my %result_to_create;
1634     foreach my $index (0..$#names) {
1635       $result_to_create{$names[$index]} = $$datum[$index];
1636     }
1637     push @results_to_create, \%result_to_create;    
1638   }
1639   return \@results_to_create;
1640 }
1641
1642 =head2 pager
1643
1644 =over 4
1645
1646 =item Arguments: none
1647
1648 =item Return Value: $pager
1649
1650 =back
1651
1652 Return Value a L<Data::Page> object for the current resultset. Only makes
1653 sense for queries with a C<page> attribute.
1654
1655 To get the full count of entries for a paged resultset, call
1656 C<total_entries> on the L<Data::Page> object.
1657
1658 =cut
1659
1660 sub pager {
1661   my ($self) = @_;
1662   my $attrs = $self->{attrs};
1663   $self->throw_exception("Can't create pager for non-paged rs")
1664     unless $self->{attrs}{page};
1665   $attrs->{rows} ||= 10;
1666   return $self->{pager} ||= Data::Page->new(
1667     $self->_count, $attrs->{rows}, $self->{attrs}{page});
1668 }
1669
1670 =head2 page
1671
1672 =over 4
1673
1674 =item Arguments: $page_number
1675
1676 =item Return Value: $rs
1677
1678 =back
1679
1680 Returns a resultset for the $page_number page of the resultset on which page
1681 is called, where each page contains a number of rows equal to the 'rows'
1682 attribute set on the resultset (10 by default).
1683
1684 =cut
1685
1686 sub page {
1687   my ($self, $page) = @_;
1688   return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
1689 }
1690
1691 =head2 new_result
1692
1693 =over 4
1694
1695 =item Arguments: \%vals
1696
1697 =item Return Value: $rowobject
1698
1699 =back
1700
1701 Creates a new row object in the resultset's result class and returns
1702 it. The row is not inserted into the database at this point, call
1703 L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
1704 will tell you whether the row object has been inserted or not.
1705
1706 Passes the hashref of input on to L<DBIx::Class::Row/new>.
1707
1708 =cut
1709
1710 sub new_result {
1711   my ($self, $values) = @_;
1712   $self->throw_exception( "new_result needs a hash" )
1713     unless (ref $values eq 'HASH');
1714
1715   my %new;
1716   my $alias = $self->{attrs}{alias};
1717
1718   if (
1719     defined $self->{cond}
1720     && $self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION
1721   ) {
1722     %new = %{ $self->{attrs}{related_objects} || {} };  # nothing might have been inserted yet
1723     $new{-from_resultset} = [ keys %new ] if keys %new;
1724   } else {
1725     $self->throw_exception(
1726       "Can't abstract implicit construct, condition not a hash"
1727     ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
1728   
1729     my $collapsed_cond = (
1730       $self->{cond}
1731         ? $self->_collapse_cond($self->{cond})
1732         : {}
1733     );
1734   
1735     # precendence must be given to passed values over values inherited from
1736     # the cond, so the order here is important.
1737     my %implied =  %{$self->_remove_alias($collapsed_cond, $alias)};
1738     while( my($col,$value) = each %implied ){
1739       if(ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '='){
1740         $new{$col} = $value->{'='};
1741         next;
1742       }
1743       $new{$col} = $value if $self->_is_deterministic_value($value);
1744     }
1745   }
1746
1747   %new = (
1748     %new,
1749     %{ $self->_remove_alias($values, $alias) },
1750     -source_handle => $self->_source_handle,
1751     -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
1752   );
1753
1754   return $self->result_class->new(\%new);
1755 }
1756
1757 # _is_deterministic_value
1758 #
1759 # Make an effor to strip non-deterministic values from the condition, 
1760 # to make sure new_result chokes less
1761
1762 sub _is_deterministic_value {
1763   my $self = shift;
1764   my $value = shift;
1765   my $ref_type = ref $value;
1766   return 1 if $ref_type eq '' || $ref_type eq 'SCALAR';
1767   return 1 if Scalar::Util::blessed($value);
1768   return 0;
1769 }
1770
1771 # _collapse_cond
1772 #
1773 # Recursively collapse the condition.
1774
1775 sub _collapse_cond {
1776   my ($self, $cond, $collapsed) = @_;
1777
1778   $collapsed ||= {};
1779
1780   if (ref $cond eq 'ARRAY') {
1781     foreach my $subcond (@$cond) {
1782       next unless ref $subcond;  # -or
1783 #      warn "ARRAY: " . Dumper $subcond;
1784       $collapsed = $self->_collapse_cond($subcond, $collapsed);
1785     }
1786   }
1787   elsif (ref $cond eq 'HASH') {
1788     if (keys %$cond and (keys %$cond)[0] eq '-and') {
1789       foreach my $subcond (@{$cond->{-and}}) {
1790 #        warn "HASH: " . Dumper $subcond;
1791         $collapsed = $self->_collapse_cond($subcond, $collapsed);
1792       }
1793     }
1794     else {
1795 #      warn "LEAF: " . Dumper $cond;
1796       foreach my $col (keys %$cond) {
1797         my $value = $cond->{$col};
1798         $collapsed->{$col} = $value;
1799       }
1800     }
1801   }
1802
1803   return $collapsed;
1804 }
1805
1806 # _remove_alias
1807 #
1808 # Remove the specified alias from the specified query hash. A copy is made so
1809 # the original query is not modified.
1810
1811 sub _remove_alias {
1812   my ($self, $query, $alias) = @_;
1813
1814   my %orig = %{ $query || {} };
1815   my %unaliased;
1816
1817   foreach my $key (keys %orig) {
1818     if ($key !~ /\./) {
1819       $unaliased{$key} = $orig{$key};
1820       next;
1821     }
1822     $unaliased{$1} = $orig{$key}
1823       if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
1824   }
1825
1826   return \%unaliased;
1827 }
1828
1829 =head2 as_query (EXPERIMENTAL)
1830
1831 =over 4
1832
1833 =item Arguments: none
1834
1835 =item Return Value: \[ $sql, @bind ]
1836
1837 =back
1838
1839 Returns the SQL query and bind vars associated with the invocant.
1840
1841 This is generally used as the RHS for a subquery.
1842
1843 B<NOTE>: This feature is still experimental.
1844
1845 =cut
1846
1847 sub as_query { return shift->cursor->as_query(@_) }
1848
1849 =head2 find_or_new
1850
1851 =over 4
1852
1853 =item Arguments: \%vals, \%attrs?
1854
1855 =item Return Value: $rowobject
1856
1857 =back
1858
1859   my $artist = $schema->resultset('Artist')->find_or_new(
1860     { artist => 'fred' }, { key => 'artists' });
1861
1862   $cd->cd_to_producer->find_or_new({ producer => $producer },
1863                                    { key => 'primary });
1864
1865 Find an existing record from this resultset, based on its primary
1866 key, or a unique constraint. If none exists, instantiate a new result
1867 object and return it. The object will not be saved into your storage
1868 until you call L<DBIx::Class::Row/insert> on it.
1869
1870 You most likely want this method when looking for existing rows using
1871 a unique constraint that is not the primary key, or looking for
1872 related rows.
1873
1874 If you want objects to be saved immediately, use L</find_or_create> instead.
1875
1876 B<Note>: C<find_or_new> is probably not what you want when creating a
1877 new row in a table that uses primary keys supplied by the
1878 database. Passing in a primary key column with a value of I<undef>
1879 will cause L</find> to attempt to search for a row with a value of
1880 I<NULL>.
1881
1882 =cut
1883
1884 sub find_or_new {
1885   my $self     = shift;
1886   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1887   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
1888   my $exists   = $self->find($hash, $attrs);
1889   return defined $exists ? $exists : $self->new_result($hash);
1890 }
1891
1892 =head2 create
1893
1894 =over 4
1895
1896 =item Arguments: \%vals
1897
1898 =item Return Value: a L<DBIx::Class::Row> $object
1899
1900 =back
1901
1902 Attempt to create a single new row or a row with multiple related rows
1903 in the table represented by the resultset (and related tables). This
1904 will not check for duplicate rows before inserting, use
1905 L</find_or_create> to do that.
1906
1907 To create one row for this resultset, pass a hashref of key/value
1908 pairs representing the columns of the table and the values you wish to
1909 store. If the appropriate relationships are set up, foreign key fields
1910 can also be passed an object representing the foreign row, and the
1911 value will be set to its primary key.
1912
1913 To create related objects, pass a hashref for the value if the related
1914 item is a foreign key relationship (L<DBIx::Class::Relationship/belongs_to>),
1915 and use the name of the relationship as the key. (NOT the name of the field,
1916 necessarily). For C<has_many> and C<has_one> relationships, pass an arrayref
1917 of hashrefs containing the data for each of the rows to create in the foreign
1918 tables, again using the relationship name as the key.
1919
1920 Instead of hashrefs of plain related data (key/value pairs), you may
1921 also pass new or inserted objects. New objects (not inserted yet, see
1922 L</new>), will be inserted into their appropriate tables.
1923
1924 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
1925
1926 Example of creating a new row.
1927
1928   $person_rs->create({
1929     name=>"Some Person",
1930     email=>"somebody@someplace.com"
1931   });
1932   
1933 Example of creating a new row and also creating rows in a related C<has_many>
1934 or C<has_one> resultset.  Note Arrayref.
1935
1936   $artist_rs->create(
1937      { artistid => 4, name => 'Manufactured Crap', cds => [ 
1938         { title => 'My First CD', year => 2006 },
1939         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
1940       ],
1941      },
1942   );
1943
1944 Example of creating a new row and also creating a row in a related
1945 C<belongs_to>resultset. Note Hashref.
1946
1947   $cd_rs->create({
1948     title=>"Music for Silly Walks",
1949     year=>2000,
1950     artist => {
1951       name=>"Silly Musician",
1952     }
1953   });
1954
1955 =cut
1956
1957 sub create {
1958   my ($self, $attrs) = @_;
1959   $self->throw_exception( "create needs a hashref" )
1960     unless ref $attrs eq 'HASH';
1961   return $self->new_result($attrs)->insert;
1962 }
1963
1964 =head2 find_or_create
1965
1966 =over 4
1967
1968 =item Arguments: \%vals, \%attrs?
1969
1970 =item Return Value: $rowobject
1971
1972 =back
1973
1974   $cd->cd_to_producer->find_or_create({ producer => $producer },
1975                                       { key => 'primary });
1976
1977 Tries to find a record based on its primary key or unique constraints; if none
1978 is found, creates one and returns that instead.
1979
1980   my $cd = $schema->resultset('CD')->find_or_create({
1981     cdid   => 5,
1982     artist => 'Massive Attack',
1983     title  => 'Mezzanine',
1984     year   => 2005,
1985   });
1986
1987 Also takes an optional C<key> attribute, to search by a specific key or unique
1988 constraint. For example:
1989
1990   my $cd = $schema->resultset('CD')->find_or_create(
1991     {
1992       artist => 'Massive Attack',
1993       title  => 'Mezzanine',
1994     },
1995     { key => 'cd_artist_title' }
1996   );
1997
1998 B<Note>: Because find_or_create() reads from the database and then
1999 possibly inserts based on the result, this method is subject to a race
2000 condition. Another process could create a record in the table after
2001 the find has completed and before the create has started. To avoid
2002 this problem, use find_or_create() inside a transaction.
2003
2004 B<Note>: C<find_or_create> is probably not what you want when creating
2005 a new row in a table that uses primary keys supplied by the
2006 database. Passing in a primary key column with a value of I<undef>
2007 will cause L</find> to attempt to search for a row with a value of
2008 I<NULL>.
2009
2010 See also L</find> and L</update_or_create>. For information on how to declare
2011 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2012
2013 =cut
2014
2015 sub find_or_create {
2016   my $self     = shift;
2017   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2018   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2019   my $exists   = $self->find($hash, $attrs);
2020   return defined $exists ? $exists : $self->create($hash);
2021 }
2022
2023 =head2 update_or_create
2024
2025 =over 4
2026
2027 =item Arguments: \%col_values, { key => $unique_constraint }?
2028
2029 =item Return Value: $rowobject
2030
2031 =back
2032
2033   $resultset->update_or_create({ col => $val, ... });
2034
2035 First, searches for an existing row matching one of the unique constraints
2036 (including the primary key) on the source of this resultset. If a row is
2037 found, updates it with the other given column values. Otherwise, creates a new
2038 row.
2039
2040 Takes an optional C<key> attribute to search on a specific unique constraint.
2041 For example:
2042
2043   # In your application
2044   my $cd = $schema->resultset('CD')->update_or_create(
2045     {
2046       artist => 'Massive Attack',
2047       title  => 'Mezzanine',
2048       year   => 1998,
2049     },
2050     { key => 'cd_artist_title' }
2051   );
2052
2053   $cd->cd_to_producer->update_or_create({ 
2054     producer => $producer, 
2055     name => 'harry',
2056   }, { 
2057     key => 'primary,
2058   });
2059
2060
2061 If no C<key> is specified, it searches on all unique constraints defined on the
2062 source, including the primary key.
2063
2064 If the C<key> is specified as C<primary>, it searches only on the primary key.
2065
2066 See also L</find> and L</find_or_create>. For information on how to declare
2067 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2068
2069 B<Note>: C<update_or_create> is probably not what you want when
2070 looking for a row in a table that uses primary keys supplied by the
2071 database, unless you actually have a key value. Passing in a primary
2072 key column with a value of I<undef> will cause L</find> to attempt to
2073 search for a row with a value of I<NULL>.
2074
2075 =cut
2076
2077 sub update_or_create {
2078   my $self = shift;
2079   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2080   my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
2081
2082   my $row = $self->find($cond, $attrs);
2083   if (defined $row) {
2084     $row->update($cond);
2085     return $row;
2086   }
2087
2088   return $self->create($cond);
2089 }
2090
2091 =head2 get_cache
2092
2093 =over 4
2094
2095 =item Arguments: none
2096
2097 =item Return Value: \@cache_objects?
2098
2099 =back
2100
2101 Gets the contents of the cache for the resultset, if the cache is set.
2102
2103 The cache is populated either by using the L</prefetch> attribute to
2104 L</search> or by calling L</set_cache>.
2105
2106 =cut
2107
2108 sub get_cache {
2109   shift->{all_cache};
2110 }
2111
2112 =head2 set_cache
2113
2114 =over 4
2115
2116 =item Arguments: \@cache_objects
2117
2118 =item Return Value: \@cache_objects
2119
2120 =back
2121
2122 Sets the contents of the cache for the resultset. Expects an arrayref
2123 of objects of the same class as those produced by the resultset. Note that
2124 if the cache is set the resultset will return the cached objects rather
2125 than re-querying the database even if the cache attr is not set.
2126
2127 The contents of the cache can also be populated by using the
2128 L</prefetch> attribute to L</search>.
2129
2130 =cut
2131
2132 sub set_cache {
2133   my ( $self, $data ) = @_;
2134   $self->throw_exception("set_cache requires an arrayref")
2135       if defined($data) && (ref $data ne 'ARRAY');
2136   $self->{all_cache} = $data;
2137 }
2138
2139 =head2 clear_cache
2140
2141 =over 4
2142
2143 =item Arguments: none
2144
2145 =item Return Value: []
2146
2147 =back
2148
2149 Clears the cache for the resultset.
2150
2151 =cut
2152
2153 sub clear_cache {
2154   shift->set_cache(undef);
2155 }
2156
2157 =head2 related_resultset
2158
2159 =over 4
2160
2161 =item Arguments: $relationship_name
2162
2163 =item Return Value: $resultset
2164
2165 =back
2166
2167 Returns a related resultset for the supplied relationship name.
2168
2169   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
2170
2171 =cut
2172
2173 sub related_resultset {
2174   my ($self, $rel) = @_;
2175
2176   $self->{related_resultsets} ||= {};
2177   return $self->{related_resultsets}{$rel} ||= do {
2178     my $rel_obj = $self->result_source->relationship_info($rel);
2179
2180     $self->throw_exception(
2181       "search_related: result source '" . $self->result_source->source_name .
2182         "' has no such relationship $rel")
2183       unless $rel_obj;
2184     
2185     my ($from,$seen) = $self->_resolve_from($rel);
2186
2187     my $join_count = $seen->{$rel};
2188     my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
2189
2190     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
2191     my %attrs = %{$self->{attrs}||{}};
2192     delete @attrs{qw(result_class alias)};
2193
2194     my $new_cache;
2195
2196     if (my $cache = $self->get_cache) {
2197       if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) {
2198         $new_cache = [ map { @{$_->related_resultset($rel)->get_cache} }
2199                         @$cache ];
2200       }
2201     }
2202
2203     my $rel_source = $self->result_source->related_source($rel);
2204
2205     my $new = do {
2206
2207       # The reason we do this now instead of passing the alias to the
2208       # search_rs below is that if you wrap/overload resultset on the
2209       # source you need to know what alias it's -going- to have for things
2210       # to work sanely (e.g. RestrictWithObject wants to be able to add
2211       # extra query restrictions, and these may need to be $alias.)
2212
2213       my $attrs = $rel_source->resultset_attributes;
2214       local $attrs->{alias} = $alias;
2215
2216       $rel_source->resultset
2217                  ->search_rs(
2218                      undef, {
2219                        %attrs,
2220                        join => undef,
2221                        prefetch => undef,
2222                        select => undef,
2223                        as => undef,
2224                        where => $self->{cond},
2225                        seen_join => $seen,
2226                        from => $from,
2227                    });
2228     };
2229     $new->set_cache($new_cache) if $new_cache;
2230     $new;
2231   };
2232 }
2233
2234 =head2 current_source_alias
2235
2236 =over 4
2237
2238 =item Arguments: none
2239
2240 =item Return Value: $source_alias
2241
2242 =back
2243
2244 Returns the current table alias for the result source this resultset is built
2245 on, that will be used in the SQL query. Usually it is C<me>.
2246
2247 Currently the source alias that refers to the result set returned by a
2248 L</search>/L</find> family method depends on how you got to the resultset: it's
2249 C<me> by default, but eg. L</search_related> aliases it to the related result
2250 source name (and keeps C<me> referring to the original result set). The long
2251 term goal is to make L<DBIx::Class> always alias the current resultset as C<me>
2252 (and make this method unnecessary).
2253
2254 Thus it's currently necessary to use this method in predefined queries (see
2255 L<DBIx::Class::Manual::Cookbook/Predefined searches>) when referring to the
2256 source alias of the current result set:
2257
2258   # in a result set class
2259   sub modified_by {
2260     my ($self, $user) = @_;
2261
2262     my $me = $self->current_source_alias;
2263
2264     return $self->search(
2265       "$me.modified" => $user->id,
2266     );
2267   }
2268
2269 =cut
2270
2271 sub current_source_alias {
2272   my ($self) = @_;
2273
2274   return ($self->{attrs} || {})->{alias} || 'me';
2275 }
2276
2277 sub _resolve_from {
2278   my ($self, $extra_join) = @_;
2279   my $source = $self->result_source;
2280   my $attrs = $self->{attrs};
2281   
2282   my $from = $attrs->{from}
2283     || [ { $attrs->{alias} => $source->from } ];
2284     
2285   my $seen = { %{$attrs->{seen_join}||{}} };
2286
2287   my $join = ($attrs->{join}
2288                ? [ $attrs->{join}, $extra_join ]
2289                : $extra_join);
2290
2291   # we need to take the prefetch the attrs into account before we 
2292   # ->resolve_join as otherwise they get lost - captainL
2293   my $merged = $self->_merge_attr( $join, $attrs->{prefetch} );
2294
2295   $from = [
2296     @$from,
2297     ($join ? $source->resolve_join($merged, $attrs->{alias}, $seen) : ()),
2298   ];
2299
2300   return ($from,$seen);
2301 }
2302
2303 sub _resolved_attrs {
2304   my $self = shift;
2305   return $self->{_attrs} if $self->{_attrs};
2306
2307   my $attrs  = { %{ $self->{attrs} || {} } };
2308   my $source = $self->result_source;
2309   my $alias  = $attrs->{alias};
2310
2311   $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols};
2312   my @colbits;
2313
2314   # build columns (as long as select isn't set) into a set of as/select hashes
2315   unless ( $attrs->{select} ) {
2316       @colbits = map {
2317           ( ref($_) eq 'HASH' ) ? $_
2318             : {
2319               (
2320                   /^\Q${alias}.\E(.+)$/ ? $1
2321                   : $_
2322                 ) => ( /\./ ? $_ : "${alias}.$_" )
2323             }
2324       } ( ref($attrs->{columns}) eq 'ARRAY' ) ? @{ delete $attrs->{columns}} : (delete $attrs->{columns} || $source->columns );
2325   }
2326   # add the additional columns on
2327   foreach ( 'include_columns', '+columns' ) {
2328       push @colbits, map {
2329           ( ref($_) eq 'HASH' )
2330             ? $_
2331             : { ( split( /\./, $_ ) )[-1] => ( /\./ ? $_ : "${alias}.$_" ) }
2332       } ( ref($attrs->{$_}) eq 'ARRAY' ) ? @{ delete $attrs->{$_} } : delete $attrs->{$_} if ( $attrs->{$_} );
2333   }
2334
2335   # start with initial select items
2336   if ( $attrs->{select} ) {
2337     $attrs->{select} =
2338         ( ref $attrs->{select} eq 'ARRAY' )
2339       ? [ @{ $attrs->{select} } ]
2340       : [ $attrs->{select} ];
2341     $attrs->{as} = (
2342       $attrs->{as}
2343       ? (
2344         ref $attrs->{as} eq 'ARRAY'
2345         ? [ @{ $attrs->{as} } ]
2346         : [ $attrs->{as} ]
2347         )
2348       : [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{ $attrs->{select} } ]
2349     );
2350   }
2351   else {
2352
2353     # otherwise we intialise select & as to empty
2354     $attrs->{select} = [];
2355     $attrs->{as}     = [];
2356   }
2357
2358   # now add colbits to select/as
2359   push( @{ $attrs->{select} }, map { values( %{$_} ) } @colbits );
2360   push( @{ $attrs->{as} },     map { keys( %{$_} ) } @colbits );
2361
2362   my $adds;
2363   if ( $adds = delete $attrs->{'+select'} ) {
2364     $adds = [$adds] unless ref $adds eq 'ARRAY';
2365     push(
2366       @{ $attrs->{select} },
2367       map { /\./ || ref $_ ? $_ : "${alias}.$_" } @$adds
2368     );
2369   }
2370   if ( $adds = delete $attrs->{'+as'} ) {
2371     $adds = [$adds] unless ref $adds eq 'ARRAY';
2372     push( @{ $attrs->{as} }, @$adds );
2373   }
2374
2375   $attrs->{from} ||= [ { $self->{attrs}{alias} => $source->from } ];
2376
2377   if ( exists $attrs->{join} || exists $attrs->{prefetch} ) {
2378     my $join = delete $attrs->{join} || {};
2379
2380     if ( defined $attrs->{prefetch} ) {
2381       $join = $self->_merge_attr( $join, $attrs->{prefetch} );
2382
2383     }
2384
2385     $attrs->{from} =    # have to copy here to avoid corrupting the original
2386       [
2387       @{ $attrs->{from} },
2388       $source->resolve_join(
2389         $join, $alias, { %{ $attrs->{seen_join} || {} } }
2390       )
2391       ];
2392
2393   }
2394
2395   $attrs->{group_by} ||= $attrs->{select}
2396     if delete $attrs->{distinct};
2397   if ( $attrs->{order_by} ) {
2398     $attrs->{order_by} = (
2399       ref( $attrs->{order_by} ) eq 'ARRAY'
2400       ? [ @{ $attrs->{order_by} } ]
2401       : [ $attrs->{order_by} ]
2402     );
2403   }
2404   else {
2405     $attrs->{order_by} = [];
2406   }
2407
2408   my $collapse = $attrs->{collapse} || {};
2409   if ( my $prefetch = delete $attrs->{prefetch} ) {
2410     $prefetch = $self->_merge_attr( {}, $prefetch );
2411     my @pre_order;
2412     my $seen = { %{ $attrs->{seen_join} || {} } };
2413     foreach my $p ( ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch) ) {
2414
2415       # bring joins back to level of current class
2416       my @prefetch =
2417         $source->resolve_prefetch( $p, $alias, $seen, \@pre_order, $collapse );
2418       push( @{ $attrs->{select} }, map { $_->[0] } @prefetch );
2419       push( @{ $attrs->{as} },     map { $_->[1] } @prefetch );
2420     }
2421     push( @{ $attrs->{order_by} }, @pre_order );
2422   }
2423   $attrs->{collapse} = $collapse;
2424
2425   if ( $attrs->{page} ) {
2426     $attrs->{offset} ||= 0;
2427     $attrs->{offset} += ( $attrs->{rows} * ( $attrs->{page} - 1 ) );
2428   }
2429
2430   return $self->{_attrs} = $attrs;
2431 }
2432
2433 sub _rollout_attr {
2434   my ($self, $attr) = @_;
2435   
2436   if (ref $attr eq 'HASH') {
2437     return $self->_rollout_hash($attr);
2438   } elsif (ref $attr eq 'ARRAY') {
2439     return $self->_rollout_array($attr);
2440   } else {
2441     return [$attr];
2442   }
2443 }
2444
2445 sub _rollout_array {
2446   my ($self, $attr) = @_;
2447
2448   my @rolled_array;
2449   foreach my $element (@{$attr}) {
2450     if (ref $element eq 'HASH') {
2451       push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
2452     } elsif (ref $element eq 'ARRAY') {
2453       #  XXX - should probably recurse here
2454       push( @rolled_array, @{$self->_rollout_array($element)} );
2455     } else {
2456       push( @rolled_array, $element );
2457     }
2458   }
2459   return \@rolled_array;
2460 }
2461
2462 sub _rollout_hash {
2463   my ($self, $attr) = @_;
2464
2465   my @rolled_array;
2466   foreach my $key (keys %{$attr}) {
2467     push( @rolled_array, { $key => $attr->{$key} } );
2468   }
2469   return \@rolled_array;
2470 }
2471
2472 sub _calculate_score {
2473   my ($self, $a, $b) = @_;
2474
2475   if (ref $b eq 'HASH') {
2476     my ($b_key) = keys %{$b};
2477     if (ref $a eq 'HASH') {
2478       my ($a_key) = keys %{$a};
2479       if ($a_key eq $b_key) {
2480         return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
2481       } else {
2482         return 0;
2483       }
2484     } else {
2485       return ($a eq $b_key) ? 1 : 0;
2486     }       
2487   } else {
2488     if (ref $a eq 'HASH') {
2489       my ($a_key) = keys %{$a};
2490       return ($b eq $a_key) ? 1 : 0;
2491     } else {
2492       return ($b eq $a) ? 1 : 0;
2493     }
2494   }
2495 }
2496
2497 sub _merge_attr {
2498   my ($self, $orig, $import) = @_;
2499
2500   return $import unless defined($orig);
2501   return $orig unless defined($import);
2502   
2503   $orig = $self->_rollout_attr($orig);
2504   $import = $self->_rollout_attr($import);
2505
2506   my $seen_keys;
2507   foreach my $import_element ( @{$import} ) {
2508     # find best candidate from $orig to merge $b_element into
2509     my $best_candidate = { position => undef, score => 0 }; my $position = 0;
2510     foreach my $orig_element ( @{$orig} ) {
2511       my $score = $self->_calculate_score( $orig_element, $import_element );
2512       if ($score > $best_candidate->{score}) {
2513         $best_candidate->{position} = $position;
2514         $best_candidate->{score} = $score;
2515       }
2516       $position++;
2517     }
2518     my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
2519
2520     if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
2521       push( @{$orig}, $import_element );
2522     } else {
2523       my $orig_best = $orig->[$best_candidate->{position}];
2524       # merge orig_best and b_element together and replace original with merged
2525       if (ref $orig_best ne 'HASH') {
2526         $orig->[$best_candidate->{position}] = $import_element;
2527       } elsif (ref $import_element eq 'HASH') {
2528         my ($key) = keys %{$orig_best};
2529         $orig->[$best_candidate->{position}] = { $key => $self->_merge_attr($orig_best->{$key}, $import_element->{$key}) };
2530       }
2531     }
2532     $seen_keys->{$import_key} = 1; # don't merge the same key twice
2533   }
2534
2535   return $orig;
2536 }
2537
2538 sub result_source {
2539     my $self = shift;
2540
2541     if (@_) {
2542         $self->_source_handle($_[0]->handle);
2543     } else {
2544         $self->_source_handle->resolve;
2545     }
2546 }
2547
2548 =head2 throw_exception
2549
2550 See L<DBIx::Class::Schema/throw_exception> for details.
2551
2552 =cut
2553
2554 sub throw_exception {
2555   my $self=shift;
2556   if (ref $self && $self->_source_handle->schema) {
2557     $self->_source_handle->schema->throw_exception(@_)
2558   } else {
2559     croak(@_);
2560   }
2561
2562 }
2563
2564 # XXX: FIXME: Attributes docs need clearing up
2565
2566 =head1 ATTRIBUTES
2567
2568 Attributes are used to refine a ResultSet in various ways when
2569 searching for data. They can be passed to any method which takes an
2570 C<\%attrs> argument. See L</search>, L</search_rs>, L</find>,
2571 L</count>.
2572
2573 These are in no particular order:
2574
2575 =head2 order_by
2576
2577 =over 4
2578
2579 =item Value: ( $order_by | \@order_by | \%order_by )
2580
2581 =back
2582
2583 Which column(s) to order the results by. If a single column name, or
2584 an arrayref of names is supplied, the argument is passed through
2585 directly to SQL. The hashref syntax allows for connection-agnostic
2586 specification of ordering direction:
2587
2588  For descending order:
2589
2590   order_by => { -desc => [qw/col1 col2 col3/] }
2591
2592  For explicit ascending order:
2593
2594   order_by => { -asc => 'col' }
2595
2596 The old scalarref syntax (i.e. order_by => \'year DESC') is still
2597 supported, although you are strongly encouraged to use the hashref
2598 syntax as outlined above.
2599
2600 =head2 columns
2601
2602 =over 4
2603
2604 =item Value: \@columns
2605
2606 =back
2607
2608 Shortcut to request a particular set of columns to be retrieved. Each
2609 column spec may be a string (a table column name), or a hash (in which
2610 case the key is the C<as> value, and the value is used as the C<select>
2611 expression). Adds C<me.> onto the start of any column without a C<.> in
2612 it and sets C<select> from that, then auto-populates C<as> from
2613 C<select> as normal. (You may also use the C<cols> attribute, as in
2614 earlier versions of DBIC.)
2615
2616 =head2 +columns
2617
2618 =over 4
2619
2620 =item Value: \@columns
2621
2622 =back
2623
2624 Indicates additional columns to be selected from storage. Works the same
2625 as L</columns> but adds columns to the selection. (You may also use the
2626 C<include_columns> attribute, as in earlier versions of DBIC). For
2627 example:-
2628
2629   $schema->resultset('CD')->search(undef, {
2630     '+columns' => ['artist.name'],
2631     join => ['artist']
2632   });
2633
2634 would return all CDs and include a 'name' column to the information
2635 passed to object inflation. Note that the 'artist' is the name of the
2636 column (or relationship) accessor, and 'name' is the name of the column
2637 accessor in the related table.
2638
2639 =head2 include_columns
2640
2641 =over 4
2642
2643 =item Value: \@columns
2644
2645 =back
2646
2647 Deprecated.  Acts as a synonym for L</+columns> for backward compatibility.
2648
2649 =head2 select
2650
2651 =over 4
2652
2653 =item Value: \@select_columns
2654
2655 =back
2656
2657 Indicates which columns should be selected from the storage. You can use
2658 column names, or in the case of RDBMS back ends, function or stored procedure
2659 names:
2660
2661   $rs = $schema->resultset('Employee')->search(undef, {
2662     select => [
2663       'name',
2664       { count => 'employeeid' },
2665       { sum => 'salary' }
2666     ]
2667   });
2668
2669 When you use function/stored procedure names and do not supply an C<as>
2670 attribute, the column names returned are storage-dependent. E.g. MySQL would
2671 return a column named C<count(employeeid)> in the above example.
2672
2673 =head2 +select
2674
2675 =over 4
2676
2677 Indicates additional columns to be selected from storage.  Works the same as
2678 L</select> but adds columns to the selection.
2679
2680 =back
2681
2682 =head2 +as
2683
2684 =over 4
2685
2686 Indicates additional column names for those added via L</+select>. See L</as>.
2687
2688 =back
2689
2690 =head2 as
2691
2692 =over 4
2693
2694 =item Value: \@inflation_names
2695
2696 =back
2697
2698 Indicates column names for object inflation. That is, C<as>
2699 indicates the name that the column can be accessed as via the
2700 C<get_column> method (or via the object accessor, B<if one already
2701 exists>).  It has nothing to do with the SQL code C<SELECT foo AS bar>.
2702
2703 The C<as> attribute is used in conjunction with C<select>,
2704 usually when C<select> contains one or more function or stored
2705 procedure names:
2706
2707   $rs = $schema->resultset('Employee')->search(undef, {
2708     select => [
2709       'name',
2710       { count => 'employeeid' }
2711     ],
2712     as => ['name', 'employee_count'],
2713   });
2714
2715   my $employee = $rs->first(); # get the first Employee
2716
2717 If the object against which the search is performed already has an accessor
2718 matching a column name specified in C<as>, the value can be retrieved using
2719 the accessor as normal:
2720
2721   my $name = $employee->name();
2722
2723 If on the other hand an accessor does not exist in the object, you need to
2724 use C<get_column> instead:
2725
2726   my $employee_count = $employee->get_column('employee_count');
2727
2728 You can create your own accessors if required - see
2729 L<DBIx::Class::Manual::Cookbook> for details.
2730
2731 Please note: This will NOT insert an C<AS employee_count> into the SQL
2732 statement produced, it is used for internal access only. Thus
2733 attempting to use the accessor in an C<order_by> clause or similar
2734 will fail miserably.
2735
2736 To get around this limitation, you can supply literal SQL to your
2737 C<select> attibute that contains the C<AS alias> text, eg:
2738
2739   select => [\'myfield AS alias']
2740
2741 =head2 join
2742
2743 =over 4
2744
2745 =item Value: ($rel_name | \@rel_names | \%rel_names)
2746
2747 =back
2748
2749 Contains a list of relationships that should be joined for this query.  For
2750 example:
2751
2752   # Get CDs by Nine Inch Nails
2753   my $rs = $schema->resultset('CD')->search(
2754     { 'artist.name' => 'Nine Inch Nails' },
2755     { join => 'artist' }
2756   );
2757
2758 Can also contain a hash reference to refer to the other relation's relations.
2759 For example:
2760
2761   package MyApp::Schema::Track;
2762   use base qw/DBIx::Class/;
2763   __PACKAGE__->table('track');
2764   __PACKAGE__->add_columns(qw/trackid cd position title/);
2765   __PACKAGE__->set_primary_key('trackid');
2766   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
2767   1;
2768
2769   # In your application
2770   my $rs = $schema->resultset('Artist')->search(
2771     { 'track.title' => 'Teardrop' },
2772     {
2773       join     => { cd => 'track' },
2774       order_by => 'artist.name',
2775     }
2776   );
2777
2778 You need to use the relationship (not the table) name in  conditions, 
2779 because they are aliased as such. The current table is aliased as "me", so 
2780 you need to use me.column_name in order to avoid ambiguity. For example:
2781
2782   # Get CDs from 1984 with a 'Foo' track 
2783   my $rs = $schema->resultset('CD')->search(
2784     { 
2785       'me.year' => 1984,
2786       'tracks.name' => 'Foo'
2787     },
2788     { join => 'tracks' }
2789   );
2790   
2791 If the same join is supplied twice, it will be aliased to <rel>_2 (and
2792 similarly for a third time). For e.g.
2793
2794   my $rs = $schema->resultset('Artist')->search({
2795     'cds.title'   => 'Down to Earth',
2796     'cds_2.title' => 'Popular',
2797   }, {
2798     join => [ qw/cds cds/ ],
2799   });
2800
2801 will return a set of all artists that have both a cd with title 'Down
2802 to Earth' and a cd with title 'Popular'.
2803
2804 If you want to fetch related objects from other tables as well, see C<prefetch>
2805 below.
2806
2807 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
2808
2809 =head2 prefetch
2810
2811 =over 4
2812
2813 =item Value: ($rel_name | \@rel_names | \%rel_names)
2814
2815 =back
2816
2817 Contains one or more relationships that should be fetched along with
2818 the main query (when they are accessed afterwards the data will
2819 already be available, without extra queries to the database).  This is
2820 useful for when you know you will need the related objects, because it
2821 saves at least one query:
2822
2823   my $rs = $schema->resultset('Tag')->search(
2824     undef,
2825     {
2826       prefetch => {
2827         cd => 'artist'
2828       }
2829     }
2830   );
2831
2832 The initial search results in SQL like the following:
2833
2834   SELECT tag.*, cd.*, artist.* FROM tag
2835   JOIN cd ON tag.cd = cd.cdid
2836   JOIN artist ON cd.artist = artist.artistid
2837
2838 L<DBIx::Class> has no need to go back to the database when we access the
2839 C<cd> or C<artist> relationships, which saves us two SQL statements in this
2840 case.
2841
2842 Simple prefetches will be joined automatically, so there is no need
2843 for a C<join> attribute in the above search. 
2844
2845 C<prefetch> can be used with the following relationship types: C<belongs_to>,
2846 C<has_one> (or if you're using C<add_relationship>, any relationship declared
2847 with an accessor type of 'single' or 'filter'). A more complex example that
2848 prefetches an artists cds, the tracks on those cds, and the tags associted 
2849 with that artist is given below (assuming many-to-many from artists to tags):
2850
2851  my $rs = $schema->resultset('Artist')->search(
2852    undef,
2853    {
2854      prefetch => [
2855        { cds => 'tracks' },
2856        { artist_tags => 'tags' }
2857      ]
2858    }
2859  );
2860  
2861
2862 B<NOTE:> If you specify a C<prefetch> attribute, the C<join> and C<select>
2863 attributes will be ignored.
2864
2865 =head2 page
2866
2867 =over 4
2868
2869 =item Value: $page
2870
2871 =back
2872
2873 Makes the resultset paged and specifies the page to retrieve. Effectively
2874 identical to creating a non-pages resultset and then calling ->page($page)
2875 on it.
2876
2877 If L<rows> attribute is not specified it defualts to 10 rows per page.
2878
2879 When you have a paged resultset, L</count> will only return the number
2880 of rows in the page. To get the total, use the L</pager> and call
2881 C<total_entries> on it.
2882
2883 =head2 rows
2884
2885 =over 4
2886
2887 =item Value: $rows
2888
2889 =back
2890
2891 Specifes the maximum number of rows for direct retrieval or the number of
2892 rows per page if the page attribute or method is used.
2893
2894 =head2 offset
2895
2896 =over 4
2897
2898 =item Value: $offset
2899
2900 =back
2901
2902 Specifies the (zero-based) row number for the  first row to be returned, or the
2903 of the first row of the first page if paging is used.
2904
2905 =head2 group_by
2906
2907 =over 4
2908
2909 =item Value: \@columns
2910
2911 =back
2912
2913 A arrayref of columns to group by. Can include columns of joined tables.
2914
2915   group_by => [qw/ column1 column2 ... /]
2916
2917 =head2 having
2918
2919 =over 4
2920
2921 =item Value: $condition
2922
2923 =back
2924
2925 HAVING is a select statement attribute that is applied between GROUP BY and
2926 ORDER BY. It is applied to the after the grouping calculations have been
2927 done.
2928
2929   having => { 'count(employee)' => { '>=', 100 } }
2930
2931 =head2 distinct
2932
2933 =over 4
2934
2935 =item Value: (0 | 1)
2936
2937 =back
2938
2939 Set to 1 to group by all columns.
2940
2941 =head2 where
2942
2943 =over 4
2944
2945 Adds to the WHERE clause.
2946
2947   # only return rows WHERE deleted IS NULL for all searches
2948   __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
2949
2950 Can be overridden by passing C<{ where => undef }> as an attribute
2951 to a resulset.
2952
2953 =back
2954
2955 =head2 cache
2956
2957 Set to 1 to cache search results. This prevents extra SQL queries if you
2958 revisit rows in your ResultSet:
2959
2960   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
2961
2962   while( my $artist = $resultset->next ) {
2963     ... do stuff ...
2964   }
2965
2966   $rs->first; # without cache, this would issue a query
2967
2968 By default, searches are not cached.
2969
2970 For more examples of using these attributes, see
2971 L<DBIx::Class::Manual::Cookbook>.
2972
2973 =head2 from
2974
2975 =over 4
2976
2977 =item Value: \@from_clause
2978
2979 =back
2980
2981 The C<from> attribute gives you manual control over the C<FROM> clause of SQL
2982 statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
2983 clauses.
2984
2985 NOTE: Use this on your own risk.  This allows you to shoot off your foot!
2986
2987 C<join> will usually do what you need and it is strongly recommended that you
2988 avoid using C<from> unless you cannot achieve the desired result using C<join>.
2989 And we really do mean "cannot", not just tried and failed. Attempting to use
2990 this because you're having problems with C<join> is like trying to use x86
2991 ASM because you've got a syntax error in your C. Trust us on this.
2992
2993 Now, if you're still really, really sure you need to use this (and if you're
2994 not 100% sure, ask the mailing list first), here's an explanation of how this
2995 works.
2996
2997 The syntax is as follows -
2998
2999   [
3000     { <alias1> => <table1> },
3001     [
3002       { <alias2> => <table2>, -join_type => 'inner|left|right' },
3003       [], # nested JOIN (optional)
3004       { <table1.column1> => <table2.column2>, ... (more conditions) },
3005     ],
3006     # More of the above [ ] may follow for additional joins
3007   ]
3008
3009   <table1> <alias1>
3010   JOIN
3011     <table2> <alias2>
3012     [JOIN ...]
3013   ON <table1.column1> = <table2.column2>
3014   <more joins may follow>
3015
3016 An easy way to follow the examples below is to remember the following:
3017
3018     Anything inside "[]" is a JOIN
3019     Anything inside "{}" is a condition for the enclosing JOIN
3020
3021 The following examples utilize a "person" table in a family tree application.
3022 In order to express parent->child relationships, this table is self-joined:
3023
3024     # Person->belongs_to('father' => 'Person');
3025     # Person->belongs_to('mother' => 'Person');
3026
3027 C<from> can be used to nest joins. Here we return all children with a father,
3028 then search against all mothers of those children:
3029
3030   $rs = $schema->resultset('Person')->search(
3031       undef,
3032       {
3033           alias => 'mother', # alias columns in accordance with "from"
3034           from => [
3035               { mother => 'person' },
3036               [
3037                   [
3038                       { child => 'person' },
3039                       [
3040                           { father => 'person' },
3041                           { 'father.person_id' => 'child.father_id' }
3042                       ]
3043                   ],
3044                   { 'mother.person_id' => 'child.mother_id' }
3045               ],
3046           ]
3047       },
3048   );
3049
3050   # Equivalent SQL:
3051   # SELECT mother.* FROM person mother
3052   # JOIN (
3053   #   person child
3054   #   JOIN person father
3055   #   ON ( father.person_id = child.father_id )
3056   # )
3057   # ON ( mother.person_id = child.mother_id )
3058
3059 The type of any join can be controlled manually. To search against only people
3060 with a father in the person table, we could explicitly use C<INNER JOIN>:
3061
3062     $rs = $schema->resultset('Person')->search(
3063         undef,
3064         {
3065             alias => 'child', # alias columns in accordance with "from"
3066             from => [
3067                 { child => 'person' },
3068                 [
3069                     { father => 'person', -join_type => 'inner' },
3070                     { 'father.id' => 'child.father_id' }
3071                 ],
3072             ]
3073         },
3074     );
3075
3076     # Equivalent SQL:
3077     # SELECT child.* FROM person child
3078     # INNER JOIN person father ON child.father_id = father.id
3079
3080 If you need to express really complex joins or you need a subselect, you
3081 can supply literal SQL to C<from> via a scalar reference. In this case
3082 the contents of the scalar will replace the table name asscoiated with the
3083 resultsource.
3084
3085 WARNING: This technique might very well not work as expected on chained
3086 searches - you have been warned.
3087
3088     # Assuming the Event resultsource is defined as:
3089
3090         MySchema::Event->add_columns (
3091             sequence => {
3092                 data_type => 'INT',
3093                 is_auto_increment => 1,
3094             },
3095             location => {
3096                 data_type => 'INT',
3097             },
3098             type => {
3099                 data_type => 'INT',
3100             },
3101         );
3102         MySchema::Event->set_primary_key ('sequence');
3103
3104     # This will get back the latest event for every location. The column
3105     # selector is still provided by DBIC, all we do is add a JOIN/WHERE
3106     # combo to limit the resultset
3107
3108     $rs = $schema->resultset('Event');
3109     $table = $rs->result_source->name;
3110     $latest = $rs->search (
3111         undef,
3112         { from => \ " 
3113             (SELECT e1.* FROM $table e1 
3114                 JOIN $table e2 
3115                     ON e1.location = e2.location 
3116                     AND e1.sequence < e2.sequence 
3117                 WHERE e2.sequence is NULL 
3118             ) me",
3119         },
3120     );
3121
3122     # Equivalent SQL (with the DBIC chunks added):
3123
3124     SELECT me.sequence, me.location, me.type FROM
3125        (SELECT e1.* FROM events e1
3126            JOIN events e2
3127                ON e1.location = e2.location
3128                AND e1.sequence < e2.sequence
3129            WHERE e2.sequence is NULL
3130        ) me;
3131
3132 =head2 for
3133
3134 =over 4
3135
3136 =item Value: ( 'update' | 'shared' )
3137
3138 =back
3139
3140 Set to 'update' for a SELECT ... FOR UPDATE or 'shared' for a SELECT
3141 ... FOR SHARED.
3142
3143 =cut
3144
3145 1;