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