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