lib/DBIx/Class/ResultSet.pm

   1 package DBIx::Class::ResultSet;
   2
   3 use strict;
   4 use warnings;
   5 use overload
   6         '0+'     => 'count',
   7         fallback => 1;
   8 use Data::Page;
   9
  10 =head1 NAME
  11
  12 DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
  13
  14 =head1 SYNOPSIS
  15
  16 my $rs = MyApp::DB::Class->search(registered => 1);
  17 my @rows = MyApp::DB::Class->search(foo => 'bar');
  18
  19 =head1 DESCRIPTION
  20
  21 The resultset is also known as an iterator. It is responsible for handling
  22 queries that may return an arbitrary number of rows, e.g. via C<search>
  23 or a C<has_many> relationship.
  24
  25 =head1 METHODS
  26
  27 =head2 new($source, \%$attrs)
  28
  29 The resultset constructor. Takes a source object (usually a DBIx::Class::Table)
  30 and an attribute hash (see below for more information on attributes). Does
  31 not perform any queries -- these are executed as needed by the other methods.
  32
  33 =cut
  34
  35 sub new {
  36   my ($class, $source, $attrs) = @_;
  37   #use Data::Dumper; warn Dumper(@_);
  38   $class = ref $class if ref $class;
  39   $attrs = { %{ $attrs || {} } };
  40   my %seen;
  41   if (!$attrs->{select}) {
  42     my @cols = ($attrs->{cols}
  43                  ? @{delete $attrs->{cols}}
  44                  : $source->result_class->_select_columns);
  45     $attrs->{select} = [ map { m/\./ ? $_ : "me.$_" } @cols ];
  46   }
  47   $attrs->{as} ||= [ map { m/^me\.(.*)$/ ? $1 : $_ } @{$attrs->{select}} ];
  48   #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
  49   $attrs->{from} ||= [ { 'me' => $source->name } ];
  50   if ($attrs->{join}) {
  51     foreach my $j (ref $attrs->{join} eq 'ARRAY'
  52               ? (@{$attrs->{join}}) : ($attrs->{join})) {
  53       if (ref $j eq 'HASH') {
  54         $seen{$_} = 1 foreach keys %$j;
  55       } else {
  56         $seen{$j} = 1;
  57       }
  58     }
  59     push(@{$attrs->{from}}, $source->result_class->_resolve_join($attrs->{join}, 'me'));
  60   }
  61   foreach my $pre (@{$attrs->{prefetch} || []}) {
  62     push(@{$attrs->{from}}, $source->result_class->_resolve_join($pre, 'me'))
  63       unless $seen{$pre};
  64     my @pre =
  65       map { "$pre.$_" }
  66       $source->result_class->_relationships->{$pre}->{class}->columns;
  67     push(@{$attrs->{select}}, @pre);
  68     push(@{$attrs->{as}}, @pre);
  69   }
  70   my $new = {
  71     source => $source,
  72     result_class => $source->result_class,
  73     cond => $attrs->{where},
  74     from => $attrs->{from},
  75     count => undef,
  76     pager => undef,
  77     attrs => $attrs };
  78   bless ($new, $class);
  79   $new->pager if $attrs->{page};
  80   return $new;
  81 }
  82
  83 =head2 search
  84
  85   my @obj    = $rs->search({ foo => 3 }); # "... WHERE foo = 3"
  86   my $new_rs = $rs->search({ foo => 3 });
  87
  88 If you need to pass in additional attributes but no additional condition,
  89 call it as ->search(undef, \%attrs);
  90
  91   my @all = $class->search({}, { cols => [qw/foo bar/] }); # "SELECT foo, bar FROM $class_table"
  92
  93 =cut
  94
  95 sub search {
  96   my $self = shift;
  97
  98   #use Data::Dumper;warn Dumper(@_);
  99
 100   my $attrs = { %{$self->{attrs}} };
 101   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 102     $attrs = { %{ pop(@_) } };
 103   }
 104
 105   my $where = ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_});
 106   if (defined $where) {
 107     $where = (defined $attrs->{where}
 108                 ? { '-and' => [ $where, $attrs->{where} ] }
 109                 : $where);
 110     $attrs->{where} = $where;
 111   }
 112
 113   my $rs = $self->new($self->{source}, $attrs);
 114
 115   return (wantarray ? $rs->all : $rs);
 116 }
 117
 118 =head2 search_literal
 119   my @obj    = $rs->search_literal($literal_where_cond, @bind);
 120   my $new_rs = $rs->search_literal($literal_where_cond, @bind);
 121
 122 Pass a literal chunk of SQL to be added to the conditional part of the
 123 resultset
 124
 125 =cut
 126
 127 sub search_literal {
 128   my ($self, $cond, @vals) = @_;
 129   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
 130   $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ];
 131   return $self->search(\$cond, $attrs);
 132 }
 133
 134 =head2 cursor
 135
 136 Returns a storage-driven cursor to the given resultset.
 137
 138 =cut
 139
 140 sub cursor {
 141   my ($self) = @_;
 142   my ($source, $attrs) = @{$self}{qw/source attrs/};
 143   if ($attrs->{page}) {
 144     $attrs->{rows} = $self->pager->entries_per_page;
 145     $attrs->{offset} = $self->pager->skipped;
 146   }
 147   return $self->{cursor}
 148     ||= $source->storage->select($self->{from}, $attrs->{select},
 149           $attrs->{where},$attrs);
 150 }
 151
 152 =head2 search_like
 153
 154 Identical to search except defaults to 'LIKE' instead of '=' in condition
 155
 156 =cut
 157
 158 sub search_like {
 159   my $class    = shift;
 160   my $attrs = { };
 161   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 162     $attrs = pop(@_);
 163   }
 164   my $query    = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
 165   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
 166   return $class->search($query, { %$attrs });
 167 }
 168
 169 =head2 slice($first, $last)
 170
 171 Returns a subset of elements from the resultset.
 172
 173 =cut
 174
 175 sub slice {
 176   my ($self, $min, $max) = @_;
 177   my $attrs = { %{ $self->{attrs} || {} } };
 178   $self->{source}->result_class->throw("Can't slice without where") unless $attrs->{where};
 179   $attrs->{offset} = $min;
 180   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
 181   my $slice = $self->new($self->{source}, $attrs);
 182   return (wantarray ? $slice->all : $slice);
 183 }
 184
 185 =head2 next
 186
 187 Returns the next element in the resultset (undef is there is none).
 188
 189 =cut
 190
 191 sub next {
 192   my ($self) = @_;
 193   my @row = $self->cursor->next;
 194   return unless (@row);
 195   return $self->_construct_object(@row);
 196 }
 197
 198 sub _construct_object {
 199   my ($self, @row) = @_;
 200   my @cols = @{ $self->{attrs}{as} };
 201   #warn "@cols -> @row";
 202   @cols = grep { /\(/ or ! /\./ } @cols;
 203   my $new;
 204   unless ($self->{attrs}{prefetch}) {
 205     $new = $self->{source}->result_class->_row_to_object(\@cols, \@row);
 206   } else {
 207     my @main = splice(@row, 0, scalar @cols);
 208     $new = $self->{source}->result_class->_row_to_object(\@cols, \@main);
 209     PRE: foreach my $pre (@{$self->{attrs}{prefetch}}) {
 210       my $rel_obj = $self->{source}->result_class->_relationships->{$pre};
 211       my $pre_class = $self->{source}->result_class->resolve_class($rel_obj->{class});
 212       my @pre_cols = $pre_class->_select_columns;
 213       my @vals = splice(@row, 0, scalar @pre_cols);
 214       my $fetched = $pre_class->_row_to_object(\@pre_cols, \@vals);
 215       $self->{source}->result_class->throw("No accessor for prefetched $pre")
 216         unless defined $rel_obj->{attrs}{accessor};
 217       if ($rel_obj->{attrs}{accessor} eq 'single') {
 218         foreach my $pri ($rel_obj->{class}->primary_columns) {
 219           unless (defined $fetched->get_column($pri)) {
 220             undef $fetched;
 221             last;
 222           }
 223         }
 224         $new->{_relationship_data}{$pre} = $fetched;
 225       } elsif ($rel_obj->{attrs}{accessor} eq 'filter') {
 226         $new->{_inflated_column}{$pre} = $fetched;
 227       } else {
 228         $self->{source}->result_class->throw("Don't know how to store prefetched $pre");
 229       }
 230     }
 231   }
 232   $new = $self->{attrs}{record_filter}->($new)
 233     if exists $self->{attrs}{record_filter};
 234   return $new;
 235 }
 236
 237 =head2 count
 238
 239 Performs an SQL C<COUNT> with the same query as the resultset was built
 240 with to find the number of elements. If passed arguments, does a search
 241 on the resultset and counts the results of that.
 242
 243 =cut
 244
 245 sub count {
 246   my $self = shift;
 247   return $self->search(@_)->count if @_ && defined $_[0];
 248   unless ($self->{count}) {
 249     my $attrs = { %{ $self->{attrs} },
 250                   select => [ 'COUNT(*)' ], as => [ 'count' ] };
 251     # offset and order by are not needed to count, page, join and prefetch
 252     # will get in the way (add themselves to from again ...)
 253     delete $attrs->{$_} for qw/offset order_by page join prefetch/;
 254
 255     my @cols = 'COUNT(*)';
 256     ($self->{count}) = $self->search(undef, $attrs)->cursor->next;
 257   }
 258   return 0 unless $self->{count};
 259   return $self->{pager}->entries_on_this_page if ($self->{pager});
 260   return ( $self->{attrs}->{rows} && $self->{attrs}->{rows} < $self->{count} )
 261     ? $self->{attrs}->{rows}
 262     : $self->{count};
 263 }
 264
 265 =head2 count_literal
 266
 267 Calls search_literal with the passed arguments, then count.
 268
 269 =cut
 270
 271 sub count_literal { shift->search_literal(@_)->count; }
 272
 273 =head2 all
 274
 275 Returns all elements in the resultset. Called implictly if the resultset
 276 is returned in list context.
 277
 278 =cut
 279
 280 sub all {
 281   my ($self) = @_;
 282   return map { $self->_construct_object(@$_); }
 283            $self->cursor->all;
 284 }
 285
 286 =head2 reset
 287
 288 Resets the resultset's cursor, so you can iterate through the elements again.
 289
 290 =cut
 291
 292 sub reset {
 293   my ($self) = @_;
 294   $self->cursor->reset;
 295   return $self;
 296 }
 297
 298 =head2 first
 299
 300 Resets the resultset and returns the first element.
 301
 302 =cut
 303
 304 sub first {
 305   return $_[0]->reset->next;
 306 }
 307
 308 =head2 delete
 309
 310 Deletes all elements in the resultset.
 311
 312 =cut
 313
 314 sub delete {
 315   my ($self) = @_;
 316   $_->delete for $self->all;
 317   return 1;
 318 }
 319
 320 *delete_all = \&delete; # Yeah, yeah, yeah ...
 321
 322 =head2 pager
 323
 324 Returns a L<Data::Page> object for the current resultset. Only makes
 325 sense for queries with page turned on.
 326
 327 =cut
 328
 329 sub pager {
 330   my ($self) = @_;
 331   my $attrs = $self->{attrs};
 332   delete $attrs->{offset};
 333   my $rows_per_page = delete $attrs->{rows} || 10;
 334   $self->{pager} ||= Data::Page->new(
 335     $self->count, $rows_per_page, $attrs->{page} || 1);
 336   $attrs->{rows} = $rows_per_page;
 337   return $self->{pager};
 338 }
 339
 340 =head2 page($page_num)
 341
 342 Returns a new resultset for the specified page.
 343
 344 =cut
 345
 346 sub page {
 347   my ($self, $page) = @_;
 348   my $attrs = $self->{attrs};
 349   $attrs->{page} = $page;
 350   return $self->new($self->{source}, $attrs);
 351 }
 352
 353 =head1 Attributes
 354
 355 The resultset takes various attributes that modify its behavior.
 356 Here's an overview of them:
 357
 358 =head2 order_by
 359
 360 Which column(s) to order the results by. This is currently passed
 361 through directly to SQL, so you can give e.g. C<foo DESC> for a
 362 descending order.
 363
 364 =head2 cols (arrayref)
 365
 366 Shortcut to request a particular set of columns to be retrieved - adds
 367 'me.' onto the start of any column without a '.' in it and sets 'select'
 368 from that, then auto-populates 'as' from 'select' as normal
 369
 370 =head2 select (arrayref)
 371
 372 Indicates which columns should be selected from the storage
 373
 374 =head2 as (arrayref)
 375
 376 Indicates column names for object inflation
 377
 378 =head2 join
 379
 380 Contains a list of relationships that should be joined for this query. Can also
 381 contain a hash reference to refer to that relation's relations. So, if one column
 382 in your class C<belongs_to> foo and another C<belongs_to> bar, you can do
 383 C<< join => [qw/ foo bar /] >> to join both (and e.g. use them for C<order_by>).
 384 If a foo contains many margles and you want to join those too, you can do
 385 C<< join => { foo => 'margle' } >>. If you want to fetch the columns from the
 386 related table as well, see C<prefetch> below.
 387
 388 =head2 prefetch
 389
 390 Contains a list of relationships that should be fetched along with the main
 391 query (when they are accessed afterwards they will have already been
 392 "prefetched"). This is useful for when you know you will need the related
 393 object(s), because it saves a query. Currently limited to prefetching
 394 one relationship deep, so unlike C<join>, prefetch must be an arrayref.
 395
 396 =head2 from
 397
 398 This attribute can contain a arrayref of elements. Each element can be another
 399 arrayref, to nest joins, or it can be a hash which represents the two sides
 400 of the join.
 401
 402 NOTE: Use this on your own risk. This allows you to shoot your foot off!
 403
 404 =head2 page
 405
 406 For a paged resultset, specifies which page to retrieve. Leave unset
 407 for an unpaged resultset.
 408
 409 =head2 rows
 410
 411 For a paged resultset, how many rows per page
 412
 413 =cut
 414
 415 1;