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 find(@colvalues), find(\%cols)
 141
 142 Finds a row based on its primary key(s).
 143
 144 =cut
 145
 146 sub find {
 147   my ($self, @vals) = @_;
 148   my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
 149   my @pk = $self->{source}->primary_columns;
 150   #use Data::Dumper; warn Dumper($attrs, @vals, @pk);
 151   $self->{source}->result_class->throw( "Can't find unless primary columns are defined" )
 152     unless @pk;
 153   my $query;
 154   if (ref $vals[0] eq 'HASH') {
 155     $query = $vals[0];
 156   } elsif (@pk == @vals) {
 157     $query = {};
 158     @{$query}{@pk} = @vals;
 159   } else {
 160     $query = {@vals};
 161   }
 162   #warn Dumper($query);
 163   # Useless -> disabled
 164   #$self->{source}->result_class->throw( "Can't find unless all primary keys are specified" )
 165   #  unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
 166                                   # column names etc. Not sure what to do yet
 167   return $self->search($query)->next;
 168 }
 169
 170 =head2 search_related
 171
 172   $rs->search_related('relname', $cond?, $attrs?);
 173
 174 =cut
 175
 176 sub search_related {
 177   my ($self, $rel, @rest) = @_;
 178   my $rel_obj = $self->{source}->result_class->_relationships->{$rel};
 179   $self->{source}->result_class->throw(
 180     "No such relationship ${rel} in search_related")
 181       unless $rel_obj;
 182   my $r_class = $self->{source}->result_class->resolve_class($rel_obj->{class});
 183   my $source = $r_class->result_source;
 184   $source = bless({ %{$source} }, ref $source || $source);
 185   $source->storage($self->{source}->storage);
 186   $source->result_class($r_class);
 187   my $rs = $self->search(undef, { join => $rel });
 188   #use Data::Dumper; warn Dumper($rs);
 189   return $source->resultset_class->new(
 190            $source, { %{$rs->{attrs}},
 191                       alias => $rel,
 192                       select => undef(),
 193                       as => undef() }
 194            )->search(@rest);
 195 }
 196
 197 =head2 cursor
 198
 199 Returns a storage-driven cursor to the given resultset.
 200
 201 =cut
 202
 203 sub cursor {
 204   my ($self) = @_;
 205   my ($source, $attrs) = @{$self}{qw/source attrs/};
 206   $attrs = { %$attrs };
 207   return $self->{cursor}
 208     ||= $source->storage->select($self->{from}, $attrs->{select},
 209           $attrs->{where},$attrs);
 210 }
 211
 212 =head2 search_like
 213
 214 Identical to search except defaults to 'LIKE' instead of '=' in condition
 215
 216 =cut
 217
 218 sub search_like {
 219   my $class    = shift;
 220   my $attrs = { };
 221   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 222     $attrs = pop(@_);
 223   }
 224   my $query    = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
 225   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
 226   return $class->search($query, { %$attrs });
 227 }
 228
 229 =head2 slice($first, $last)
 230
 231 Returns a subset of elements from the resultset.
 232
 233 =cut
 234
 235 sub slice {
 236   my ($self, $min, $max) = @_;
 237   my $attrs = { %{ $self->{attrs} || {} } };
 238   $attrs->{offset} ||= 0;
 239   $attrs->{offset} += $min;
 240   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
 241   my $slice = $self->new($self->{source}, $attrs);
 242   return (wantarray ? $slice->all : $slice);
 243 }
 244
 245 =head2 next
 246
 247 Returns the next element in the resultset (undef is there is none).
 248
 249 =cut
 250
 251 sub next {
 252   my ($self) = @_;
 253   my @row = $self->cursor->next;
 254   return unless (@row);
 255   return $self->_construct_object(@row);
 256 }
 257
 258 sub _construct_object {
 259   my ($self, @row) = @_;
 260   my @cols = @{ $self->{attrs}{as} };
 261   #warn "@cols -> @row";
 262   my (%me, %pre);
 263   foreach my $col (@cols) {
 264     if ($col =~ /([^\.]+)\.([^\.]+)/) {
 265       $pre{$1}[0]{$2} = shift @row;
 266     } else {
 267       $me{$col} = shift @row;
 268     }
 269   }
 270   my $new = $self->{source}->result_class->inflate_result(\%me, \%pre);
 271   $new = $self->{attrs}{record_filter}->($new)
 272     if exists $self->{attrs}{record_filter};
 273   return $new;
 274 }
 275
 276 =head2 count
 277
 278 Performs an SQL C<COUNT> with the same query as the resultset was built
 279 with to find the number of elements. If passed arguments, does a search
 280 on the resultset and counts the results of that.
 281
 282 =cut
 283
 284 sub count {
 285   my $self = shift;
 286   return $self->search(@_)->count if @_ && defined $_[0];
 287   die "Unable to ->count with a GROUP BY" if defined $self->{attrs}{group_by};
 288   unless (defined $self->{count}) {
 289     my $attrs = { %{ $self->{attrs} },
 290                   select => { 'count' => '*' },
 291                   as => [ 'count' ] };
 292     # offset, order by and page are not needed to count
 293     delete $attrs->{$_} for qw/rows offset order_by page pager/;
 294
 295     ($self->{count}) = $self->new($self->{source}, $attrs)->cursor->next;
 296   }
 297   return 0 unless $self->{count};
 298   my $count = $self->{count};
 299   $count -= $self->{attrs}{offset} if $self->{attrs}{offset};
 300   $count = $self->{attrs}{rows} if
 301     ($self->{attrs}{rows} && $self->{attrs}{rows} < $count);
 302   return $count;
 303 }
 304
 305 =head2 count_literal
 306
 307 Calls search_literal with the passed arguments, then count.
 308
 309 =cut
 310
 311 sub count_literal { shift->search_literal(@_)->count; }
 312
 313 =head2 all
 314
 315 Returns all elements in the resultset. Called implictly if the resultset
 316 is returned in list context.
 317
 318 =cut
 319
 320 sub all {
 321   my ($self) = @_;
 322   return map { $self->_construct_object(@$_); }
 323            $self->cursor->all;
 324 }
 325
 326 =head2 reset
 327
 328 Resets the resultset's cursor, so you can iterate through the elements again.
 329
 330 =cut
 331
 332 sub reset {
 333   my ($self) = @_;
 334   $self->cursor->reset;
 335   return $self;
 336 }
 337
 338 =head2 first
 339
 340 Resets the resultset and returns the first element.
 341
 342 =cut
 343
 344 sub first {
 345   return $_[0]->reset->next;
 346 }
 347
 348 =head2 delete
 349
 350 Deletes all elements in the resultset.
 351
 352 =cut
 353
 354 sub delete {
 355   my ($self) = @_;
 356   $_->delete for $self->all;
 357   return 1;
 358 }
 359
 360 *delete_all = \&delete; # Yeah, yeah, yeah ...
 361
 362 =head2 pager
 363
 364 Returns a L<Data::Page> object for the current resultset. Only makes
 365 sense for queries with page turned on.
 366
 367 =cut
 368
 369 sub pager {
 370   my ($self) = @_;
 371   my $attrs = $self->{attrs};
 372   die "Can't create pager for non-paged rs" unless $self->{page};
 373   $attrs->{rows} ||= 10;
 374   $self->count;
 375   return $self->{pager} ||= Data::Page->new(
 376     $self->{count}, $attrs->{rows}, $self->{page});
 377 }
 378
 379 =head2 page($page_num)
 380
 381 Returns a new resultset for the specified page.
 382
 383 =cut
 384
 385 sub page {
 386   my ($self, $page) = @_;
 387   my $attrs = { %{$self->{attrs}} };
 388   $attrs->{page} = $page;
 389   return $self->new($self->{source}, $attrs);
 390 }
 391
 392 =head1 ATTRIBUTES
 393
 394 The resultset takes various attributes that modify its behavior.
 395 Here's an overview of them:
 396
 397 =head2 order_by
 398
 399 Which column(s) to order the results by. This is currently passed
 400 through directly to SQL, so you can give e.g. C<foo DESC> for a
 401 descending order.
 402
 403 =head2 cols (arrayref)
 404
 405 Shortcut to request a particular set of columns to be retrieved - adds
 406 'me.' onto the start of any column without a '.' in it and sets 'select'
 407 from that, then auto-populates 'as' from 'select' as normal
 408
 409 =head2 select (arrayref)
 410
 411 Indicates which columns should be selected from the storage
 412
 413 =head2 as (arrayref)
 414
 415 Indicates column names for object inflation
 416
 417 =head2 join
 418
 419 Contains a list of relationships that should be joined for this query. Can also
 420 contain a hash reference to refer to that relation's relations. So, if one column
 421 in your class C<belongs_to> foo and another C<belongs_to> bar, you can do
 422 C<< join => [qw/ foo bar /] >> to join both (and e.g. use them for C<order_by>).
 423 If a foo contains many margles and you want to join those too, you can do
 424 C<< join => { foo => 'margle' } >>. If you want to fetch the columns from the
 425 related table as well, see C<prefetch> below.
 426
 427 =head2 prefetch
 428
 429 Contains a list of relationships that should be fetched along with the main
 430 query (when they are accessed afterwards they will have already been
 431 "prefetched"). This is useful for when you know you will need the related
 432 object(s), because it saves a query. Currently limited to prefetching
 433 one relationship deep, so unlike C<join>, prefetch must be an arrayref.
 434
 435 =head2 from
 436
 437 This attribute can contain a arrayref of elements. Each element can be another
 438 arrayref, to nest joins, or it can be a hash which represents the two sides
 439 of the join.
 440
 441 NOTE: Use this on your own risk. This allows you to shoot your foot off!
 442
 443 =head2 page
 444
 445 For a paged resultset, specifies which page to retrieve. Leave unset
 446 for an unpaged resultset.
 447
 448 =head2 rows
 449
 450 For a paged resultset, how many rows per page
 451
 452 =head2 group_by
 453
 454 A list of columns to group by (note that 'count' doesn't work on grouped
 455 resultsets)
 456
 457 =head2 distinct
 458
 459 Set to 1 to group by all columns
 460
 461 =cut
 462
 463 1;