0289c0ffc5a33cbb15283a6323474bdb8957d4c2
[dbsrgits/DBIx-Class-Historic.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'   => sub { 1; },
8         fallback => 1;
9 use Data::Page;
10 use Storable;
11 use Scalar::Util qw/weaken/;
12
13 use DBIx::Class::ResultSetColumn;
14 use base qw/DBIx::Class/;
15 __PACKAGE__->load_components(qw/AccessorGroup/);
16 __PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
17
18 =head1 NAME
19
20 DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
21
22 =head1 SYNOPSIS
23
24   my $rs   = $schema->resultset('User')->search(registered => 1);
25   my @rows = $schema->resultset('CD')->search(year => 2005);
26
27 =head1 DESCRIPTION
28
29 The resultset is also known as an iterator. It is responsible for handling
30 queries that may return an arbitrary number of rows, e.g. via L</search>
31 or a C<has_many> relationship.
32
33 In the examples below, the following table classes are used:
34
35   package MyApp::Schema::Artist;
36   use base qw/DBIx::Class/;
37   __PACKAGE__->load_components(qw/Core/);
38   __PACKAGE__->table('artist');
39   __PACKAGE__->add_columns(qw/artistid name/);
40   __PACKAGE__->set_primary_key('artistid');
41   __PACKAGE__->has_many(cds => 'MyApp::Schema::CD');
42   1;
43
44   package MyApp::Schema::CD;
45   use base qw/DBIx::Class/;
46   __PACKAGE__->load_components(qw/Core/);
47   __PACKAGE__->table('cd');
48   __PACKAGE__->add_columns(qw/cdid artist title year/);
49   __PACKAGE__->set_primary_key('cdid');
50   __PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
51   1;
52
53 =head1 METHODS
54
55 =head2 new
56
57 =over 4
58
59 =item Arguments: $source, \%$attrs
60
61 =item Return Value: $rs
62
63 =back
64
65 The resultset constructor. Takes a source object (usually a
66 L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
67 L</ATTRIBUTES> below).  Does not perform any queries -- these are
68 executed as needed by the other methods.
69
70 Generally you won't need to construct a resultset manually.  You'll
71 automatically get one from e.g. a L</search> called in scalar context:
72
73   my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
74
75 IMPORTANT: If called on an object, proxies to new_result instead so
76
77   my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
78
79 will return a CD object, not a ResultSet.
80
81 =cut
82
83 sub new {
84   my $class = shift;
85   return $class->new_result(@_) if ref $class;
86   
87   my ($source, $attrs) = @_;
88   weaken $source;
89   $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
90   #use Data::Dumper; warn Dumper($attrs);
91   my $alias = ($attrs->{alias} ||= 'me');
92   
93   $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
94   delete $attrs->{as} if $attrs->{columns};
95   $attrs->{columns} ||= [ $source->columns ] unless $attrs->{select};
96   $attrs->{select} = [
97     map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}}
98   ] if $attrs->{columns};
99   $attrs->{as} ||= [
100     map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
101   ];
102   if (my $include = delete $attrs->{include_columns}) {
103     push(@{$attrs->{select}}, @$include);
104     push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include);
105   }
106   #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
107
108   $attrs->{from} ||= [ { $alias => $source->from } ];
109   $attrs->{seen_join} ||= {};
110   my %seen;
111   if (my $join = delete $attrs->{join}) {
112     foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) {
113       if (ref $j eq 'HASH') {
114         $seen{$_} = 1 foreach keys %$j;
115       } else {
116         $seen{$j} = 1;
117       }
118     }
119     push(@{$attrs->{from}}, $source->resolve_join(
120       $join, $attrs->{alias}, $attrs->{seen_join})
121     );
122   }
123   
124   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
125   $attrs->{order_by} = [ $attrs->{order_by} ] if
126     $attrs->{order_by} and !ref($attrs->{order_by});
127   $attrs->{order_by} ||= [];
128
129   my $collapse = $attrs->{collapse} || {};
130   if (my $prefetch = delete $attrs->{prefetch}) {
131     my @pre_order;
132     foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
133       if ( ref $p eq 'HASH' ) {
134         foreach my $key (keys %$p) {
135           push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
136             unless $seen{$key};
137         }
138       } else {
139         push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
140             unless $seen{$p};
141       }
142       my @prefetch = $source->resolve_prefetch(
143            $p, $attrs->{alias}, {}, \@pre_order, $collapse);
144       push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
145       push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
146     }
147     push(@{$attrs->{order_by}}, @pre_order);
148   }
149   $attrs->{collapse} = $collapse;
150 #  use Data::Dumper; warn Dumper($collapse) if keys %{$collapse};
151
152   if ($attrs->{page}) {
153     $attrs->{rows} ||= 10;
154     $attrs->{offset} ||= 0;
155     $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
156   }
157
158   bless {
159     result_source => $source,
160     result_class => $attrs->{result_class} || $source->result_class,
161     cond => $attrs->{where},
162     from => $attrs->{from},
163     collapse => $collapse,
164     count => undef,
165     page => delete $attrs->{page},
166     pager => undef,
167     attrs => $attrs
168   }, $class;
169 }
170
171 =head2 search
172
173 =over 4
174
175 =item Arguments: $cond, \%attrs?
176
177 =item Return Value: $resultset (scalar context), @row_objs (list context)
178
179 =back
180
181   my @cds    = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
182   my $new_rs = $cd_rs->search({ year => 2005 });
183
184   my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
185                  # year = 2005 OR year = 2004
186
187 If you need to pass in additional attributes but no additional condition,
188 call it as C<search(undef, \%attrs)>.
189
190   # "SELECT name, artistid FROM $artist_table"
191   my @all_artists = $schema->resultset('Artist')->search(undef, {
192     columns => [qw/name artistid/],
193   });
194
195 =cut
196
197 sub search {
198   my $self = shift;
199
200   my $rs;
201   if( @_ ) {
202     
203     my $attrs = { %{$self->{attrs}} };
204     my $having = delete $attrs->{having};
205     $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
206
207     my $where = (@_
208                   ? ((@_ == 1 || ref $_[0] eq "HASH")
209                       ? shift
210                       : ((@_ % 2)
211                           ? $self->throw_exception(
212                               "Odd number of arguments to search")
213                           : {@_}))
214                   : undef());
215     if (defined $where) {
216       $attrs->{where} = (defined $attrs->{where}
217                 ? { '-and' =>
218                     [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
219                         $where, $attrs->{where} ] }
220                 : $where);
221     }
222
223     if (defined $having) {
224       $attrs->{having} = (defined $attrs->{having}
225                 ? { '-and' =>
226                     [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
227                         $having, $attrs->{having} ] }
228                 : $having);
229     }
230
231     $rs = (ref $self)->new($self->result_source, $attrs);
232   }
233   else {
234     $rs = $self;
235     $rs->reset;
236   }
237   return (wantarray ? $rs->all : $rs);
238 }
239
240 =head2 search_literal
241
242 =over 4
243
244 =item Arguments: $sql_fragment, @bind_values
245
246 =item Return Value: $resultset (scalar context), @row_objs (list context)
247
248 =back
249
250   my @cds   = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
251   my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
252
253 Pass a literal chunk of SQL to be added to the conditional part of the
254 resultset query.
255
256 =cut
257
258 sub search_literal {
259   my ($self, $cond, @vals) = @_;
260   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
261   $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ];
262   return $self->search(\$cond, $attrs);
263 }
264
265 =head2 find
266
267 =over 4
268
269 =item Arguments: @values | \%cols, \%attrs?
270
271 =item Return Value: $row_object
272
273 =back
274
275 Finds a row based on its primary key or unique constraint. For example:
276
277   my $cd = $schema->resultset('CD')->find(5);
278
279 Also takes an optional C<key> attribute, to search by a specific key or unique
280 constraint. For example:
281
282   my $cd = $schema->resultset('CD')->find(
283     {
284       artist => 'Massive Attack',
285       title  => 'Mezzanine',
286     },
287     { key => 'artist_title' }
288   );
289
290 See also L</find_or_create> and L</update_or_create>.
291
292 =cut
293
294 sub find {
295   my ($self, @vals) = @_;
296   my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
297
298   my @cols = $self->result_source->primary_columns;
299   if (exists $attrs->{key}) {
300     my %uniq = $self->result_source->unique_constraints;
301     $self->throw_exception(
302       "Unknown key $attrs->{key} on '" . $self->result_source->name . "'"
303     ) unless exists $uniq{$attrs->{key}};
304     @cols = @{ $uniq{$attrs->{key}} };
305   }
306   #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
307   $self->throw_exception(
308     "Can't find unless a primary key or unique constraint is defined"
309   ) unless @cols;
310
311   my $query;
312   if (ref $vals[0] eq 'HASH') {
313     $query = { %{$vals[0]} };
314   } elsif (@cols == @vals) {
315     $query = {};
316     @{$query}{@cols} = @vals;
317   } else {
318     $query = {@vals};
319   }
320   foreach my $key (grep { ! m/\./ } keys %$query) {
321     $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
322   }
323   #warn Dumper($query);
324   
325   if (keys %$attrs) {
326       my $rs = $self->search($query,$attrs);
327       return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
328   } else {
329       return keys %{$self->{collapse}} ?
330         $self->search($query)->next :
331         $self->single($query);
332   }
333 }
334
335 =head2 search_related
336
337 =over 4
338
339 =item Arguments: $cond, \%attrs?
340
341 =item Return Value: $new_resultset
342
343 =back
344
345   $new_rs = $cd_rs->search_related('artist', {
346     name => 'Emo-R-Us',
347   });
348
349 Searches the specified relationship, optionally specifying a condition and
350 attributes for matching records. See L</ATTRIBUTES> for more information.
351
352 =cut
353
354 sub search_related {
355   return shift->related_resultset(shift)->search(@_);
356 }
357
358 =head2 cursor
359
360 =over 4
361
362 =item Arguments: none
363
364 =item Return Value: $cursor
365
366 =back
367
368 Returns a storage-driven cursor to the given resultset. See
369 L<DBIx::Class::Cursor> for more information.
370
371 =cut
372
373 sub cursor {
374   my ($self) = @_;
375   my $attrs = { %{$self->{attrs}} };
376   return $self->{cursor}
377     ||= $self->result_source->storage->select($self->{from}, $attrs->{select},
378           $attrs->{where},$attrs);
379 }
380
381 =head2 single
382
383 =over 4
384
385 =item Arguments: $cond?
386
387 =item Return Value: $row_object?
388
389 =back
390
391   my $cd = $schema->resultset('CD')->single({ year => 2001 });
392
393 Inflates the first result without creating a cursor if the resultset has
394 any records in it; if not returns nothing. Used by find() as an optimisation.
395
396 =cut
397
398 sub single {
399   my ($self, $where) = @_;
400   my $attrs = { %{$self->{attrs}} };
401   if ($where) {
402     if (defined $attrs->{where}) {
403       $attrs->{where} = {
404         '-and' =>
405             [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
406                $where, delete $attrs->{where} ]
407       };
408     } else {
409       $attrs->{where} = $where;
410     }
411   }
412   my @data = $self->result_source->storage->select_single(
413           $self->{from}, $attrs->{select},
414           $attrs->{where},$attrs);
415   return (@data ? $self->_construct_object(@data) : ());
416 }
417
418 =head2 get_column
419
420 =over 4
421
422 =item Arguments: $cond?
423
424 =item Return Value: $resultsetcolumn
425
426 =back
427
428   my $max_length = $rs->get_column('length')->max;
429
430 Returns a ResultSetColumn instance for $column based on $self
431
432 =cut
433
434 sub get_column {
435   my ($self, $column) = @_;
436
437   my $new = DBIx::Class::ResultSetColumn->new($self, $column);
438   return $new;
439 }
440
441 =head2 search_like
442
443 =over 4
444
445 =item Arguments: $cond, \%attrs?
446
447 =item Return Value: $resultset (scalar context), @row_objs (list context)
448
449 =back
450
451   # WHERE title LIKE '%blue%'
452   $cd_rs = $rs->search_like({ title => '%blue%'});
453
454 Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
455 that this is simply a convenience method. You most likely want to use
456 L</search> with specific operators.
457
458 For more information, see L<DBIx::Class::Manual::Cookbook>.
459
460 =cut
461
462 sub search_like {
463   my $class = shift;
464   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
465   my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
466   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
467   return $class->search($query, { %$attrs });
468 }
469
470 =head2 slice
471
472 =over 4
473
474 =item Arguments: $first, $last
475
476 =item Return Value: $resultset (scalar context), @row_objs (list context)
477
478 =back
479
480 Returns a resultset or object list representing a subset of elements from the
481 resultset slice is called on. Indexes are from 0, i.e., to get the first
482 three records, call:
483
484   my ($one, $two, $three) = $rs->slice(0, 2);
485
486 =cut
487
488 sub slice {
489   my ($self, $min, $max) = @_;
490   my $attrs = {}; # = { %{ $self->{attrs} || {} } };
491   $attrs->{offset} = $self->{attrs}{offset} || 0;
492   $attrs->{offset} += $min;
493   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
494   return $self->search(undef(), $attrs);
495   #my $slice = (ref $self)->new($self->result_source, $attrs);
496   #return (wantarray ? $slice->all : $slice);
497 }
498
499 =head2 next
500
501 =over 4
502
503 =item Arguments: none
504
505 =item Return Value: $result?
506
507 =back
508
509 Returns the next element in the resultset (C<undef> is there is none).
510
511 Can be used to efficiently iterate over records in the resultset:
512
513   my $rs = $schema->resultset('CD')->search;
514   while (my $cd = $rs->next) {
515     print $cd->title;
516   }
517
518 Note that you need to store the resultset object, and call C<next> on it. 
519 Calling C<< resultset('Table')->next >> repeatedly will always return the
520 first record from the resultset.
521
522 =cut
523
524 sub next {
525   my ($self) = @_;
526   if (@{$self->{all_cache} || []}) {
527     $self->{all_cache_position} ||= 0;
528     return $self->{all_cache}->[$self->{all_cache_position}++];
529   }
530   if ($self->{attrs}{cache}) {
531     $self->{all_cache_position} = 1;
532     return ($self->all)[0];
533   }
534   my @row = (exists $self->{stashed_row} ?
535                @{delete $self->{stashed_row}} :
536                $self->cursor->next
537   );
538 #  warn Dumper(\@row); use Data::Dumper;
539   return unless (@row);
540   return $self->_construct_object(@row);
541 }
542
543 sub _construct_object {
544   my ($self, @row) = @_;
545   my @as = @{ $self->{attrs}{as} };
546   
547   my $info = $self->_collapse_result(\@as, \@row);
548   
549   my $new = $self->result_class->inflate_result($self->result_source, @$info);
550   
551   $new = $self->{attrs}{record_filter}->($new)
552     if exists $self->{attrs}{record_filter};
553   return $new;
554 }
555
556 sub _collapse_result {
557   my ($self, $as, $row, $prefix) = @_;
558
559   my %const;
560
561   my @copy = @$row;
562   foreach my $this_as (@$as) {
563     my $val = shift @copy;
564     if (defined $prefix) {
565       if ($this_as =~ m/^\Q${prefix}.\E(.+)$/) {
566         my $remain = $1;
567         $remain =~ /^(?:(.*)\.)?([^.]+)$/;
568         $const{$1||''}{$2} = $val;
569       }
570     } else {
571       $this_as =~ /^(?:(.*)\.)?([^.]+)$/;
572       $const{$1||''}{$2} = $val;
573     }
574   }
575
576   my $info = [ {}, {} ];
577   foreach my $key (keys %const) {
578     if (length $key) {
579       my $target = $info;
580       my @parts = split(/\./, $key);
581       foreach my $p (@parts) {
582         $target = $target->[1]->{$p} ||= [];
583       }
584       $target->[0] = $const{$key};
585     } else {
586       $info->[0] = $const{$key};
587     }
588   }
589
590   my @collapse;
591   if (defined $prefix) {
592     @collapse = map {
593         m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
594     } keys %{$self->{collapse}}
595   } else {
596     @collapse = keys %{$self->{collapse}};
597   };
598
599   if (@collapse) {
600     my ($c) = sort { length $a <=> length $b } @collapse;
601     my $target = $info;
602     foreach my $p (split(/\./, $c)) {
603       $target = $target->[1]->{$p} ||= [];
604     }
605     my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c);
606     my @co_key = @{$self->{collapse}{$c_prefix}};
607     my %co_check = map { ($_, $target->[0]->{$_}); } @co_key;
608     my $tree = $self->_collapse_result($as, $row, $c_prefix);
609     my (@final, @raw);
610     while ( !(grep {
611                 !defined($tree->[0]->{$_}) ||
612                 $co_check{$_} ne $tree->[0]->{$_}
613               } @co_key) ) {
614       push(@final, $tree);
615       last unless (@raw = $self->cursor->next);
616       $row = $self->{stashed_row} = \@raw;
617       $tree = $self->_collapse_result($as, $row, $c_prefix);
618       #warn Data::Dumper::Dumper($tree, $row);
619     }
620     @$target = @final;
621   }
622
623   return $info;
624 }
625
626 =head2 result_source
627
628 =over 4
629
630 =item Arguments: $result_source?
631
632 =item Return Value: $result_source
633
634 =back
635
636 An accessor for the primary ResultSource object from which this ResultSet
637 is derived.
638
639 =cut
640
641
642 =head2 count
643
644 =over 4
645
646 =item Arguments: $cond, \%attrs??
647
648 =item Return Value: $count
649
650 =back
651
652 Performs an SQL C<COUNT> with the same query as the resultset was built
653 with to find the number of elements. If passed arguments, does a search
654 on the resultset and counts the results of that.
655
656 Note: When using C<count> with C<group_by>, L<DBIX::Class> emulates C<GROUP BY>
657 using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
658 not support C<DISTINCT> with multiple columns. If you are using such a
659 database, you should only use columns from the main table in your C<group_by>
660 clause.
661
662 =cut
663
664 sub count {
665   my $self = shift;
666   return $self->search(@_)->count if @_ and defined $_[0];
667   return scalar @{ $self->get_cache } if @{ $self->get_cache };
668
669   my $count = $self->_count;
670   return 0 unless $count;
671
672   $count -= $self->{attrs}{offset} if $self->{attrs}{offset};
673   $count = $self->{attrs}{rows} if
674     $self->{attrs}{rows} and $self->{attrs}{rows} < $count;
675   return $count;
676 }
677
678 sub _count { # Separated out so pager can get the full count
679   my $self = shift;
680   my $select = { count => '*' };
681   my $attrs = { %{ $self->{attrs} } };
682   if (my $group_by = delete $attrs->{group_by}) {
683     delete $attrs->{having};
684     my @distinct = (ref $group_by ?  @$group_by : ($group_by));
685     # todo: try CONCAT for multi-column pk
686     my @pk = $self->result_source->primary_columns;
687     if (@pk == 1) {
688       foreach my $column (@distinct) {
689         if ($column =~ qr/^(?:\Q$attrs->{alias}.\E)?$pk[0]$/) {
690           @distinct = ($column);
691           last;
692         }
693       }
694     }
695
696     $select = { count => { distinct => \@distinct } };
697     #use Data::Dumper; die Dumper $select;
698   }
699
700   $attrs->{select} = $select;
701   $attrs->{as} = [qw/count/];
702
703   # offset, order by and page are not needed to count. record_filter is cdbi
704   delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
705         
706   my ($count) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
707   return $count;
708 }
709
710 =head2 count_literal
711
712 =over 4
713
714 =item Arguments: $sql_fragment, @bind_values
715
716 =item Return Value: $count
717
718 =back
719
720 Counts the results in a literal query. Equivalent to calling L</search_literal>
721 with the passed arguments, then L</count>.
722
723 =cut
724
725 sub count_literal { shift->search_literal(@_)->count; }
726
727 =head2 all
728
729 =over 4
730
731 =item Arguments: none
732
733 =item Return Value: @objects
734
735 =back
736
737 Returns all elements in the resultset. Called implicitly if the resultset
738 is returned in list context.
739
740 =cut
741
742 sub all {
743   my ($self) = @_;
744   return @{ $self->get_cache } if @{ $self->get_cache };
745
746   my @obj;
747
748   if (keys %{$self->{collapse}}) {
749       # Using $self->cursor->all is really just an optimisation.
750       # If we're collapsing has_many prefetches it probably makes
751       # very little difference, and this is cleaner than hacking
752       # _construct_object to survive the approach
753     $self->cursor->reset;
754     my @row = $self->cursor->next;
755     while (@row) {
756       push(@obj, $self->_construct_object(@row));
757       @row = (exists $self->{stashed_row}
758                ? @{delete $self->{stashed_row}}
759                : $self->cursor->next);
760     }
761   } else {
762     @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
763   }
764
765   $self->set_cache(\@obj) if $self->{attrs}{cache};
766   return @obj;
767 }
768
769 =head2 reset
770
771 =over 4
772
773 =item Arguments: none
774
775 =item Return Value: $self
776
777 =back
778
779 Resets the resultset's cursor, so you can iterate through the elements again.
780
781 =cut
782
783 sub reset {
784   my ($self) = @_;
785   $self->{all_cache_position} = 0;
786   $self->cursor->reset;
787   return $self;
788 }
789
790 =head2 first
791
792 =over 4
793
794 =item Arguments: none
795
796 =item Return Value: $object?
797
798 =back
799
800 Resets the resultset and returns an object for the first result (if the
801 resultset returns anything).
802
803 =cut
804
805 sub first {
806   return $_[0]->reset->next;
807 }
808
809 # _cond_for_update_delete
810 #
811 # update/delete require the condition to be modified to handle
812 # the differing SQL syntax available.  This transforms the $self->{cond}
813 # appropriately, returning the new condition
814
815 sub _cond_for_update_delete {
816   my ($self) = @_;
817   my $cond = {};
818
819   if (!ref($self->{cond})) {
820     # No-op. No condition, we're update/deleting everything
821   }
822   elsif (ref $self->{cond} eq 'ARRAY') {
823     $cond = [
824       map {
825         my %hash;
826         foreach my $key (keys %{$_}) {
827           $key =~ /([^.]+)$/;
828           $hash{$1} = $_->{$key};
829         }
830         \%hash;
831         } @{$self->{cond}}
832     ];
833   }
834   elsif (ref $self->{cond} eq 'HASH') {
835     if ((keys %{$self->{cond}})[0] eq '-and') {
836       $cond->{-and} = [
837         map {
838           my %hash;
839           foreach my $key (keys %{$_}) {
840             $key =~ /([^.]+)$/;
841             $hash{$1} = $_->{$key};
842           }
843           \%hash;
844           } @{$self->{cond}{-and}}
845       ];
846     }
847     else {
848       foreach my $key (keys %{$self->{cond}}) {
849         $key =~ /([^.]+)$/;
850         $cond->{$1} = $self->{cond}{$key};
851       }
852     }
853   }
854   else {
855     $self->throw_exception(
856                "Can't update/delete on resultset with condition unless hash or array");
857   }
858   return $cond;
859 }
860
861
862 =head2 update
863
864 =over 4
865
866 =item Arguments: \%values
867
868 =item Return Value: $storage_rv
869
870 =back
871
872 Sets the specified columns in the resultset to the supplied values in a
873 single query. Return value will be true if the update succeeded or false
874 if no records were updated; exact type of success value is storage-dependent.
875
876 =cut
877
878 sub update {
879   my ($self, $values) = @_;
880   $self->throw_exception("Values for update must be a hash")
881     unless ref $values eq 'HASH';
882
883   my $cond = $self->_cond_for_update_delete;
884
885   return $self->result_source->storage->update(
886     $self->result_source->from, $values, $cond
887   );
888 }
889
890 =head2 update_all
891
892 =over 4
893
894 =item Arguments: \%values
895
896 =item Return Value: 1
897
898 =back
899
900 Fetches all objects and updates them one at a time. Note that C<update_all>
901 will run DBIC cascade triggers, while L</update> will not.
902
903 =cut
904
905 sub update_all {
906   my ($self, $values) = @_;
907   $self->throw_exception("Values for update must be a hash")
908     unless ref $values eq 'HASH';
909   foreach my $obj ($self->all) {
910     $obj->set_columns($values)->update;
911   }
912   return 1;
913 }
914
915 =head2 delete
916
917 =over 4
918
919 =item Arguments: none
920
921 =item Return Value: 1
922
923 =back
924
925 Deletes the contents of the resultset from its result source. Note that this
926 will not run DBIC cascade triggers. See L</delete_all> if you need triggers
927 to run.
928
929 =cut
930
931 sub delete {
932   my ($self) = @_;
933   my $del = {};
934
935   my $cond = $self->_cond_for_update_delete;
936
937   $self->result_source->storage->delete($self->result_source->from, $cond);
938   return 1;
939 }
940
941 =head2 delete_all
942
943 =over 4
944
945 =item Arguments: none
946
947 =item Return Value: 1
948
949 =back
950
951 Fetches all objects and deletes them one at a time. Note that C<delete_all>
952 will run DBIC cascade triggers, while L</delete> will not.
953
954 =cut
955
956 sub delete_all {
957   my ($self) = @_;
958   $_->delete for $self->all;
959   return 1;
960 }
961
962 =head2 pager
963
964 =over 4
965
966 =item Arguments: none
967
968 =item Return Value: $pager
969
970 =back
971
972 Return Value a L<Data::Page> object for the current resultset. Only makes
973 sense for queries with a C<page> attribute.
974
975 =cut
976
977 sub pager {
978   my ($self) = @_;
979   my $attrs = $self->{attrs};
980   $self->throw_exception("Can't create pager for non-paged rs")
981     unless $self->{page};
982   $attrs->{rows} ||= 10;
983   return $self->{pager} ||= Data::Page->new(
984     $self->_count, $attrs->{rows}, $self->{page});
985 }
986
987 =head2 page
988
989 =over 4
990
991 =item Arguments: $page_number
992
993 =item Return Value: $rs
994
995 =back
996
997 Returns a resultset for the $page_number page of the resultset on which page
998 is called, where each page contains a number of rows equal to the 'rows'
999 attribute set on the resultset (10 by default).
1000
1001 =cut
1002
1003 sub page {
1004   my ($self, $page) = @_;
1005   my $attrs = { %{$self->{attrs}} };
1006   $attrs->{page} = $page;
1007   return (ref $self)->new($self->result_source, $attrs);
1008 }
1009
1010 =head2 new_result
1011
1012 =over 4
1013
1014 =item Arguments: \%vals
1015
1016 =item Return Value: $object
1017
1018 =back
1019
1020 Creates an object in the resultset's result class and returns it.
1021
1022 =cut
1023
1024 sub new_result {
1025   my ($self, $values) = @_;
1026   $self->throw_exception( "new_result needs a hash" )
1027     unless (ref $values eq 'HASH');
1028   $self->throw_exception(
1029     "Can't abstract implicit construct, condition not a hash"
1030   ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
1031   my %new = %$values;
1032   my $alias = $self->{attrs}{alias};
1033   foreach my $key (keys %{$self->{cond}||{}}) {
1034     $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:\Q${alias}.\E)?([^.]+)$/);
1035   }
1036   my $obj = $self->result_class->new(\%new);
1037   $obj->result_source($self->result_source) if $obj->can('result_source');
1038   return $obj;
1039 }
1040
1041 =head2 create
1042
1043 =over 4
1044
1045 =item Arguments: \%vals
1046
1047 =item Return Value: $object
1048
1049 =back
1050
1051 Inserts a record into the resultset and returns the object representing it.
1052
1053 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
1054
1055 =cut
1056
1057 sub create {
1058   my ($self, $attrs) = @_;
1059   $self->throw_exception( "create needs a hashref" )
1060     unless ref $attrs eq 'HASH';
1061   return $self->new_result($attrs)->insert;
1062 }
1063
1064 =head2 find_or_create
1065
1066 =over 4
1067
1068 =item Arguments: \%vals, \%attrs?
1069
1070 =item Return Value: $object
1071
1072 =back
1073
1074   $class->find_or_create({ key => $val, ... });
1075
1076 Searches for a record matching the search condition; if it doesn't find one,
1077 creates one and returns that instead.
1078
1079   my $cd = $schema->resultset('CD')->find_or_create({
1080     cdid   => 5,
1081     artist => 'Massive Attack',
1082     title  => 'Mezzanine',
1083     year   => 2005,
1084   });
1085
1086 Also takes an optional C<key> attribute, to search by a specific key or unique
1087 constraint. For example:
1088
1089   my $cd = $schema->resultset('CD')->find_or_create(
1090     {
1091       artist => 'Massive Attack',
1092       title  => 'Mezzanine',
1093     },
1094     { key => 'artist_title' }
1095   );
1096
1097 See also L</find> and L</update_or_create>.
1098
1099 =cut
1100
1101 sub find_or_create {
1102   my $self     = shift;
1103   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1104   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
1105   my $exists   = $self->find($hash, $attrs);
1106   return defined $exists ? $exists : $self->create($hash);
1107 }
1108
1109 =head2 update_or_create
1110
1111 =over 4
1112
1113 =item Arguments: \%col_values, { key => $unique_constraint }?
1114
1115 =item Return Value: $object
1116
1117 =back
1118
1119   $class->update_or_create({ col => $val, ... });
1120
1121 First, searches for an existing row matching one of the unique constraints
1122 (including the primary key) on the source of this resultset. If a row is
1123 found, updates it with the other given column values. Otherwise, creates a new
1124 row.
1125
1126 Takes an optional C<key> attribute to search on a specific unique constraint.
1127 For example:
1128
1129   # In your application
1130   my $cd = $schema->resultset('CD')->update_or_create(
1131     {
1132       artist => 'Massive Attack',
1133       title  => 'Mezzanine',
1134       year   => 1998,
1135     },
1136     { key => 'artist_title' }
1137   );
1138
1139 If no C<key> is specified, it searches on all unique constraints defined on the
1140 source, including the primary key.
1141
1142 If the C<key> is specified as C<primary>, it searches only on the primary key.
1143
1144 See also L</find> and L</find_or_create>.
1145
1146 =cut
1147
1148 sub update_or_create {
1149   my $self = shift;
1150   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1151   my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
1152
1153   my %unique_constraints = $self->result_source->unique_constraints;
1154   my @constraint_names   = (exists $attrs->{key}
1155                             ? ($attrs->{key})
1156                             : keys %unique_constraints);
1157
1158   my @unique_hashes;
1159   foreach my $name (@constraint_names) {
1160     my @unique_cols = @{ $unique_constraints{$name} };
1161     my %unique_hash =
1162       map  { $_ => $hash->{$_} }
1163       grep { exists $hash->{$_} }
1164       @unique_cols;
1165
1166     push @unique_hashes, \%unique_hash
1167       if (scalar keys %unique_hash == scalar @unique_cols);
1168   }
1169
1170   if (@unique_hashes) {
1171     my $row = $self->single(\@unique_hashes);
1172     if (defined $row) {
1173       $row->set_columns($hash);
1174       $row->update;
1175       return $row;
1176     }
1177   }
1178
1179   return $self->create($hash);
1180 }
1181
1182 =head2 get_cache
1183
1184 =over 4
1185
1186 =item Arguments: none
1187
1188 =item Return Value: \@cache_objects?
1189
1190 =back
1191
1192 Gets the contents of the cache for the resultset, if the cache is set.
1193
1194 =cut
1195
1196 sub get_cache {
1197   shift->{all_cache} || [];
1198 }
1199
1200 =head2 set_cache
1201
1202 =over 4
1203
1204 =item Arguments: \@cache_objects
1205
1206 =item Return Value: \@cache_objects
1207
1208 =back
1209
1210 Sets the contents of the cache for the resultset. Expects an arrayref
1211 of objects of the same class as those produced by the resultset. Note that
1212 if the cache is set the resultset will return the cached objects rather
1213 than re-querying the database even if the cache attr is not set.
1214
1215 =cut
1216
1217 sub set_cache {
1218   my ( $self, $data ) = @_;
1219   $self->throw_exception("set_cache requires an arrayref")
1220     if ref $data ne 'ARRAY';
1221   my $result_class = $self->result_class;
1222   foreach( @$data ) {
1223     $self->throw_exception(
1224       "cannot cache object of type '$_', expected '$result_class'"
1225     ) if ref $_ ne $result_class;
1226   }
1227   $self->{all_cache} = $data;
1228 }
1229
1230 =head2 clear_cache
1231
1232 =over 4
1233
1234 =item Arguments: none
1235
1236 =item Return Value: []
1237
1238 =back
1239
1240 Clears the cache for the resultset.
1241
1242 =cut
1243
1244 sub clear_cache {
1245   shift->set_cache([]);
1246 }
1247
1248 =head2 related_resultset
1249
1250 =over 4
1251
1252 =item Arguments: $relationship_name
1253
1254 =item Return Value: $resultset
1255
1256 =back
1257
1258 Returns a related resultset for the supplied relationship name.
1259
1260   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
1261
1262 =cut
1263
1264 sub related_resultset {
1265   my ( $self, $rel ) = @_;
1266   $self->{related_resultsets} ||= {};
1267   return $self->{related_resultsets}{$rel} ||= do {
1268       #warn "fetching related resultset for rel '$rel'";
1269       my $rel_obj = $self->result_source->relationship_info($rel);
1270       $self->throw_exception(
1271         "search_related: result source '" . $self->result_source->name .
1272         "' has no such relationship ${rel}")
1273         unless $rel_obj; #die Dumper $self->{attrs};
1274
1275       my $rs = $self->search(undef, { join => $rel });
1276       my $alias = defined $rs->{attrs}{seen_join}{$rel}
1277                     && $rs->{attrs}{seen_join}{$rel} > 1
1278                   ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
1279                   : $rel;
1280
1281       $self->result_source->schema->resultset($rel_obj->{class}
1282            )->search( undef,
1283              { %{$rs->{attrs}},
1284                alias => $alias,
1285                select => undef,
1286                as => undef }
1287            );
1288   };
1289 }
1290
1291 =head2 throw_exception
1292
1293 See L<DBIx::Class::Schema/throw_exception> for details.
1294
1295 =cut
1296
1297 sub throw_exception {
1298   my $self=shift;
1299   $self->result_source->schema->throw_exception(@_);
1300 }
1301
1302 # XXX: FIXME: Attributes docs need clearing up
1303
1304 =head1 ATTRIBUTES
1305
1306 The resultset takes various attributes that modify its behavior. Here's an
1307 overview of them:
1308
1309 =head2 order_by
1310
1311 =over 4
1312
1313 =item Value: ($order_by | \@order_by)
1314
1315 =back
1316
1317 Which column(s) to order the results by. This is currently passed
1318 through directly to SQL, so you can give e.g. C<year DESC> for a
1319 descending order on the column `year'.
1320
1321 =head2 columns
1322
1323 =over 4
1324
1325 =item Value: \@columns
1326
1327 =back
1328
1329 Shortcut to request a particular set of columns to be retrieved.  Adds
1330 C<me.> onto the start of any column without a C<.> in it and sets C<select>
1331 from that, then auto-populates C<as> from C<select> as normal. (You may also
1332 use the C<cols> attribute, as in earlier versions of DBIC.)
1333
1334 =head2 include_columns
1335
1336 =over 4
1337
1338 =item Value: \@columns
1339
1340 =back
1341
1342 Shortcut to include additional columns in the returned results - for example
1343
1344   $schema->resultset('CD')->search(undef, {
1345     include_columns => ['artist.name'],
1346     join => ['artist']
1347   });
1348
1349 would return all CDs and include a 'name' column to the information
1350 passed to object inflation
1351
1352 =head2 select
1353
1354 =over 4
1355
1356 =item Value: \@select_columns
1357
1358 =back
1359
1360 Indicates which columns should be selected from the storage. You can use
1361 column names, or in the case of RDBMS back ends, function or stored procedure
1362 names:
1363
1364   $rs = $schema->resultset('Employee')->search(undef, {
1365     select => [
1366       'name',
1367       { count => 'employeeid' },
1368       { sum => 'salary' }
1369     ]
1370   });
1371
1372 When you use function/stored procedure names and do not supply an C<as>
1373 attribute, the column names returned are storage-dependent. E.g. MySQL would
1374 return a column named C<count(employeeid)> in the above example.
1375
1376 =head2 as
1377
1378 =over 4
1379
1380 =item Value: \@inflation_names
1381
1382 =back
1383
1384 Indicates column names for object inflation. This is used in conjunction with
1385 C<select>, usually when C<select> contains one or more function or stored
1386 procedure names:
1387
1388   $rs = $schema->resultset('Employee')->search(undef, {
1389     select => [
1390       'name',
1391       { count => 'employeeid' }
1392     ],
1393     as => ['name', 'employee_count'],
1394   });
1395
1396   my $employee = $rs->first(); # get the first Employee
1397
1398 If the object against which the search is performed already has an accessor
1399 matching a column name specified in C<as>, the value can be retrieved using
1400 the accessor as normal:
1401
1402   my $name = $employee->name();
1403
1404 If on the other hand an accessor does not exist in the object, you need to
1405 use C<get_column> instead:
1406
1407   my $employee_count = $employee->get_column('employee_count');
1408
1409 You can create your own accessors if required - see
1410 L<DBIx::Class::Manual::Cookbook> for details.
1411
1412 =head2 join
1413
1414 =over 4
1415
1416 =item Value: ($rel_name | \@rel_names | \%rel_names)
1417
1418 =back
1419
1420 Contains a list of relationships that should be joined for this query.  For
1421 example:
1422
1423   # Get CDs by Nine Inch Nails
1424   my $rs = $schema->resultset('CD')->search(
1425     { 'artist.name' => 'Nine Inch Nails' },
1426     { join => 'artist' }
1427   );
1428
1429 Can also contain a hash reference to refer to the other relation's relations.
1430 For example:
1431
1432   package MyApp::Schema::Track;
1433   use base qw/DBIx::Class/;
1434   __PACKAGE__->table('track');
1435   __PACKAGE__->add_columns(qw/trackid cd position title/);
1436   __PACKAGE__->set_primary_key('trackid');
1437   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
1438   1;
1439
1440   # In your application
1441   my $rs = $schema->resultset('Artist')->search(
1442     { 'track.title' => 'Teardrop' },
1443     {
1444       join     => { cd => 'track' },
1445       order_by => 'artist.name',
1446     }
1447   );
1448
1449 If the same join is supplied twice, it will be aliased to <rel>_2 (and
1450 similarly for a third time). For e.g.
1451
1452   my $rs = $schema->resultset('Artist')->search({
1453     'cds.title'   => 'Down to Earth',
1454     'cds_2.title' => 'Popular',
1455   }, {
1456     join => [ qw/cds cds/ ],
1457   });
1458
1459 will return a set of all artists that have both a cd with title 'Down
1460 to Earth' and a cd with title 'Popular'.
1461
1462 If you want to fetch related objects from other tables as well, see C<prefetch>
1463 below.
1464
1465 =head2 prefetch
1466
1467 =over 4
1468
1469 =item Value: ($rel_name | \@rel_names | \%rel_names)
1470
1471 =back
1472
1473 Contains one or more relationships that should be fetched along with the main
1474 query (when they are accessed afterwards they will have already been
1475 "prefetched").  This is useful for when you know you will need the related
1476 objects, because it saves at least one query:
1477
1478   my $rs = $schema->resultset('Tag')->search(
1479     undef,
1480     {
1481       prefetch => {
1482         cd => 'artist'
1483       }
1484     }
1485   );
1486
1487 The initial search results in SQL like the following:
1488
1489   SELECT tag.*, cd.*, artist.* FROM tag
1490   JOIN cd ON tag.cd = cd.cdid
1491   JOIN artist ON cd.artist = artist.artistid
1492
1493 L<DBIx::Class> has no need to go back to the database when we access the
1494 C<cd> or C<artist> relationships, which saves us two SQL statements in this
1495 case.
1496
1497 Simple prefetches will be joined automatically, so there is no need
1498 for a C<join> attribute in the above search. If you're prefetching to
1499 depth (e.g. { cd => { artist => 'label' } or similar), you'll need to
1500 specify the join as well.
1501
1502 C<prefetch> can be used with the following relationship types: C<belongs_to>,
1503 C<has_one> (or if you're using C<add_relationship>, any relationship declared
1504 with an accessor type of 'single' or 'filter').
1505
1506 =head2 from
1507
1508 =over 4
1509
1510 =item Value: \@from_clause
1511
1512 =back
1513
1514 The C<from> attribute gives you manual control over the C<FROM> clause of SQL
1515 statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
1516 clauses.
1517
1518 NOTE: Use this on your own risk.  This allows you to shoot off your foot!
1519 C<join> will usually do what you need and it is strongly recommended that you
1520 avoid using C<from> unless you cannot achieve the desired result using C<join>.
1521
1522 In simple terms, C<from> works as follows:
1523
1524     [
1525         { <alias> => <table>, -join_type => 'inner|left|right' }
1526         [] # nested JOIN (optional)
1527         { <table.column> => <foreign_table.foreign_key> }
1528     ]
1529
1530     JOIN
1531         <alias> <table>
1532         [JOIN ...]
1533     ON <table.column> = <foreign_table.foreign_key>
1534
1535 An easy way to follow the examples below is to remember the following:
1536
1537     Anything inside "[]" is a JOIN
1538     Anything inside "{}" is a condition for the enclosing JOIN
1539
1540 The following examples utilize a "person" table in a family tree application.
1541 In order to express parent->child relationships, this table is self-joined:
1542
1543     # Person->belongs_to('father' => 'Person');
1544     # Person->belongs_to('mother' => 'Person');
1545
1546 C<from> can be used to nest joins. Here we return all children with a father,
1547 then search against all mothers of those children:
1548
1549   $rs = $schema->resultset('Person')->search(
1550       undef,
1551       {
1552           alias => 'mother', # alias columns in accordance with "from"
1553           from => [
1554               { mother => 'person' },
1555               [
1556                   [
1557                       { child => 'person' },
1558                       [
1559                           { father => 'person' },
1560                           { 'father.person_id' => 'child.father_id' }
1561                       ]
1562                   ],
1563                   { 'mother.person_id' => 'child.mother_id' }
1564               ],
1565           ]
1566       },
1567   );
1568
1569   # Equivalent SQL:
1570   # SELECT mother.* FROM person mother
1571   # JOIN (
1572   #   person child
1573   #   JOIN person father
1574   #   ON ( father.person_id = child.father_id )
1575   # )
1576   # ON ( mother.person_id = child.mother_id )
1577
1578 The type of any join can be controlled manually. To search against only people
1579 with a father in the person table, we could explicitly use C<INNER JOIN>:
1580
1581     $rs = $schema->resultset('Person')->search(
1582         undef,
1583         {
1584             alias => 'child', # alias columns in accordance with "from"
1585             from => [
1586                 { child => 'person' },
1587                 [
1588                     { father => 'person', -join_type => 'inner' },
1589                     { 'father.id' => 'child.father_id' }
1590                 ],
1591             ]
1592         },
1593     );
1594
1595     # Equivalent SQL:
1596     # SELECT child.* FROM person child
1597     # INNER JOIN person father ON child.father_id = father.id
1598
1599 =head2 page
1600
1601 =over 4
1602
1603 =item Value: $page
1604
1605 =back
1606
1607 Makes the resultset paged and specifies the page to retrieve. Effectively
1608 identical to creating a non-pages resultset and then calling ->page($page)
1609 on it.
1610
1611 =head2 rows
1612
1613 =over 4
1614
1615 =item Value: $rows
1616
1617 =back
1618
1619 Specifes the maximum number of rows for direct retrieval or the number of
1620 rows per page if the page attribute or method is used.
1621
1622 =head2 group_by
1623
1624 =over 4
1625
1626 =item Value: \@columns
1627
1628 =back
1629
1630 A arrayref of columns to group by. Can include columns of joined tables.
1631
1632   group_by => [qw/ column1 column2 ... /]
1633
1634 =head2 having
1635
1636 =over 4
1637
1638 =item Value: $condition
1639
1640 =back
1641
1642 HAVING is a select statement attribute that is applied between GROUP BY and
1643 ORDER BY. It is applied to the after the grouping calculations have been
1644 done. 
1645
1646   having => { 'count(employee)' => { '>=', 100 } }
1647
1648 =head2 distinct
1649
1650 =over 4
1651
1652 =item Value: (0 | 1)
1653
1654 =back
1655
1656 Set to 1 to group by all columns.
1657
1658 =head2 cache
1659
1660 Set to 1 to cache search results. This prevents extra SQL queries if you
1661 revisit rows in your ResultSet:
1662
1663   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
1664   
1665   while( my $artist = $resultset->next ) {
1666     ... do stuff ...
1667   }
1668
1669   $rs->first; # without cache, this would issue a query
1670
1671 By default, searches are not cached.
1672
1673 For more examples of using these attributes, see
1674 L<DBIx::Class::Manual::Cookbook>.
1675
1676 =cut
1677
1678 1;