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