made commit/rollback when disconnected an exception
[dbsrgits/DBIx-Class-Historic.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 (EXPERIMENTAL)
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 B<NOTE>: This feature is still experimental.
116
117 =cut
118
119 sub as_query { return shift->_resultset->as_query(@_) }
120
121 =head2 next
122
123 =over 4
124
125 =item Arguments: none
126
127 =item Return Value: $value
128
129 =back
130
131 Returns the next value of the column in the resultset (or C<undef> if
132 there is none).
133
134 Much like L<DBIx::Class::ResultSet/next> but just returning the 
135 one value.
136
137 =cut
138
139 sub next {
140   my $self = shift;
141
142   # using cursor so we don't inflate anything
143   my ($row) = $self->_resultset->cursor->next;
144
145   return $row;
146 }
147
148 =head2 all
149
150 =over 4
151
152 =item Arguments: none
153
154 =item Return Value: @values
155
156 =back
157
158 Returns all values of the column in the resultset (or C<undef> if
159 there are none).
160
161 Much like L<DBIx::Class::ResultSet/all> but returns values rather
162 than row objects.
163
164 =cut
165
166 sub all {
167   my $self = shift;
168
169   # using cursor so we don't inflate anything
170   return map { $_->[0] } $self->_resultset->cursor->all;
171 }
172
173 =head2 reset
174
175 =over 4
176
177 =item Arguments: none
178
179 =item Return Value: $self
180
181 =back
182
183 Resets the underlying resultset's cursor, so you can iterate through the
184 elements of the column again.
185
186 Much like L<DBIx::Class::ResultSet/reset>.
187
188 =cut
189
190 sub reset {
191   my $self = shift;
192   $self->_resultset->cursor->reset;
193   return $self;
194 }
195
196 =head2 first
197
198 =over 4
199
200 =item Arguments: none
201
202 =item Return Value: $value
203
204 =back
205
206 Resets the underlying resultset and returns the next value of the column in the
207 resultset (or C<undef> if there is none).
208
209 Much like L<DBIx::Class::ResultSet/first> but just returning the one value.
210
211 =cut
212
213 sub first {
214   my $self = shift;
215
216   # using cursor so we don't inflate anything
217   $self->_resultset->cursor->reset;
218   my ($row) = $self->_resultset->cursor->next;
219
220   return $row;
221 }
222
223 =head2 single
224
225 =over 4
226
227 =item Arguments: none
228
229 =item Return Value: $value
230
231 =back
232
233 Much like L<DBIx::Class::ResultSet/single> fetches one and only one column
234 value using the cursor directly. If additional rows are present a warning
235 is issued before discarding the cursor.
236
237 =cut
238
239 sub single {
240   my $self = shift;
241
242   my $attrs = $self->_resultset->_resolved_attrs;
243   my ($row) = $self->_resultset->result_source->storage->select_single(
244     $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
245   );
246
247   return $row;
248 }
249
250 =head2 min
251
252 =over 4
253
254 =item Arguments: none
255
256 =item Return Value: $lowest_value
257
258 =back
259
260   my $first_year = $year_col->min();
261
262 Wrapper for ->func. Returns the lowest value of the column in the
263 resultset (or C<undef> if there are none).
264
265 =cut
266
267 sub min {
268   return shift->func('MIN');
269 }
270
271 =head2 min_rs
272
273 =over 4
274
275 =item Arguments: none
276
277 =item Return Value: $resultset
278
279 =back
280
281   my $rs = $year_col->min_rs();
282
283 Wrapper for ->func_rs for function MIN().
284
285 =cut
286
287 sub min_rs { return shift->func_rs('MIN') }
288
289 =head2 max
290
291 =over 4
292
293 =item Arguments: none
294
295 =item Return Value: $highest_value
296
297 =back
298
299   my $last_year = $year_col->max();
300
301 Wrapper for ->func. Returns the highest value of the column in the
302 resultset (or C<undef> if there are none).
303
304 =cut
305
306 sub max {
307   return shift->func('MAX');
308 }
309
310 =head2 max_rs
311
312 =over 4
313
314 =item Arguments: none
315
316 =item Return Value: $resultset
317
318 =back
319
320   my $rs = $year_col->max_rs();
321
322 Wrapper for ->func_rs for function MAX().
323
324 =cut
325
326 sub max_rs { return shift->func_rs('MAX') }
327
328 =head2 sum
329
330 =over 4
331
332 =item Arguments: none
333
334 =item Return Value: $sum_of_values
335
336 =back
337
338   my $total = $prices_col->sum();
339
340 Wrapper for ->func. Returns the sum of all the values in the column of
341 the resultset. Use on varchar-like columns at your own risk.
342
343 =cut
344
345 sub sum {
346   return shift->func('SUM');
347 }
348
349 =head2 sum_rs
350
351 =over 4
352
353 =item Arguments: none
354
355 =item Return Value: $resultset
356
357 =back
358
359   my $rs = $year_col->sum_rs();
360
361 Wrapper for ->func_rs for function SUM().
362
363 =cut
364
365 sub sum_rs { return shift->func_rs('SUM') }
366
367 =head2 func
368
369 =over 4
370
371 =item Arguments: $function
372
373 =item Return Value: $function_return_value
374
375 =back
376
377   $rs = $schema->resultset("CD")->search({});
378   $length = $rs->get_column('title')->func('LENGTH');
379
380 Runs a query using the function on the column and returns the
381 value. Produces the following SQL:
382
383   SELECT LENGTH( title ) FROM cd me
384
385 =cut
386
387 sub func {
388   my ($self,$function) = @_;
389   my $cursor = $self->func_rs($function)->cursor;
390
391   if( wantarray ) {
392     return map { $_->[ 0 ] } $cursor->all;
393   }
394
395   return ( $cursor->next )[ 0 ];
396 }
397
398 =head2 func_rs
399
400 =over 4
401
402 =item Arguments: $function
403
404 =item Return Value: $resultset
405
406 =back
407
408 Creates the resultset that C<func()> uses to run its query.
409
410 =cut
411
412 sub func_rs {
413   my ($self,$function) = @_;
414   return $self->{_parent_resultset}->search(
415     undef, {
416       select => {$function => $self->{_select}},
417       as => [$self->{_as}],
418     },
419   );
420 }
421
422 =head2 throw_exception
423
424 See L<DBIx::Class::Schema/throw_exception> for details.
425
426 =cut 
427
428 sub throw_exception {
429   my $self=shift;
430
431   if (ref $self && $self->{_parent_resultset}) {
432     $self->{_parent_resultset}->throw_exception(@_);
433   }
434   else {
435     DBIx::Class::Exception->throw(@_);
436   }
437 }
438
439 # _resultset
440 #
441 # Arguments: none
442 #
443 # Return Value: $resultset
444 #
445 #  $year_col->_resultset->next
446 #
447 # Returns the underlying resultset. Creates it from the parent resultset if
448 # necessary.
449 #
450 sub _resultset {
451   my $self = shift;
452
453   return $self->{_resultset} ||= $self->{_parent_resultset}->search(undef,
454     {
455       select => [$self->{_select}],
456       as => [$self->{_as}]
457     }
458   );
459 }
460
461 1;
462
463 =head1 AUTHORS
464
465 Luke Saunders <luke.saunders@gmail.com>
466
467 Jess Robinson
468
469 =head1 LICENSE
470
471 You may distribute this code under the same terms as Perl itself.
472
473 =cut