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