more TODOs
[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} ||= 0;
492   $attrs->{offset} += $min;
493   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
494   my $slice = (ref $self)->new($self->result_source, $attrs);
495   return (wantarray ? $slice->all : $slice);
496 }
497
498 =head2 next
499
500 =over 4
501
502 =item Arguments: none
503
504 =item Return Value: $result?
505
506 =back
507
508 Returns the next element in the resultset (C<undef> is there is none).
509
510 Can be used to efficiently iterate over records in the resultset:
511
512   my $rs = $schema->resultset('CD')->search;
513   while (my $cd = $rs->next) {
514     print $cd->title;
515   }
516
517 =cut
518
519 sub next {
520   my ($self) = @_;
521   if (@{$self->{all_cache} || []}) {
522     $self->{all_cache_position} ||= 0;
523     return $self->{all_cache}->[$self->{all_cache_position}++];
524   }
525   if ($self->{attrs}{cache}) {
526     $self->{all_cache_position} = 1;
527     return ($self->all)[0];
528   }
529   my @row = (exists $self->{stashed_row} ?
530                @{delete $self->{stashed_row}} :
531                $self->cursor->next
532   );
533 #  warn Dumper(\@row); use Data::Dumper;
534   return unless (@row);
535   return $self->_construct_object(@row);
536 }
537
538 sub _construct_object {
539   my ($self, @row) = @_;
540   my @as = @{ $self->{attrs}{as} };
541   
542   my $info = $self->_collapse_result(\@as, \@row);
543   
544   my $new = $self->result_class->inflate_result($self->result_source, @$info);
545   
546   $new = $self->{attrs}{record_filter}->($new)
547     if exists $self->{attrs}{record_filter};
548   return $new;
549 }
550
551 sub _collapse_result {
552   my ($self, $as, $row, $prefix) = @_;
553
554   my %const;
555
556   my @copy = @$row;
557   foreach my $this_as (@$as) {
558     my $val = shift @copy;
559     if (defined $prefix) {
560       if ($this_as =~ m/^\Q${prefix}.\E(.+)$/) {
561         my $remain = $1;
562         $remain =~ /^(?:(.*)\.)?([^.]+)$/;
563         $const{$1||''}{$2} = $val;
564       }
565     } else {
566       $this_as =~ /^(?:(.*)\.)?([^.]+)$/;
567       $const{$1||''}{$2} = $val;
568     }
569   }
570
571   my $info = [ {}, {} ];
572   foreach my $key (keys %const) {
573     if (length $key) {
574       my $target = $info;
575       my @parts = split(/\./, $key);
576       foreach my $p (@parts) {
577         $target = $target->[1]->{$p} ||= [];
578       }
579       $target->[0] = $const{$key};
580     } else {
581       $info->[0] = $const{$key};
582     }
583   }
584
585   my @collapse;
586   if (defined $prefix) {
587     @collapse = map {
588         m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
589     } keys %{$self->{collapse}}
590   } else {
591     @collapse = keys %{$self->{collapse}};
592   };
593
594   if (@collapse) {
595     my ($c) = sort { length $a <=> length $b } @collapse;
596     my $target = $info;
597     foreach my $p (split(/\./, $c)) {
598       $target = $target->[1]->{$p} ||= [];
599     }
600     my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c);
601     my @co_key = @{$self->{collapse}{$c_prefix}};
602     my %co_check = map { ($_, $target->[0]->{$_}); } @co_key;
603     my $tree = $self->_collapse_result($as, $row, $c_prefix);
604     my (@final, @raw);
605     while ( !(grep {
606                 !defined($tree->[0]->{$_}) ||
607                 $co_check{$_} ne $tree->[0]->{$_}
608               } @co_key) ) {
609       push(@final, $tree);
610       last unless (@raw = $self->cursor->next);
611       $row = $self->{stashed_row} = \@raw;
612       $tree = $self->_collapse_result($as, $row, $c_prefix);
613       #warn Data::Dumper::Dumper($tree, $row);
614     }
615     @$target = @final;
616   }
617
618   return $info;
619 }
620
621 =head2 result_source
622
623 =over 4
624
625 =item Arguments: $result_source?
626
627 =item Return Value: $result_source
628
629 =back
630
631 An accessor for the primary ResultSource object from which this ResultSet
632 is derived.
633
634 =cut
635
636
637 =head2 count
638
639 =over 4
640
641 =item Arguments: $cond, \%attrs??
642
643 =item Return Value: $count
644
645 =back
646
647 Performs an SQL C<COUNT> with the same query as the resultset was built
648 with to find the number of elements. If passed arguments, does a search
649 on the resultset and counts the results of that.
650
651 Note: When using C<count> with C<group_by>, L<DBIX::Class> emulates C<GROUP BY>
652 using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
653 not support C<DISTINCT> with multiple columns. If you are using such a
654 database, you should only use columns from the main table in your C<group_by>
655 clause.
656
657 =cut
658
659 sub count {
660   my $self = shift;
661   return $self->search(@_)->count if @_ and defined $_[0];
662   return scalar @{ $self->get_cache } if @{ $self->get_cache };
663
664   my $count = $self->_count;
665   return 0 unless $count;
666
667   $count -= $self->{attrs}{offset} if $self->{attrs}{offset};
668   $count = $self->{attrs}{rows} if
669     $self->{attrs}{rows} and $self->{attrs}{rows} < $count;
670   return $count;
671 }
672
673 sub _count { # Separated out so pager can get the full count
674   my $self = shift;
675   my $select = { count => '*' };
676   my $attrs = { %{ $self->{attrs} } };
677   if (my $group_by = delete $attrs->{group_by}) {
678     delete $attrs->{having};
679     my @distinct = (ref $group_by ?  @$group_by : ($group_by));
680     # todo: try CONCAT for multi-column pk
681     my @pk = $self->result_source->primary_columns;
682     if (@pk == 1) {
683       foreach my $column (@distinct) {
684         if ($column =~ qr/^(?:\Q$attrs->{alias}.\E)?$pk[0]$/) {
685           @distinct = ($column);
686           last;
687         }
688       }
689     }
690
691     $select = { count => { distinct => \@distinct } };
692     #use Data::Dumper; die Dumper $select;
693   }
694
695   $attrs->{select} = $select;
696   $attrs->{as} = [qw/count/];
697
698   # offset, order by and page are not needed to count. record_filter is cdbi
699   delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
700         
701   my ($count) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
702   return $count;
703 }
704
705 =head2 count_literal
706
707 =over 4
708
709 =item Arguments: $sql_fragment, @bind_values
710
711 =item Return Value: $count
712
713 =back
714
715 Counts the results in a literal query. Equivalent to calling L</search_literal>
716 with the passed arguments, then L</count>.
717
718 =cut
719
720 sub count_literal { shift->search_literal(@_)->count; }
721
722 =head2 all
723
724 =over 4
725
726 =item Arguments: none
727
728 =item Return Value: @objects
729
730 =back
731
732 Returns all elements in the resultset. Called implicitly if the resultset
733 is returned in list context.
734
735 =cut
736
737 sub all {
738   my ($self) = @_;
739   return @{ $self->get_cache } if @{ $self->get_cache };
740
741   my @obj;
742
743   if (keys %{$self->{collapse}}) {
744       # Using $self->cursor->all is really just an optimisation.
745       # If we're collapsing has_many prefetches it probably makes
746       # very little difference, and this is cleaner than hacking
747       # _construct_object to survive the approach
748     $self->cursor->reset;
749     my @row = $self->cursor->next;
750     while (@row) {
751       push(@obj, $self->_construct_object(@row));
752       @row = (exists $self->{stashed_row}
753                ? @{delete $self->{stashed_row}}
754                : $self->cursor->next);
755     }
756   } else {
757     @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
758   }
759
760   $self->set_cache(\@obj) if $self->{attrs}{cache};
761   return @obj;
762 }
763
764 =head2 reset
765
766 =over 4
767
768 =item Arguments: none
769
770 =item Return Value: $self
771
772 =back
773
774 Resets the resultset's cursor, so you can iterate through the elements again.
775
776 =cut
777
778 sub reset {
779   my ($self) = @_;
780   $self->{all_cache_position} = 0;
781   $self->cursor->reset;
782   return $self;
783 }
784
785 =head2 first
786
787 =over 4
788
789 =item Arguments: none
790
791 =item Return Value: $object?
792
793 =back
794
795 Resets the resultset and returns an object for the first result (if the
796 resultset returns anything).
797
798 =cut
799
800 sub first {
801   return $_[0]->reset->next;
802 }
803
804 =head2 update
805
806 =over 4
807
808 =item Arguments: \%values
809
810 =item Return Value: $storage_rv
811
812 =back
813
814 Sets the specified columns in the resultset to the supplied values in a
815 single query. Return value will be true if the update succeeded or false
816 if no records were updated; exact type of success value is storage-dependent.
817
818 =cut
819
820 sub update {
821   my ($self, $values) = @_;
822   $self->throw_exception("Values for update must be a hash")
823     unless ref $values eq 'HASH';
824   return $self->result_source->storage->update(
825     $self->result_source->from, $values, $self->{cond}
826   );
827 }
828
829 =head2 update_all
830
831 =over 4
832
833 =item Arguments: \%values
834
835 =item Return Value: 1
836
837 =back
838
839 Fetches all objects and updates them one at a time. Note that C<update_all>
840 will run DBIC cascade triggers, while L</update> will not.
841
842 =cut
843
844 sub update_all {
845   my ($self, $values) = @_;
846   $self->throw_exception("Values for update must be a hash")
847     unless ref $values eq 'HASH';
848   foreach my $obj ($self->all) {
849     $obj->set_columns($values)->update;
850   }
851   return 1;
852 }
853
854 =head2 delete
855
856 =over 4
857
858 =item Arguments: none
859
860 =item Return Value: 1
861
862 =back
863
864 Deletes the contents of the resultset from its result source. Note that this
865 will not run DBIC cascade triggers. See L</delete_all> if you need triggers
866 to run.
867
868 =cut
869
870 sub delete {
871   my ($self) = @_;
872   my $del = {};
873
874   if (!ref($self->{cond})) {
875
876     # No-op. No condition, we're deleting everything
877
878   } elsif (ref $self->{cond} eq 'ARRAY') {
879
880     $del = [ map { my %hash;
881       foreach my $key (keys %{$_}) {
882         $key =~ /([^.]+)$/;
883         $hash{$1} = $_->{$key};
884       }; \%hash; } @{$self->{cond}} ];
885
886   } elsif (ref $self->{cond} eq 'HASH') {
887
888     if ((keys %{$self->{cond}})[0] eq '-and') {
889
890       $del->{-and} = [ map { my %hash;
891         foreach my $key (keys %{$_}) {
892           $key =~ /([^.]+)$/;
893           $hash{$1} = $_->{$key};
894         }; \%hash; } @{$self->{cond}{-and}} ];
895
896     } else {
897
898       foreach my $key (keys %{$self->{cond}}) {
899         $key =~ /([^.]+)$/;
900         $del->{$1} = $self->{cond}{$key};
901       }
902     }
903
904   } else {
905     $self->throw_exception(
906       "Can't delete on resultset with condition unless hash or array"
907     );
908   }
909
910   $self->result_source->storage->delete($self->result_source->from, $del);
911   return 1;
912 }
913
914 =head2 delete_all
915
916 =over 4
917
918 =item Arguments: none
919
920 =item Return Value: 1
921
922 =back
923
924 Fetches all objects and deletes them one at a time. Note that C<delete_all>
925 will run DBIC cascade triggers, while L</delete> will not.
926
927 =cut
928
929 sub delete_all {
930   my ($self) = @_;
931   $_->delete for $self->all;
932   return 1;
933 }
934
935 =head2 pager
936
937 =over 4
938
939 =item Arguments: none
940
941 =item Return Value: $pager
942
943 =back
944
945 Return Value a L<Data::Page> object for the current resultset. Only makes
946 sense for queries with a C<page> attribute.
947
948 =cut
949
950 sub pager {
951   my ($self) = @_;
952   my $attrs = $self->{attrs};
953   $self->throw_exception("Can't create pager for non-paged rs")
954     unless $self->{page};
955   $attrs->{rows} ||= 10;
956   return $self->{pager} ||= Data::Page->new(
957     $self->_count, $attrs->{rows}, $self->{page});
958 }
959
960 =head2 page
961
962 =over 4
963
964 =item Arguments: $page_number
965
966 =item Return Value: $rs
967
968 =back
969
970 Returns a resultset for the $page_number page of the resultset on which page
971 is called, where each page contains a number of rows equal to the 'rows'
972 attribute set on the resultset (10 by default).
973
974 =cut
975
976 sub page {
977   my ($self, $page) = @_;
978   my $attrs = { %{$self->{attrs}} };
979   $attrs->{page} = $page;
980   return (ref $self)->new($self->result_source, $attrs);
981 }
982
983 =head2 new_result
984
985 =over 4
986
987 =item Arguments: \%vals
988
989 =item Return Value: $object
990
991 =back
992
993 Creates an object in the resultset's result class and returns it.
994
995 =cut
996
997 sub new_result {
998   my ($self, $values) = @_;
999   $self->throw_exception( "new_result needs a hash" )
1000     unless (ref $values eq 'HASH');
1001   $self->throw_exception(
1002     "Can't abstract implicit construct, condition not a hash"
1003   ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
1004   my %new = %$values;
1005   my $alias = $self->{attrs}{alias};
1006   foreach my $key (keys %{$self->{cond}||{}}) {
1007     $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:\Q${alias}.\E)?([^.]+)$/);
1008   }
1009   my $obj = $self->result_class->new(\%new);
1010   $obj->result_source($self->result_source) if $obj->can('result_source');
1011   return $obj;
1012 }
1013
1014 =head2 create
1015
1016 =over 4
1017
1018 =item Arguments: \%vals
1019
1020 =item Return Value: $object
1021
1022 =back
1023
1024 Inserts a record into the resultset and returns the object representing it.
1025
1026 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
1027
1028 =cut
1029
1030 sub create {
1031   my ($self, $attrs) = @_;
1032   $self->throw_exception( "create needs a hashref" )
1033     unless ref $attrs eq 'HASH';
1034   return $self->new_result($attrs)->insert;
1035 }
1036
1037 =head2 find_or_create
1038
1039 =over 4
1040
1041 =item Arguments: \%vals, \%attrs?
1042
1043 =item Return Value: $object
1044
1045 =back
1046
1047   $class->find_or_create({ key => $val, ... });
1048
1049 Searches for a record matching the search condition; if it doesn't find one,
1050 creates one and returns that instead.
1051
1052   my $cd = $schema->resultset('CD')->find_or_create({
1053     cdid   => 5,
1054     artist => 'Massive Attack',
1055     title  => 'Mezzanine',
1056     year   => 2005,
1057   });
1058
1059 Also takes an optional C<key> attribute, to search by a specific key or unique
1060 constraint. For example:
1061
1062   my $cd = $schema->resultset('CD')->find_or_create(
1063     {
1064       artist => 'Massive Attack',
1065       title  => 'Mezzanine',
1066     },
1067     { key => 'artist_title' }
1068   );
1069
1070 See also L</find> and L</update_or_create>.
1071
1072 =cut
1073
1074 sub find_or_create {
1075   my $self     = shift;
1076   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1077   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
1078   my $exists   = $self->find($hash, $attrs);
1079   return defined $exists ? $exists : $self->create($hash);
1080 }
1081
1082 =head2 update_or_create
1083
1084 =over 4
1085
1086 =item Arguments: \%col_values, { key => $unique_constraint }?
1087
1088 =item Return Value: $object
1089
1090 =back
1091
1092   $class->update_or_create({ col => $val, ... });
1093
1094 First, searches for an existing row matching one of the unique constraints
1095 (including the primary key) on the source of this resultset. If a row is
1096 found, updates it with the other given column values. Otherwise, creates a new
1097 row.
1098
1099 Takes an optional C<key> attribute to search on a specific unique constraint.
1100 For example:
1101
1102   # In your application
1103   my $cd = $schema->resultset('CD')->update_or_create(
1104     {
1105       artist => 'Massive Attack',
1106       title  => 'Mezzanine',
1107       year   => 1998,
1108     },
1109     { key => 'artist_title' }
1110   );
1111
1112 If no C<key> is specified, it searches on all unique constraints defined on the
1113 source, including the primary key.
1114
1115 If the C<key> is specified as C<primary>, it searches only on the primary key.
1116
1117 See also L</find> and L</find_or_create>.
1118
1119 =cut
1120
1121 sub update_or_create {
1122   my $self = shift;
1123   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1124   my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
1125
1126   my %unique_constraints = $self->result_source->unique_constraints;
1127   my @constraint_names   = (exists $attrs->{key}
1128                             ? ($attrs->{key})
1129                             : keys %unique_constraints);
1130
1131   my @unique_hashes;
1132   foreach my $name (@constraint_names) {
1133     my @unique_cols = @{ $unique_constraints{$name} };
1134     my %unique_hash =
1135       map  { $_ => $hash->{$_} }
1136       grep { exists $hash->{$_} }
1137       @unique_cols;
1138
1139     push @unique_hashes, \%unique_hash
1140       if (scalar keys %unique_hash == scalar @unique_cols);
1141   }
1142
1143   if (@unique_hashes) {
1144     my $row = $self->single(\@unique_hashes);
1145     if (defined $row) {
1146       $row->set_columns($hash);
1147       $row->update;
1148       return $row;
1149     }
1150   }
1151
1152   return $self->create($hash);
1153 }
1154
1155 =head2 get_cache
1156
1157 =over 4
1158
1159 =item Arguments: none
1160
1161 =item Return Value: \@cache_objects?
1162
1163 =back
1164
1165 Gets the contents of the cache for the resultset, if the cache is set.
1166
1167 =cut
1168
1169 sub get_cache {
1170   shift->{all_cache} || [];
1171 }
1172
1173 =head2 set_cache
1174
1175 =over 4
1176
1177 =item Arguments: \@cache_objects
1178
1179 =item Return Value: \@cache_objects
1180
1181 =back
1182
1183 Sets the contents of the cache for the resultset. Expects an arrayref
1184 of objects of the same class as those produced by the resultset. Note that
1185 if the cache is set the resultset will return the cached objects rather
1186 than re-querying the database even if the cache attr is not set.
1187
1188 =cut
1189
1190 sub set_cache {
1191   my ( $self, $data ) = @_;
1192   $self->throw_exception("set_cache requires an arrayref")
1193     if ref $data ne 'ARRAY';
1194   my $result_class = $self->result_class;
1195   foreach( @$data ) {
1196     $self->throw_exception(
1197       "cannot cache object of type '$_', expected '$result_class'"
1198     ) if ref $_ ne $result_class;
1199   }
1200   $self->{all_cache} = $data;
1201 }
1202
1203 =head2 clear_cache
1204
1205 =over 4
1206
1207 =item Arguments: none
1208
1209 =item Return Value: []
1210
1211 =back
1212
1213 Clears the cache for the resultset.
1214
1215 =cut
1216
1217 sub clear_cache {
1218   shift->set_cache([]);
1219 }
1220
1221 =head2 related_resultset
1222
1223 =over 4
1224
1225 =item Arguments: $relationship_name
1226
1227 =item Return Value: $resultset
1228
1229 =back
1230
1231 Returns a related resultset for the supplied relationship name.
1232
1233   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
1234
1235 =cut
1236
1237 sub related_resultset {
1238   my ( $self, $rel ) = @_;
1239   $self->{related_resultsets} ||= {};
1240   return $self->{related_resultsets}{$rel} ||= do {
1241       #warn "fetching related resultset for rel '$rel'";
1242       my $rel_obj = $self->result_source->relationship_info($rel);
1243       $self->throw_exception(
1244         "search_related: result source '" . $self->result_source->name .
1245         "' has no such relationship ${rel}")
1246         unless $rel_obj; #die Dumper $self->{attrs};
1247
1248       my $rs = $self->search(undef, { join => $rel });
1249       my $alias = defined $rs->{attrs}{seen_join}{$rel}
1250                     && $rs->{attrs}{seen_join}{$rel} > 1
1251                   ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
1252                   : $rel;
1253
1254       $self->result_source->schema->resultset($rel_obj->{class}
1255            )->search( undef,
1256              { %{$rs->{attrs}},
1257                alias => $alias,
1258                select => undef,
1259                as => undef }
1260            );
1261   };
1262 }
1263
1264 =head2 throw_exception
1265
1266 See L<DBIx::Class::Schema/throw_exception> for details.
1267
1268 =cut
1269
1270 sub throw_exception {
1271   my $self=shift;
1272   $self->result_source->schema->throw_exception(@_);
1273 }
1274
1275 # XXX: FIXME: Attributes docs need clearing up
1276
1277 =head1 ATTRIBUTES
1278
1279 The resultset takes various attributes that modify its behavior. Here's an
1280 overview of them:
1281
1282 =head2 order_by
1283
1284 =over 4
1285
1286 =item Value: ($order_by | \@order_by)
1287
1288 =back
1289
1290 Which column(s) to order the results by. This is currently passed
1291 through directly to SQL, so you can give e.g. C<year DESC> for a
1292 descending order on the column `year'.
1293
1294 =head2 columns
1295
1296 =over 4
1297
1298 =item Value: \@columns
1299
1300 =back
1301
1302 Shortcut to request a particular set of columns to be retrieved.  Adds
1303 C<me.> onto the start of any column without a C<.> in it and sets C<select>
1304 from that, then auto-populates C<as> from C<select> as normal. (You may also
1305 use the C<cols> attribute, as in earlier versions of DBIC.)
1306
1307 =head2 include_columns
1308
1309 =over 4
1310
1311 =item Value: \@columns
1312
1313 =back
1314
1315 Shortcut to include additional columns in the returned results - for example
1316
1317   $schema->resultset('CD')->search(undef, {
1318     include_columns => ['artist.name'],
1319     join => ['artist']
1320   });
1321
1322 would return all CDs and include a 'name' column to the information
1323 passed to object inflation
1324
1325 =head2 select
1326
1327 =over 4
1328
1329 =item Value: \@select_columns
1330
1331 =back
1332
1333 Indicates which columns should be selected from the storage. You can use
1334 column names, or in the case of RDBMS back ends, function or stored procedure
1335 names:
1336
1337   $rs = $schema->resultset('Employee')->search(undef, {
1338     select => [
1339       'name',
1340       { count => 'employeeid' },
1341       { sum => 'salary' }
1342     ]
1343   });
1344
1345 When you use function/stored procedure names and do not supply an C<as>
1346 attribute, the column names returned are storage-dependent. E.g. MySQL would
1347 return a column named C<count(employeeid)> in the above example.
1348
1349 =head2 as
1350
1351 =over 4
1352
1353 =item Value: \@inflation_names
1354
1355 =back
1356
1357 Indicates column names for object inflation. This is used in conjunction with
1358 C<select>, usually when C<select> contains one or more function or stored
1359 procedure names:
1360
1361   $rs = $schema->resultset('Employee')->search(undef, {
1362     select => [
1363       'name',
1364       { count => 'employeeid' }
1365     ],
1366     as => ['name', 'employee_count'],
1367   });
1368
1369   my $employee = $rs->first(); # get the first Employee
1370
1371 If the object against which the search is performed already has an accessor
1372 matching a column name specified in C<as>, the value can be retrieved using
1373 the accessor as normal:
1374
1375   my $name = $employee->name();
1376
1377 If on the other hand an accessor does not exist in the object, you need to
1378 use C<get_column> instead:
1379
1380   my $employee_count = $employee->get_column('employee_count');
1381
1382 You can create your own accessors if required - see
1383 L<DBIx::Class::Manual::Cookbook> for details.
1384
1385 =head2 join
1386
1387 =over 4
1388
1389 =item Value: ($rel_name | \@rel_names | \%rel_names)
1390
1391 =back
1392
1393 Contains a list of relationships that should be joined for this query.  For
1394 example:
1395
1396   # Get CDs by Nine Inch Nails
1397   my $rs = $schema->resultset('CD')->search(
1398     { 'artist.name' => 'Nine Inch Nails' },
1399     { join => 'artist' }
1400   );
1401
1402 Can also contain a hash reference to refer to the other relation's relations.
1403 For example:
1404
1405   package MyApp::Schema::Track;
1406   use base qw/DBIx::Class/;
1407   __PACKAGE__->table('track');
1408   __PACKAGE__->add_columns(qw/trackid cd position title/);
1409   __PACKAGE__->set_primary_key('trackid');
1410   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
1411   1;
1412
1413   # In your application
1414   my $rs = $schema->resultset('Artist')->search(
1415     { 'track.title' => 'Teardrop' },
1416     {
1417       join     => { cd => 'track' },
1418       order_by => 'artist.name',
1419     }
1420   );
1421
1422 If the same join is supplied twice, it will be aliased to <rel>_2 (and
1423 similarly for a third time). For e.g.
1424
1425   my $rs = $schema->resultset('Artist')->search({
1426     'cds.title'   => 'Down to Earth',
1427     'cds_2.title' => 'Popular',
1428   }, {
1429     join => [ qw/cds cds/ ],
1430   });
1431
1432 will return a set of all artists that have both a cd with title 'Down
1433 to Earth' and a cd with title 'Popular'.
1434
1435 If you want to fetch related objects from other tables as well, see C<prefetch>
1436 below.
1437
1438 =head2 prefetch
1439
1440 =over 4
1441
1442 =item Value: ($rel_name | \@rel_names | \%rel_names)
1443
1444 =back
1445
1446 Contains one or more relationships that should be fetched along with the main
1447 query (when they are accessed afterwards they will have already been
1448 "prefetched").  This is useful for when you know you will need the related
1449 objects, because it saves at least one query:
1450
1451   my $rs = $schema->resultset('Tag')->search(
1452     undef,
1453     {
1454       prefetch => {
1455         cd => 'artist'
1456       }
1457     }
1458   );
1459
1460 The initial search results in SQL like the following:
1461
1462   SELECT tag.*, cd.*, artist.* FROM tag
1463   JOIN cd ON tag.cd = cd.cdid
1464   JOIN artist ON cd.artist = artist.artistid
1465
1466 L<DBIx::Class> has no need to go back to the database when we access the
1467 C<cd> or C<artist> relationships, which saves us two SQL statements in this
1468 case.
1469
1470 Simple prefetches will be joined automatically, so there is no need
1471 for a C<join> attribute in the above search. If you're prefetching to
1472 depth (e.g. { cd => { artist => 'label' } or similar), you'll need to
1473 specify the join as well.
1474
1475 C<prefetch> can be used with the following relationship types: C<belongs_to>,
1476 C<has_one> (or if you're using C<add_relationship>, any relationship declared
1477 with an accessor type of 'single' or 'filter').
1478
1479 =head2 from
1480
1481 =over 4
1482
1483 =item Value: \@from_clause
1484
1485 =back
1486
1487 The C<from> attribute gives you manual control over the C<FROM> clause of SQL
1488 statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
1489 clauses.
1490
1491 NOTE: Use this on your own risk.  This allows you to shoot off your foot!
1492 C<join> will usually do what you need and it is strongly recommended that you
1493 avoid using C<from> unless you cannot achieve the desired result using C<join>.
1494
1495 In simple terms, C<from> works as follows:
1496
1497     [
1498         { <alias> => <table>, -join_type => 'inner|left|right' }
1499         [] # nested JOIN (optional)
1500         { <table.column> => <foreign_table.foreign_key> }
1501     ]
1502
1503     JOIN
1504         <alias> <table>
1505         [JOIN ...]
1506     ON <table.column> = <foreign_table.foreign_key>
1507
1508 An easy way to follow the examples below is to remember the following:
1509
1510     Anything inside "[]" is a JOIN
1511     Anything inside "{}" is a condition for the enclosing JOIN
1512
1513 The following examples utilize a "person" table in a family tree application.
1514 In order to express parent->child relationships, this table is self-joined:
1515
1516     # Person->belongs_to('father' => 'Person');
1517     # Person->belongs_to('mother' => 'Person');
1518
1519 C<from> can be used to nest joins. Here we return all children with a father,
1520 then search against all mothers of those children:
1521
1522   $rs = $schema->resultset('Person')->search(
1523       undef,
1524       {
1525           alias => 'mother', # alias columns in accordance with "from"
1526           from => [
1527               { mother => 'person' },
1528               [
1529                   [
1530                       { child => 'person' },
1531                       [
1532                           { father => 'person' },
1533                           { 'father.person_id' => 'child.father_id' }
1534                       ]
1535                   ],
1536                   { 'mother.person_id' => 'child.mother_id' }
1537               ],
1538           ]
1539       },
1540   );
1541
1542   # Equivalent SQL:
1543   # SELECT mother.* FROM person mother
1544   # JOIN (
1545   #   person child
1546   #   JOIN person father
1547   #   ON ( father.person_id = child.father_id )
1548   # )
1549   # ON ( mother.person_id = child.mother_id )
1550
1551 The type of any join can be controlled manually. To search against only people
1552 with a father in the person table, we could explicitly use C<INNER JOIN>:
1553
1554     $rs = $schema->resultset('Person')->search(
1555         undef,
1556         {
1557             alias => 'child', # alias columns in accordance with "from"
1558             from => [
1559                 { child => 'person' },
1560                 [
1561                     { father => 'person', -join_type => 'inner' },
1562                     { 'father.id' => 'child.father_id' }
1563                 ],
1564             ]
1565         },
1566     );
1567
1568     # Equivalent SQL:
1569     # SELECT child.* FROM person child
1570     # INNER JOIN person father ON child.father_id = father.id
1571
1572 =head2 page
1573
1574 =over 4
1575
1576 =item Value: $page
1577
1578 =back
1579
1580 Makes the resultset paged and specifies the page to retrieve. Effectively
1581 identical to creating a non-pages resultset and then calling ->page($page)
1582 on it.
1583
1584 =head2 rows
1585
1586 =over 4
1587
1588 =item Value: $rows
1589
1590 =back
1591
1592 Specifes the maximum number of rows for direct retrieval or the number of
1593 rows per page if the page attribute or method is used.
1594
1595 =head2 group_by
1596
1597 =over 4
1598
1599 =item Value: \@columns
1600
1601 =back
1602
1603 A arrayref of columns to group by. Can include columns of joined tables.
1604
1605   group_by => [qw/ column1 column2 ... /]
1606
1607 =head2 distinct
1608
1609 =over 4
1610
1611 =item Value: (0 | 1)
1612
1613 =back
1614
1615 Set to 1 to group by all columns.
1616
1617 =head2 cache
1618
1619 Set to 1 to cache search results. This prevents extra SQL queries if you
1620 revisit rows in your ResultSet:
1621
1622   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
1623   
1624   while( my $artist = $resultset->next ) {
1625     ... do stuff ...
1626   }
1627
1628   $rs->first; # without cache, this would issue a query
1629
1630 By default, searches are not cached.
1631
1632 For more examples of using these attributes, see
1633 L<DBIx::Class::Manual::Cookbook>.
1634
1635 =cut
1636
1637 1;