Chucked out some unrequired column case stuff in CDBICompat
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / ResultSet.pm
CommitLineData
89c0a5a2 1package DBIx::Class::ResultSet;
2
3use strict;
4use warnings;
5use overload
6 '0+' => 'count',
7 fallback => 1;
3c5b25c5 8use Data::Page;
ea20d0fd 9use Storable;
89c0a5a2 10
ee38fa40 11=head1 NAME
12
bfab575a 13DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
ee38fa40 14
bfab575a 15=head1 SYNOPSIS
ee38fa40 16
bfab575a 17my $rs = MyApp::DB::Class->search(registered => 1);
18my @rows = MyApp::DB::Class->search(foo => 'bar');
ee38fa40 19
20=head1 DESCRIPTION
21
bfab575a 22The resultset is also known as an iterator. It is responsible for handling
23queries that may return an arbitrary number of rows, e.g. via C<search>
24or a C<has_many> relationship.
ee38fa40 25
26=head1 METHODS
27
976f3686 28=head2 new($source, \%$attrs)
ee38fa40 29
976f3686 30The resultset constructor. Takes a source object (usually a DBIx::Class::Table)
31and an attribute hash (see below for more information on attributes). Does
32not perform any queries -- these are executed as needed by the other methods.
ee38fa40 33
34=cut
35
89c0a5a2 36sub new {
fea3d045 37 my $class = shift;
38 $class->new_result(@_) if ref $class;
39 my ($source, $attrs) = @_;
89c0a5a2 40 #use Data::Dumper; warn Dumper(@_);
ea20d0fd 41 $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
c7ce65e6 42 my %seen;
6aeb9185 43 my $alias = ($attrs->{alias} ||= 'me');
976f3686 44 if (!$attrs->{select}) {
45 my @cols = ($attrs->{cols}
46 ? @{delete $attrs->{cols}}
47 : $source->result_class->_select_columns);
6aeb9185 48 $attrs->{select} = [ map { m/\./ ? $_ : "${alias}.$_" } @cols ];
976f3686 49 }
6aeb9185 50 $attrs->{as} ||= [ map { m/^$alias\.(.*)$/ ? $1 : $_ } @{$attrs->{select}} ];
976f3686 51 #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
fea3d045 52 $attrs->{from} ||= [ { $alias => $source->from } ];
b52e9bf8 53 if (my $join = delete $attrs->{join}) {
54 foreach my $j (ref $join eq 'ARRAY'
55 ? (@{$join}) : ($join)) {
c7ce65e6 56 if (ref $j eq 'HASH') {
57 $seen{$_} = 1 foreach keys %$j;
58 } else {
59 $seen{$j} = 1;
60 }
61 }
6aeb9185 62 push(@{$attrs->{from}}, $source->result_class->_resolve_join($join, $attrs->{alias}));
c7ce65e6 63 }
54540863 64 $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
b52e9bf8 65 foreach my $pre (@{delete $attrs->{prefetch} || []}) {
6aeb9185 66 push(@{$attrs->{from}}, $source->result_class->_resolve_join($pre, $attrs->{alias}))
c7ce65e6 67 unless $seen{$pre};
976f3686 68 my @pre =
c7ce65e6 69 map { "$pre.$_" }
4685e006 70 $source->result_class->relationship_info($pre)->{class}->columns;
976f3686 71 push(@{$attrs->{select}}, @pre);
72 push(@{$attrs->{as}}, @pre);
fef5d100 73 }
6aeb9185 74 if ($attrs->{page}) {
75 $attrs->{rows} ||= 10;
76 $attrs->{offset} ||= 0;
77 $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
78 }
89c0a5a2 79 my $new = {
cda04c3a 80 source => $source,
89c0a5a2 81 cond => $attrs->{where},
0a3c5b43 82 from => $attrs->{from},
3c5b25c5 83 count => undef,
93b004d3 84 page => delete $attrs->{page},
3c5b25c5 85 pager => undef,
89c0a5a2 86 attrs => $attrs };
2f5911b2 87 bless ($new, $class);
9229f20a 88 return $new;
89c0a5a2 89}
90
bfab575a 91=head2 search
0a3c5b43 92
6009260a 93 my @obj = $rs->search({ foo => 3 }); # "... WHERE foo = 3"
94 my $new_rs = $rs->search({ foo => 3 });
95
96If you need to pass in additional attributes but no additional condition,
97call it as ->search(undef, \%attrs);
98
99 my @all = $class->search({}, { cols => [qw/foo bar/] }); # "SELECT foo, bar FROM $class_table"
0a3c5b43 100
101=cut
102
103sub search {
104 my $self = shift;
105
6009260a 106 #use Data::Dumper;warn Dumper(@_);
107
0a3c5b43 108 my $attrs = { %{$self->{attrs}} };
109 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
6aeb9185 110 $attrs = { %$attrs, %{ pop(@_) } };
0a3c5b43 111 }
112
6aeb9185 113 my $where = (@_ ? ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_}) : undef());
0a3c5b43 114 if (defined $where) {
115 $where = (defined $attrs->{where}
116 ? { '-and' => [ $where, $attrs->{where} ] }
117 : $where);
118 $attrs->{where} = $where;
119 }
120
fea3d045 121 my $rs = (ref $self)->new($self->{source}, $attrs);
0a3c5b43 122
123 return (wantarray ? $rs->all : $rs);
124}
125
bfab575a 126=head2 search_literal
6009260a 127 my @obj = $rs->search_literal($literal_where_cond, @bind);
128 my $new_rs = $rs->search_literal($literal_where_cond, @bind);
129
130Pass a literal chunk of SQL to be added to the conditional part of the
131resultset
132
bfab575a 133=cut
134
6009260a 135sub search_literal {
136 my ($self, $cond, @vals) = @_;
137 my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
138 $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ];
139 return $self->search(\$cond, $attrs);
140}
0a3c5b43 141
716b3d29 142=head2 find(@colvalues), find(\%cols)
143
144Finds a row based on its primary key(s).
145
146=cut
147
148sub find {
149 my ($self, @vals) = @_;
150 my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
151 my @pk = $self->{source}->primary_columns;
152 #use Data::Dumper; warn Dumper($attrs, @vals, @pk);
153 $self->{source}->result_class->throw( "Can't find unless primary columns are defined" )
154 unless @pk;
155 my $query;
156 if (ref $vals[0] eq 'HASH') {
157 $query = $vals[0];
158 } elsif (@pk == @vals) {
159 $query = {};
160 @{$query}{@pk} = @vals;
161 } else {
162 $query = {@vals};
163 }
164 #warn Dumper($query);
165 # Useless -> disabled
166 #$self->{source}->result_class->throw( "Can't find unless all primary keys are specified" )
167 # unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
168 # column names etc. Not sure what to do yet
169 return $self->search($query)->next;
170}
171
b52e9bf8 172=head2 search_related
173
174 $rs->search_related('relname', $cond?, $attrs?);
175
176=cut
177
6aeb9185 178sub search_related {
179 my ($self, $rel, @rest) = @_;
4685e006 180 my $rel_obj = $self->{source}->result_class->relationship_info($rel);
6aeb9185 181 $self->{source}->result_class->throw(
182 "No such relationship ${rel} in search_related")
183 unless $rel_obj;
6aeb9185 184 my $rs = $self->search(undef, { join => $rel });
ea20d0fd 185 return $self->{source}->schema->resultset($rel_obj->{class}
186 )->search( undef,
187 { %{$rs->{attrs}},
188 alias => $rel,
189 select => undef(),
190 as => undef() }
6aeb9185 191 )->search(@rest);
192}
b52e9bf8 193
bfab575a 194=head2 cursor
ee38fa40 195
bfab575a 196Returns a storage-driven cursor to the given resultset.
ee38fa40 197
198=cut
199
73f58123 200sub cursor {
201 my ($self) = @_;
2f5911b2 202 my ($source, $attrs) = @{$self}{qw/source attrs/};
6aeb9185 203 $attrs = { %$attrs };
73f58123 204 return $self->{cursor}
976f3686 205 ||= $source->storage->select($self->{from}, $attrs->{select},
73f58123 206 $attrs->{where},$attrs);
207}
208
bfab575a 209=head2 search_like
58a4bd18 210
211Identical to search except defaults to 'LIKE' instead of '=' in condition
212
213=cut
214
215sub search_like {
216 my $class = shift;
217 my $attrs = { };
218 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
219 $attrs = pop(@_);
220 }
221 my $query = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
222 $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
223 return $class->search($query, { %$attrs });
224}
225
bfab575a 226=head2 slice($first, $last)
ee38fa40 227
bfab575a 228Returns a subset of elements from the resultset.
ee38fa40 229
230=cut
231
89c0a5a2 232sub slice {
233 my ($self, $min, $max) = @_;
234 my $attrs = { %{ $self->{attrs} || {} } };
6aeb9185 235 $attrs->{offset} ||= 0;
236 $attrs->{offset} += $min;
89c0a5a2 237 $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
fea3d045 238 my $slice = (ref $self)->new($self->{source}, $attrs);
89c0a5a2 239 return (wantarray ? $slice->all : $slice);
240}
241
bfab575a 242=head2 next
ee38fa40 243
bfab575a 244Returns the next element in the resultset (undef is there is none).
ee38fa40 245
246=cut
247
89c0a5a2 248sub next {
249 my ($self) = @_;
73f58123 250 my @row = $self->cursor->next;
89c0a5a2 251 return unless (@row);
c7ce65e6 252 return $self->_construct_object(@row);
253}
254
255sub _construct_object {
256 my ($self, @row) = @_;
976f3686 257 my @cols = @{ $self->{attrs}{as} };
258 #warn "@cols -> @row";
b52e9bf8 259 my (%me, %pre);
260 foreach my $col (@cols) {
261 if ($col =~ /([^\.]+)\.([^\.]+)/) {
6aeb9185 262 $pre{$1}[0]{$2} = shift @row;
b52e9bf8 263 } else {
264 $me{$col} = shift @row;
c7ce65e6 265 }
c7ce65e6 266 }
b52e9bf8 267 my $new = $self->{source}->result_class->inflate_result(\%me, \%pre);
33ce49d6 268 $new = $self->{attrs}{record_filter}->($new)
269 if exists $self->{attrs}{record_filter};
270 return $new;
89c0a5a2 271}
272
bfab575a 273=head2 count
ee38fa40 274
bfab575a 275Performs an SQL C<COUNT> with the same query as the resultset was built
6009260a 276with to find the number of elements. If passed arguments, does a search
277on the resultset and counts the results of that.
ee38fa40 278
279=cut
280
89c0a5a2 281sub count {
6009260a 282 my $self = shift;
283 return $self->search(@_)->count if @_ && defined $_[0];
54540863 284 die "Unable to ->count with a GROUP BY" if defined $self->{attrs}{group_by};
6aeb9185 285 unless (defined $self->{count}) {
976f3686 286 my $attrs = { %{ $self->{attrs} },
54540863 287 select => { 'count' => '*' },
288 as => [ 'count' ] };
ea20d0fd 289 # offset, order by and page are not needed to count. record_filter is cdbi
290 delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
3c5b25c5 291
fea3d045 292 ($self->{count}) = (ref $self)->new($self->{source}, $attrs)->cursor->next;
3c5b25c5 293 }
294 return 0 unless $self->{count};
6aeb9185 295 my $count = $self->{count};
296 $count -= $self->{attrs}{offset} if $self->{attrs}{offset};
297 $count = $self->{attrs}{rows} if
298 ($self->{attrs}{rows} && $self->{attrs}{rows} < $count);
299 return $count;
89c0a5a2 300}
301
bfab575a 302=head2 count_literal
6009260a 303
bfab575a 304Calls search_literal with the passed arguments, then count.
6009260a 305
306=cut
307
308sub count_literal { shift->search_literal(@_)->count; }
309
bfab575a 310=head2 all
ee38fa40 311
bfab575a 312Returns all elements in the resultset. Called implictly if the resultset
313is returned in list context.
ee38fa40 314
315=cut
316
89c0a5a2 317sub all {
318 my ($self) = @_;
c7ce65e6 319 return map { $self->_construct_object(@$_); }
73f58123 320 $self->cursor->all;
89c0a5a2 321}
322
bfab575a 323=head2 reset
ee38fa40 324
bfab575a 325Resets the resultset's cursor, so you can iterate through the elements again.
ee38fa40 326
327=cut
328
89c0a5a2 329sub reset {
330 my ($self) = @_;
73f58123 331 $self->cursor->reset;
89c0a5a2 332 return $self;
333}
334
bfab575a 335=head2 first
ee38fa40 336
bfab575a 337Resets the resultset and returns the first element.
ee38fa40 338
339=cut
340
89c0a5a2 341sub first {
342 return $_[0]->reset->next;
343}
344
bfab575a 345=head2 delete
ee38fa40 346
38659261 347Deletes all elements in the resultset.
ee38fa40 348
349=cut
350
28927b50 351sub delete {
89c0a5a2 352 my ($self) = @_;
353 $_->delete for $self->all;
354 return 1;
355}
356
28927b50 357*delete_all = \&delete; # Yeah, yeah, yeah ...
358
bfab575a 359=head2 pager
ee38fa40 360
361Returns a L<Data::Page> object for the current resultset. Only makes
362sense for queries with page turned on.
363
364=cut
365
3c5b25c5 366sub pager {
367 my ($self) = @_;
368 my $attrs = $self->{attrs};
93b004d3 369 die "Can't create pager for non-paged rs" unless $self->{page};
6aeb9185 370 $attrs->{rows} ||= 10;
371 $self->count;
372 return $self->{pager} ||= Data::Page->new(
93b004d3 373 $self->{count}, $attrs->{rows}, $self->{page});
3c5b25c5 374}
375
bfab575a 376=head2 page($page_num)
ee38fa40 377
bfab575a 378Returns a new resultset for the specified page.
ee38fa40 379
380=cut
381
3c5b25c5 382sub page {
383 my ($self, $page) = @_;
6aeb9185 384 my $attrs = { %{$self->{attrs}} };
3c5b25c5 385 $attrs->{page} = $page;
fea3d045 386 return (ref $self)->new($self->{source}, $attrs);
387}
388
389=head2 new_result(\%vals)
390
391Creates a result in the resultset's result class
392
393=cut
394
395sub new_result {
396 my ($self, $values) = @_;
397 $self->{source}->result_class->throw( "new_result needs a hash" )
398 unless (ref $values eq 'HASH');
399 $self->{source}->result_class->throw( "Can't abstract implicit construct, condition not a hash" )
400 if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
401 my %new = %$values;
402 my $alias = $self->{attrs}{alias};
403 foreach my $key (keys %{$self->{cond}||{}}) {
404 $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:$alias\.)?([^\.]+)$/);
405 }
406 return $self->{source}->result_class->new(\%new);
407}
408
409=head2 create(\%vals)
410
411Inserts a record into the resultset and returns the object
412
413Effectively a shortcut for ->new_result(\%vals)->insert
414
415=cut
416
417sub create {
418 my ($self, $attrs) = @_;
419 $self->{source}->result_class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
420 return $self->new_result($attrs)->insert;
3c5b25c5 421}
422
c2b15ecc 423=head2 find_or_create(\%vals)
424
425 $class->find_or_create({ key => $val, ... });
426
427Searches for a record matching the search condition; if it doesn't find one,
428creates one and returns that instead.
429
430=cut
431
432sub find_or_create {
433 my $self = shift;
434 my $hash = ref $_[0] eq "HASH" ? shift: {@_};
435 my $exists = $self->find($hash);
436 return defined($exists) ? $exists : $self->create($hash);
437}
438
40dbc108 439=head1 ATTRIBUTES
076652e8 440
bfab575a 441The resultset takes various attributes that modify its behavior.
442Here's an overview of them:
443
444=head2 order_by
076652e8 445
bfab575a 446Which column(s) to order the results by. This is currently passed
447through directly to SQL, so you can give e.g. C<foo DESC> for a
448descending order.
076652e8 449
976f3686 450=head2 cols (arrayref)
451
452Shortcut to request a particular set of columns to be retrieved - adds
453'me.' onto the start of any column without a '.' in it and sets 'select'
454from that, then auto-populates 'as' from 'select' as normal
455
456=head2 select (arrayref)
457
458Indicates which columns should be selected from the storage
459
460=head2 as (arrayref)
076652e8 461
976f3686 462Indicates column names for object inflation
ee38fa40 463
bfab575a 464=head2 join
ee38fa40 465
bfab575a 466Contains a list of relationships that should be joined for this query. Can also
467contain a hash reference to refer to that relation's relations. So, if one column
468in your class C<belongs_to> foo and another C<belongs_to> bar, you can do
469C<< join => [qw/ foo bar /] >> to join both (and e.g. use them for C<order_by>).
470If a foo contains many margles and you want to join those too, you can do
471C<< join => { foo => 'margle' } >>. If you want to fetch the columns from the
472related table as well, see C<prefetch> below.
ee38fa40 473
bfab575a 474=head2 prefetch
ee38fa40 475
bfab575a 476Contains a list of relationships that should be fetched along with the main
477query (when they are accessed afterwards they will have already been
478"prefetched"). This is useful for when you know you will need the related
479object(s), because it saves a query. Currently limited to prefetching
480one relationship deep, so unlike C<join>, prefetch must be an arrayref.
ee38fa40 481
bfab575a 482=head2 from
ee38fa40 483
bfab575a 484This attribute can contain a arrayref of elements. Each element can be another
ee38fa40 485arrayref, to nest joins, or it can be a hash which represents the two sides
486of the join.
487
bfab575a 488NOTE: Use this on your own risk. This allows you to shoot your foot off!
ee38fa40 489
bfab575a 490=head2 page
076652e8 491
bfab575a 492For a paged resultset, specifies which page to retrieve. Leave unset
493for an unpaged resultset.
076652e8 494
bfab575a 495=head2 rows
076652e8 496
bfab575a 497For a paged resultset, how many rows per page
076652e8 498
54540863 499=head2 group_by
500
501A list of columns to group by (note that 'count' doesn't work on grouped
502resultsets)
503
504=head2 distinct
505
506Set to 1 to group by all columns
507
bfab575a 508=cut
076652e8 509
89c0a5a2 5101;