Subqueries no longer experimental
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSetColumn.pm
1 package DBIx::Class::ResultSetColumn;
2
3 use strict;
4 use warnings;
5
6 use base 'DBIx::Class';
7
8 use Carp::Clan qw/^DBIx::Class/;
9 use DBIx::Class::Exception;
10 use List::Util;
11
12 =head1 NAME
13
14   DBIx::Class::ResultSetColumn - helpful methods for messing
15   with a single column of the resultset
16
17 =head1 SYNOPSIS
18
19   $rs = $schema->resultset('CD')->search({ artist => 'Tool' });
20   $rs_column = $rs->get_column('year');
21   $max_year = $rs_column->max; #returns latest year
22
23 =head1 DESCRIPTION
24
25 A convenience class used to perform operations on a specific column of
26 a resultset.
27
28 =cut
29
30 =head1 METHODS
31
32 =head2 new
33
34   my $obj = DBIx::Class::ResultSetColumn->new($rs, $column);
35
36 Creates a new resultset column object from the resultset and column
37 passed as params. Used internally by L<DBIx::Class::ResultSet/get_column>.
38
39 =cut
40
41 sub new {
42   my ($class, $rs, $column) = @_;
43   $class = ref $class if ref $class;
44
45   $rs->throw_exception("column must be supplied") unless $column;
46
47   my $orig_attrs = $rs->_resolved_attrs;
48   my $new_parent_rs = $rs->search_rs;
49
50   # prefetch causes additional columns to be fetched, but we can not just make a new
51   # rs via the _resolved_attrs trick - we need to retain the separation between
52   # +select/+as and select/as. At the same time we want to preserve any joins that the
53   # prefetch would otherwise generate.
54
55   my $new_attrs = $new_parent_rs->{attrs} ||= {};
56   $new_attrs->{join} = $rs->_merge_attr( delete $new_attrs->{join}, delete $new_attrs->{prefetch} );
57
58   # If $column can be found in the 'as' list of the parent resultset, use the
59   # corresponding element of its 'select' list (to keep any custom column
60   # definition set up with 'select' or '+select' attrs), otherwise use $column
61   # (to create a new column definition on-the-fly).
62
63   my $as_list = $orig_attrs->{as} || [];
64   my $select_list = $orig_attrs->{select} || [];
65   my $as_index = List::Util::first { ($as_list->[$_] || "") eq $column } 0..$#$as_list;
66   my $select = defined $as_index ? $select_list->[$as_index] : $column;
67
68   # {collapse} would mean a has_many join was injected, which in turn means
69   # we need to group *IF WE CAN* (only if the column in question is unique)
70   if (!$new_attrs->{group_by} && keys %{$orig_attrs->{collapse}}) {
71
72     # scan for a constraint that would contain our column only - that'd be proof
73     # enough it is unique
74     my $constraints = { $rs->result_source->unique_constraints };
75     for my $constraint_columns ( values %$constraints ) {
76
77       next unless @$constraint_columns == 1;
78
79       my $col = $constraint_columns->[0];
80       my $fqcol = join ('.', $new_attrs->{alias}, $col);
81
82       if ($col eq $select or $fqcol eq $select) {
83         $new_attrs->{group_by} = [ $select ];
84         delete $new_attrs->{distinct}; # it is ignored when group_by is present
85         last;
86       }
87     }
88
89     if (!$new_attrs->{group_by}) {
90       carp (
91           "Attempting to retrieve non-unique column '$column' on a resultset containing "
92         . 'one-to-many joins will return duplicate results.'
93       );
94     }
95   }
96
97   my $new = bless { _select => $select, _as => $column, _parent_resultset => $new_parent_rs }, $class;
98   return $new;
99 }
100
101 =head2 as_query
102
103 =over 4
104
105 =item Arguments: none
106
107 =item Return Value: \[ $sql, @bind ]
108
109 =back
110
111 Returns the SQL query and bind vars associated with the invocant.
112
113 This is generally used as the RHS for a subquery.
114
115 =cut
116
117 sub as_query { return shift->_resultset->as_query(@_) }
118
119 =head2 next
120
121 =over 4
122
123 =item Arguments: none
124
125 =item Return Value: $value
126
127 =back
128
129 Returns the next value of the column in the resultset (or C<undef> if
130 there is none).
131
132 Much like L<DBIx::Class::ResultSet/next> but just returning the 
133 one value.
134
135 =cut
136
137 sub next {
138   my $self = shift;
139
140   # using cursor so we don't inflate anything
141   my ($row) = $self->_resultset->cursor->next;
142
143   return $row;
144 }
145
146 =head2 all
147
148 =over 4
149
150 =item Arguments: none
151
152 =item Return Value: @values
153
154 =back
155
156 Returns all values of the column in the resultset (or C<undef> if
157 there are none).
158
159 Much like L<DBIx::Class::ResultSet/all> but returns values rather
160 than row objects.
161
162 =cut
163
164 sub all {
165   my $self = shift;
166
167   # using cursor so we don't inflate anything
168   return map { $_->[0] } $self->_resultset->cursor->all;
169 }
170
171 =head2 reset
172
173 =over 4
174
175 =item Arguments: none
176
177 =item Return Value: $self
178
179 =back
180
181 Resets the underlying resultset's cursor, so you can iterate through the
182 elements of the column again.
183
184 Much like L<DBIx::Class::ResultSet/reset>.
185
186 =cut
187
188 sub reset {
189   my $self = shift;
190   $self->_resultset->cursor->reset;
191   return $self;
192 }
193
194 =head2 first
195
196 =over 4
197
198 =item Arguments: none
199
200 =item Return Value: $value
201
202 =back
203
204 Resets the underlying resultset and returns the next value of the column in the
205 resultset (or C<undef> if there is none).
206
207 Much like L<DBIx::Class::ResultSet/first> but just returning the one value.
208
209 =cut
210
211 sub first {
212   my $self = shift;
213
214   # using cursor so we don't inflate anything
215   $self->_resultset->cursor->reset;
216   my ($row) = $self->_resultset->cursor->next;
217
218   return $row;
219 }
220
221 =head2 single
222
223 =over 4
224
225 =item Arguments: none
226
227 =item Return Value: $value
228
229 =back
230
231 Much like L<DBIx::Class::ResultSet/single> fetches one and only one column
232 value using the cursor directly. If additional rows are present a warning
233 is issued before discarding the cursor.
234
235 =cut
236
237 sub single {
238   my $self = shift;
239
240   my $attrs = $self->_resultset->_resolved_attrs;
241   my ($row) = $self->_resultset->result_source->storage->select_single(
242     $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
243   );
244
245   return $row;
246 }
247
248 =head2 min
249
250 =over 4
251
252 =item Arguments: none
253
254 =item Return Value: $lowest_value
255
256 =back
257
258   my $first_year = $year_col->min();
259
260 Wrapper for ->func. Returns the lowest value of the column in the
261 resultset (or C<undef> if there are none).
262
263 =cut
264
265 sub min {
266   return shift->func('MIN');
267 }
268
269 =head2 min_rs
270
271 =over 4
272
273 =item Arguments: none
274
275 =item Return Value: $resultset
276
277 =back
278
279   my $rs = $year_col->min_rs();
280
281 Wrapper for ->func_rs for function MIN().
282
283 =cut
284
285 sub min_rs { return shift->func_rs('MIN') }
286
287 =head2 max
288
289 =over 4
290
291 =item Arguments: none
292
293 =item Return Value: $highest_value
294
295 =back
296
297   my $last_year = $year_col->max();
298
299 Wrapper for ->func. Returns the highest value of the column in the
300 resultset (or C<undef> if there are none).
301
302 =cut
303
304 sub max {
305   return shift->func('MAX');
306 }
307
308 =head2 max_rs
309
310 =over 4
311
312 =item Arguments: none
313
314 =item Return Value: $resultset
315
316 =back
317
318   my $rs = $year_col->max_rs();
319
320 Wrapper for ->func_rs for function MAX().
321
322 =cut
323
324 sub max_rs { return shift->func_rs('MAX') }
325
326 =head2 sum
327
328 =over 4
329
330 =item Arguments: none
331
332 =item Return Value: $sum_of_values
333
334 =back
335
336   my $total = $prices_col->sum();
337
338 Wrapper for ->func. Returns the sum of all the values in the column of
339 the resultset. Use on varchar-like columns at your own risk.
340
341 =cut
342
343 sub sum {
344   return shift->func('SUM');
345 }
346
347 =head2 sum_rs
348
349 =over 4
350
351 =item Arguments: none
352
353 =item Return Value: $resultset
354
355 =back
356
357   my $rs = $year_col->sum_rs();
358
359 Wrapper for ->func_rs for function SUM().
360
361 =cut
362
363 sub sum_rs { return shift->func_rs('SUM') }
364
365 =head2 func
366
367 =over 4
368
369 =item Arguments: $function
370
371 =item Return Value: $function_return_value
372
373 =back
374
375   $rs = $schema->resultset("CD")->search({});
376   $length = $rs->get_column('title')->func('LENGTH');
377
378 Runs a query using the function on the column and returns the
379 value. Produces the following SQL:
380
381   SELECT LENGTH( title ) FROM cd me
382
383 =cut
384
385 sub func {
386   my ($self,$function) = @_;
387   my $cursor = $self->func_rs($function)->cursor;
388
389   if( wantarray ) {
390     return map { $_->[ 0 ] } $cursor->all;
391   }
392
393   return ( $cursor->next )[ 0 ];
394 }
395
396 =head2 func_rs
397
398 =over 4
399
400 =item Arguments: $function
401
402 =item Return Value: $resultset
403
404 =back
405
406 Creates the resultset that C<func()> uses to run its query.
407
408 =cut
409
410 sub func_rs {
411   my ($self,$function) = @_;
412   return $self->{_parent_resultset}->search(
413     undef, {
414       select => {$function => $self->{_select}},
415       as => [$self->{_as}],
416     },
417   );
418 }
419
420 =head2 throw_exception
421
422 See L<DBIx::Class::Schema/throw_exception> for details.
423
424 =cut 
425
426 sub throw_exception {
427   my $self=shift;
428
429   if (ref $self && $self->{_parent_resultset}) {
430     $self->{_parent_resultset}->throw_exception(@_);
431   }
432   else {
433     DBIx::Class::Exception->throw(@_);
434   }
435 }
436
437 # _resultset
438 #
439 # Arguments: none
440 #
441 # Return Value: $resultset
442 #
443 #  $year_col->_resultset->next
444 #
445 # Returns the underlying resultset. Creates it from the parent resultset if
446 # necessary.
447 #
448 sub _resultset {
449   my $self = shift;
450
451   return $self->{_resultset} ||= $self->{_parent_resultset}->search(undef,
452     {
453       select => [$self->{_select}],
454       as => [$self->{_as}]
455     }
456   );
457 }
458
459 1;
460
461 =head1 AUTHORS
462
463 Luke Saunders <luke.saunders@gmail.com>
464
465 Jess Robinson
466
467 =head1 LICENSE
468
469 You may distribute this code under the same terms as Perl itself.
470
471 =cut