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