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