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