lib/DBIx/Class/ResultSet.pm

   1 package DBIx::Class::ResultSet;
   2
   3 use strict;
   4 use warnings;
   5 use overload
   6         '0+'     => \&count,
   7         'bool'   => sub { 1; },
   8         fallback => 1;
   9 use Carp::Clan qw/^DBIx::Class/;
  10 use Data::Page;
  11 use Storable;
  12 use Data::Dumper;
  13 use Scalar::Util qw/weaken/;
  14
  15 use DBIx::Class::ResultSetColumn;
  16 use base qw/DBIx::Class/;
  17 __PACKAGE__->load_components(qw/AccessorGroup/);
  18 __PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
  19
  20 =head1 NAME
  21
  22 DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
  23
  24 =head1 SYNOPSIS
  25
  26   my $rs   = $schema->resultset('User')->search(registered => 1);
  27   my @rows = $schema->resultset('CD')->search(year => 2005);
  28
  29 =head1 DESCRIPTION
  30
  31 The resultset is also known as an iterator. It is responsible for handling
  32 queries that may return an arbitrary number of rows, e.g. via L</search>
  33 or a C<has_many> relationship.
  34
  35 In the examples below, the following table classes are used:
  36
  37   package MyApp::Schema::Artist;
  38   use base qw/DBIx::Class/;
  39   __PACKAGE__->load_components(qw/Core/);
  40   __PACKAGE__->table('artist');
  41   __PACKAGE__->add_columns(qw/artistid name/);
  42   __PACKAGE__->set_primary_key('artistid');
  43   __PACKAGE__->has_many(cds => 'MyApp::Schema::CD');
  44   1;
  45
  46   package MyApp::Schema::CD;
  47   use base qw/DBIx::Class/;
  48   __PACKAGE__->load_components(qw/Core/);
  49   __PACKAGE__->table('cd');
  50   __PACKAGE__->add_columns(qw/cdid artist title year/);
  51   __PACKAGE__->set_primary_key('cdid');
  52   __PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
  53   1;
  54
  55 =head1 METHODS
  56
  57 =head2 new
  58
  59 =over 4
  60
  61 =item Arguments: $source, \%$attrs
  62
  63 =item Return Value: $rs
  64
  65 =back
  66
  67 The resultset constructor. Takes a source object (usually a
  68 L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
  69 L</ATTRIBUTES> below).  Does not perform any queries -- these are
  70 executed as needed by the other methods.
  71
  72 Generally you won't need to construct a resultset manually.  You'll
  73 automatically get one from e.g. a L</search> called in scalar context:
  74
  75   my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
  76
  77 IMPORTANT: If called on an object, proxies to new_result instead so
  78
  79   my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
  80
  81 will return a CD object, not a ResultSet.
  82
  83 =cut
  84
  85 sub new {
  86   my $class = shift;
  87   return $class->new_result(@_) if ref $class;
  88
  89   my ($source, $attrs) = @_;
  90   weaken $source;
  91
  92   if ($attrs->{page}) {
  93     $attrs->{rows} ||= 10;
  94     $attrs->{offset} ||= 0;
  95     $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
  96   }
  97
  98   $attrs->{alias} ||= 'me';
  99
 100   bless {
 101     result_source => $source,
 102     result_class => $attrs->{result_class} || $source->result_class,
 103     cond => $attrs->{where},
 104 #    from => $attrs->{from},
 105 #    collapse => $collapse,
 106     count => undef,
 107     page => delete $attrs->{page},
 108     pager => undef,
 109     attrs => $attrs
 110   }, $class;
 111 }
 112
 113 =head2 search
 114
 115 =over 4
 116
 117 =item Arguments: $cond, \%attrs?
 118
 119 =item Return Value: $resultset (scalar context), @row_objs (list context)
 120
 121 =back
 122
 123   my @cds    = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
 124   my $new_rs = $cd_rs->search({ year => 2005 });
 125
 126   my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
 127                  # year = 2005 OR year = 2004
 128
 129 If you need to pass in additional attributes but no additional condition,
 130 call it as C<search(undef, \%attrs)>.
 131
 132   # "SELECT name, artistid FROM $artist_table"
 133   my @all_artists = $schema->resultset('Artist')->search(undef, {
 134     columns => [qw/name artistid/],
 135   });
 136
 137 =cut
 138
 139 sub search {
 140   my $self = shift;
 141   my $rs = $self->search_rs( @_ );
 142   return (wantarray ? $rs->all : $rs);
 143 }
 144
 145 =head2 search_rs
 146
 147 =over 4
 148
 149 =item Arguments: $cond, \%attrs?
 150
 151 =item Return Value: $resultset
 152
 153 =back
 154
 155 This method does the same exact thing as search() except it will
 156 always return a resultset, even in list context.
 157
 158 =cut
 159
 160 sub search_rs {
 161   my $self = shift;
 162
 163   my $our_attrs = { %{$self->{attrs}} };
 164   my $having = delete $our_attrs->{having};
 165   my $attrs = {};
 166   $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
 167
 168   # merge new attrs into old
 169   foreach my $key (qw/join prefetch/) {
 170     next unless (exists $attrs->{$key});
 171     if (exists $our_attrs->{$key}) {
 172       $our_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
 173     } else {
 174       $our_attrs->{$key} = $attrs->{$key};
 175     }
 176     delete $attrs->{$key};
 177   }
 178
 179   if (exists $our_attrs->{prefetch}) {
 180       $our_attrs->{join} = $self->_merge_attr($our_attrs->{join}, $our_attrs->{prefetch}, 1);
 181   }
 182
 183   my $new_attrs = { %{$our_attrs}, %{$attrs} };
 184
 185   # merge new where and having into old
 186   my $where = (@_
 187                 ? ((@_ == 1 || ref $_[0] eq "HASH")
 188                     ? shift
 189                     : ((@_ % 2)
 190                         ? $self->throw_exception(
 191                             "Odd number of arguments to search")
 192                         : {@_}))
 193                 : undef());
 194   if (defined $where) {
 195     $new_attrs->{where} = (defined $new_attrs->{where}
 196               ? { '-and' =>
 197                   [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
 198                       $where, $new_attrs->{where} ] }
 199               : $where);
 200   }
 201
 202   if (defined $having) {
 203     $new_attrs->{having} = (defined $new_attrs->{having}
 204               ? { '-and' =>
 205                   [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
 206                       $having, $new_attrs->{having} ] }
 207               : $having);
 208   }
 209
 210   my $rs = (ref $self)->new($self->result_source, $new_attrs);
 211   $rs->{_parent_rs} = $self->{_parent_rs} if ($self->{_parent_rs}); #XXX - hack to pass through parent of related resultsets
 212
 213   unless (@_) { # no search, effectively just a clone
 214     my $rows = $self->get_cache;
 215     if ($rows) {
 216       $rs->set_cache($rows);
 217     }
 218   }
 219
 220   return $rs;
 221 }
 222
 223 =head2 search_literal
 224
 225 =over 4
 226
 227 =item Arguments: $sql_fragment, @bind_values
 228
 229 =item Return Value: $resultset (scalar context), @row_objs (list context)
 230
 231 =back
 232
 233   my @cds   = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
 234   my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
 235
 236 Pass a literal chunk of SQL to be added to the conditional part of the
 237 resultset query.
 238
 239 =cut
 240
 241 sub search_literal {
 242   my ($self, $cond, @vals) = @_;
 243   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
 244   $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ];
 245   return $self->search(\$cond, $attrs);
 246 }
 247
 248 =head2 find
 249
 250 =over 4
 251
 252 =item Arguments: @values | \%cols, \%attrs?
 253
 254 =item Return Value: $row_object
 255
 256 =back
 257
 258 Finds a row based on its primary key or unique constraint. For example, to find
 259 a row by its primary key:
 260
 261   my $cd = $schema->resultset('CD')->find(5);
 262
 263 You can also find a row by a specific unique constraint using the C<key>
 264 attribute. For example:
 265
 266   my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', { key => 'artist_title' });
 267
 268 Additionally, you can specify the columns explicitly by name:
 269
 270   my $cd = $schema->resultset('CD')->find(
 271     {
 272       artist => 'Massive Attack',
 273       title  => 'Mezzanine',
 274     },
 275     { key => 'artist_title' }
 276   );
 277
 278 If the C<key> is specified as C<primary>, it searches only on the primary key.
 279
 280 If no C<key> is specified, it searches on all unique constraints defined on the
 281 source, including the primary key.
 282
 283 See also L</find_or_create> and L</update_or_create>. For information on how to
 284 declare unique constraints, see
 285 L<DBIx::Class::ResultSource/add_unique_constraint>.
 286
 287 =cut
 288
 289 sub find {
 290   my $self = shift;
 291   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 292
 293   # Default to the primary key, but allow a specific key
 294   my @cols = exists $attrs->{key}
 295     ? $self->result_source->unique_constraint_columns($attrs->{key})
 296     : $self->result_source->primary_columns;
 297   $self->throw_exception(
 298     "Can't find unless a primary key or unique constraint is defined"
 299   ) unless @cols;
 300
 301   # Parse out a hashref from input
 302   my $input_query;
 303   if (ref $_[0] eq 'HASH') {
 304     $input_query = { %{$_[0]} };
 305   }
 306   elsif (@_ == @cols) {
 307     $input_query = {};
 308     @{$input_query}{@cols} = @_;
 309   }
 310   else {
 311     # Compatibility: Allow e.g. find(id => $value)
 312     carp "Find by key => value deprecated; please use a hashref instead";
 313     $input_query = {@_};
 314   }
 315
 316   my @unique_queries = $self->_unique_queries($input_query, $attrs);
 317 #  use Data::Dumper; warn Dumper $self->result_source->name, $input_query, \@unique_queries, $self->{attrs}->{where};
 318
 319   # Verify the query
 320   my $query = \@unique_queries;
 321   if (scalar @unique_queries == 0) {
 322     # Handle cases where the ResultSet defines the query, or where the user is
 323     # abusing find
 324     $query = $input_query;
 325   }
 326
 327   # Run the query
 328   if (keys %$attrs) {
 329     my $rs = $self->search($query, $attrs);
 330     $rs->_resolve;
 331     return keys %{$rs->{_attrs}->{collapse}} ? $rs->next : $rs->single;
 332   }
 333   else {
 334     $self->_resolve;
 335     return (keys %{$self->{_attrs}->{collapse}})
 336       ? $self->search($query)->next
 337       : $self->single($query);
 338   }
 339 }
 340
 341 # _unique_queries
 342 #
 343 # Build a list of queries which satisfy unique constraints.
 344
 345 sub _unique_queries {
 346   my ($self, $query, $attrs) = @_;
 347
 348   my @constraint_names = exists $attrs->{key}
 349     ? ($attrs->{key})
 350     : $self->result_source->unique_constraint_names;
 351
 352   my @unique_queries;
 353   foreach my $name (@constraint_names) {
 354     my @unique_cols = $self->result_source->unique_constraint_columns($name);
 355     my $unique_query = $self->_build_unique_query($query, \@unique_cols);
 356
 357     next unless scalar keys %$unique_query;
 358
 359     # Add the ResultSet's alias
 360     foreach my $key (grep { ! m/\./ } keys %$unique_query) {
 361       $unique_query->{"$self->{attrs}->{alias}.$key"} = delete $unique_query->{$key};
 362     }
 363
 364     push @unique_queries, $unique_query;
 365   }
 366
 367   return @unique_queries;
 368 }
 369
 370 # _build_unique_query
 371 #
 372 # Constrain the specified query hash based on the specified column names.
 373
 374 sub _build_unique_query {
 375   my ($self, $query, $unique_cols) = @_;
 376
 377   my %unique_query =
 378     map  { $_ => $query->{$_} }
 379     grep { exists $query->{$_} }
 380     @$unique_cols;
 381
 382   return \%unique_query;
 383 }
 384
 385 =head2 search_related
 386
 387 =over 4
 388
 389 =item Arguments: $cond, \%attrs?
 390
 391 =item Return Value: $new_resultset
 392
 393 =back
 394
 395   $new_rs = $cd_rs->search_related('artist', {
 396     name => 'Emo-R-Us',
 397   });
 398
 399 Searches the specified relationship, optionally specifying a condition and
 400 attributes for matching records. See L</ATTRIBUTES> for more information.
 401
 402 =cut
 403
 404 sub search_related {
 405   return shift->related_resultset(shift)->search(@_);
 406 }
 407
 408 =head2 cursor
 409
 410 =over 4
 411
 412 =item Arguments: none
 413
 414 =item Return Value: $cursor
 415
 416 =back
 417
 418 Returns a storage-driven cursor to the given resultset. See
 419 L<DBIx::Class::Cursor> for more information.
 420
 421 =cut
 422
 423 sub cursor {
 424   my ($self) = @_;
 425
 426   $self->_resolve;
 427   my $attrs = { %{$self->{_attrs}} };
 428   return $self->{cursor}
 429     ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
 430           $attrs->{where},$attrs);
 431 }
 432
 433 =head2 single
 434
 435 =over 4
 436
 437 =item Arguments: $cond?
 438
 439 =item Return Value: $row_object?
 440
 441 =back
 442
 443   my $cd = $schema->resultset('CD')->single({ year => 2001 });
 444
 445 Inflates the first result without creating a cursor if the resultset has
 446 any records in it; if not returns nothing. Used by L</find> as an optimisation.
 447
 448 Can optionally take an additional condition *only* - this is a fast-code-path
 449 method; if you need to add extra joins or similar call ->search and then
 450 ->single without a condition on the $rs returned from that.
 451
 452 =cut
 453
 454 sub single {
 455   my ($self, $where) = @_;
 456   $self->_resolve;
 457   my $attrs = { %{$self->{_attrs}} };
 458   if ($where) {
 459     if (defined $attrs->{where}) {
 460       $attrs->{where} = {
 461         '-and' =>
 462             [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
 463                $where, delete $attrs->{where} ]
 464       };
 465     } else {
 466       $attrs->{where} = $where;
 467     }
 468   }
 469
 470   unless ($self->_is_unique_query($attrs->{where})) {
 471     carp "Query not guarnteed to return a single row"
 472       . "; please declare your unique constraints or use search instead";
 473   }
 474
 475   my @data = $self->result_source->storage->select_single(
 476           $attrs->{from}, $attrs->{select},
 477           $attrs->{where},$attrs);
 478   return (@data ? $self->_construct_object(@data) : ());
 479 }
 480
 481 # _is_unique_query
 482 #
 483 # Try to determine if the specified query is guaranteed to be unique, based on
 484 # the declared unique constraints.
 485
 486 sub _is_unique_query {
 487   my ($self, $query) = @_;
 488
 489   my $collapsed = $self->_collapse_query($query);
 490 #  use Data::Dumper; warn Dumper $query, $collapsed;
 491
 492   foreach my $name ($self->result_source->unique_constraint_names) {
 493     my @unique_cols = map { "$self->{attrs}->{alias}.$_" }
 494       $self->result_source->unique_constraint_columns($name);
 495
 496     # Count the values for each unique column
 497     my %seen = map { $_ => 0 } @unique_cols;
 498
 499     foreach my $key (keys %$collapsed) {
 500       my $aliased = $key;
 501       $aliased = "$self->{attrs}->{alias}.$key" unless $key =~ /\./;
 502
 503       next unless exists $seen{$aliased};  # Additional constraints are okay
 504       $seen{$aliased} = scalar @{ $collapsed->{$key} };
 505     }
 506
 507     # If we get 0 or more than 1 value for a column, it's not necessarily unique
 508     return 1 unless grep { $_ != 1 } values %seen;
 509   }
 510
 511   return 0;
 512 }
 513
 514 # _collapse_query
 515 #
 516 # Recursively collapse the query, accumulating values for each column.
 517
 518 sub _collapse_query {
 519   my ($self, $query, $collapsed) = @_;
 520
 521   $collapsed ||= {};
 522
 523   if (ref $query eq 'ARRAY') {
 524     foreach my $subquery (@$query) {
 525       next unless ref $subquery;  # -or
 526 #      warn "ARRAY: " . Dumper $subquery;
 527       $collapsed = $self->_collapse_query($subquery, $collapsed);
 528     }
 529   }
 530   elsif (ref $query eq 'HASH') {
 531     if (keys %$query and (keys %$query)[0] eq '-and') {
 532       foreach my $subquery (@{$query->{-and}}) {
 533 #        warn "HASH: " . Dumper $subquery;
 534         $collapsed = $self->_collapse_query($subquery, $collapsed);
 535       }
 536     }
 537     else {
 538 #      warn "LEAF: " . Dumper $query;
 539       foreach my $key (keys %$query) {
 540         push @{$collapsed->{$key}}, $query->{$key};
 541       }
 542     }
 543   }
 544
 545   return $collapsed;
 546 }
 547
 548 =head2 get_column
 549
 550 =over 4
 551
 552 =item Arguments: $cond?
 553
 554 =item Return Value: $resultsetcolumn
 555
 556 =back
 557
 558   my $max_length = $rs->get_column('length')->max;
 559
 560 Returns a ResultSetColumn instance for $column based on $self
 561
 562 =cut
 563
 564 sub get_column {
 565   my ($self, $column) = @_;
 566
 567   my $new = DBIx::Class::ResultSetColumn->new($self, $column);
 568   return $new;
 569 }
 570
 571 =head2 search_like
 572
 573 =over 4
 574
 575 =item Arguments: $cond, \%attrs?
 576
 577 =item Return Value: $resultset (scalar context), @row_objs (list context)
 578
 579 =back
 580
 581   # WHERE title LIKE '%blue%'
 582   $cd_rs = $rs->search_like({ title => '%blue%'});
 583
 584 Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
 585 that this is simply a convenience method. You most likely want to use
 586 L</search> with specific operators.
 587
 588 For more information, see L<DBIx::Class::Manual::Cookbook>.
 589
 590 =cut
 591
 592 sub search_like {
 593   my $class = shift;
 594   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 595   my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
 596   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
 597   return $class->search($query, { %$attrs });
 598 }
 599
 600 =head2 slice
 601
 602 =over 4
 603
 604 =item Arguments: $first, $last
 605
 606 =item Return Value: $resultset (scalar context), @row_objs (list context)
 607
 608 =back
 609
 610 Returns a resultset or object list representing a subset of elements from the
 611 resultset slice is called on. Indexes are from 0, i.e., to get the first
 612 three records, call:
 613
 614   my ($one, $two, $three) = $rs->slice(0, 2);
 615
 616 =cut
 617
 618 sub slice {
 619   my ($self, $min, $max) = @_;
 620   my $attrs = {}; # = { %{ $self->{attrs} || {} } };
 621   $attrs->{offset} = $self->{attrs}{offset} || 0;
 622   $attrs->{offset} += $min;
 623   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
 624   return $self->search(undef(), $attrs);
 625   #my $slice = (ref $self)->new($self->result_source, $attrs);
 626   #return (wantarray ? $slice->all : $slice);
 627 }
 628
 629 =head2 next
 630
 631 =over 4
 632
 633 =item Arguments: none
 634
 635 =item Return Value: $result?
 636
 637 =back
 638
 639 Returns the next element in the resultset (C<undef> is there is none).
 640
 641 Can be used to efficiently iterate over records in the resultset:
 642
 643   my $rs = $schema->resultset('CD')->search;
 644   while (my $cd = $rs->next) {
 645     print $cd->title;
 646   }
 647
 648 Note that you need to store the resultset object, and call C<next> on it.
 649 Calling C<< resultset('Table')->next >> repeatedly will always return the
 650 first record from the resultset.
 651
 652 =cut
 653
 654 sub next {
 655   my ($self) = @_;
 656   if (my $cache = $self->get_cache) {
 657     $self->{all_cache_position} ||= 0;
 658     return $cache->[$self->{all_cache_position}++];
 659   }
 660   if ($self->{attrs}{cache}) {
 661     $self->{all_cache_position} = 1;
 662     return ($self->all)[0];
 663   }
 664   my @row = (exists $self->{stashed_row} ?
 665                @{delete $self->{stashed_row}} :
 666                $self->cursor->next
 667   );
 668   return unless (@row);
 669   return $self->_construct_object(@row);
 670 }
 671
 672 sub _resolve {
 673   my $self = shift;
 674
 675   return if(exists $self->{_attrs}); #return if _resolve has already been called
 676
 677   my $attrs = $self->{attrs};
 678   my $source = ($self->{_parent_rs}) ? $self->{_parent_rs} : $self->{result_source};
 679
 680   # XXX - lose storable dclone
 681   my $record_filter = delete $attrs->{record_filter} if (defined $attrs->{record_filter});
 682   $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
 683   $attrs->{record_filter} = $record_filter if ($record_filter);
 684   $self->{attrs}->{record_filter} = $record_filter if ($record_filter);
 685
 686   my $alias = $attrs->{alias};
 687
 688   $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
 689   delete $attrs->{as} if $attrs->{columns};
 690   $attrs->{columns} ||= [ $self->{result_source}->columns ] unless $attrs->{select};
 691   my $select_alias = ($self->{_parent_rs}) ? $self->{attrs}->{_live_join} : $alias;
 692   $attrs->{select} = [
 693                       map { m/\./ ? $_ : "${select_alias}.$_" } @{delete $attrs->{columns}}
 694                       ] if $attrs->{columns};
 695   $attrs->{as} ||= [
 696                     map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
 697                     ];
 698   if (my $include = delete $attrs->{include_columns}) {
 699       push(@{$attrs->{select}}, @$include);
 700       push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include);
 701   }
 702
 703   $attrs->{from} ||= [ { $alias => $source->from } ];
 704   $attrs->{seen_join} ||= {};
 705   my %seen;
 706   if (my $join = delete $attrs->{join}) {
 707       foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) {
 708           if (ref $j eq 'HASH') {
 709               $seen{$_} = 1 foreach keys %$j;
 710           } else {
 711               $seen{$j} = 1;
 712           }
 713       }
 714
 715       push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join}));
 716   }
 717   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
 718   $attrs->{order_by} = [ $attrs->{order_by} ] if
 719       $attrs->{order_by} and !ref($attrs->{order_by});
 720   $attrs->{order_by} ||= [];
 721
 722  if(my $seladds = delete($attrs->{'+select'})) {
 723    my @seladds = (ref($seladds) eq 'ARRAY' ? @$seladds : ($seladds));
 724    $attrs->{select} = [
 725      @{ $attrs->{select} },
 726      map { (m/\./ || ref($_)) ? $_ : "${alias}.$_" } $seladds
 727    ];
 728  }
 729  if(my $asadds = delete($attrs->{'+as'})) {
 730    my @asadds = (ref($asadds) eq 'ARRAY' ? @$asadds : ($asadds));
 731    $attrs->{as} = [ @{ $attrs->{as} }, @asadds ];
 732  }
 733
 734   my $collapse = $attrs->{collapse} || {};
 735   if (my $prefetch = delete $attrs->{prefetch}) {
 736       my @pre_order;
 737       foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
 738           if ( ref $p eq 'HASH' ) {
 739               foreach my $key (keys %$p) {
 740                   push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
 741                       unless $seen{$key};
 742               }
 743           } else {
 744               push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
 745                   unless $seen{$p};
 746           }
 747           my @prefetch = $source->resolve_prefetch(
 748                                                    $p, $attrs->{alias}, {}, \@pre_order, $collapse);
 749           push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
 750           push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
 751       }
 752       push(@{$attrs->{order_by}}, @pre_order);
 753   }
 754   $attrs->{collapse} = $collapse;
 755   $self->{_attrs} = $attrs;
 756 }
 757
 758 sub _merge_attr {
 759   my ($self, $a, $b, $is_prefetch) = @_;
 760
 761   return $b unless $a;
 762   if (ref $b eq 'HASH' && ref $a eq 'HASH') {
 763                 foreach my $key (keys %{$b}) {
 764                         if (exists $a->{$key}) {
 765               $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key}, $is_prefetch);
 766                         } else {
 767               $a->{$key} = delete $b->{$key};
 768                         }
 769                 }
 770                 return $a;
 771   } else {
 772                 $a = [$a] unless (ref $a eq 'ARRAY');
 773                 $b = [$b] unless (ref $b eq 'ARRAY');
 774
 775                 my $hash = {};
 776                 my $array = [];
 777                 foreach ($a, $b) {
 778                         foreach my $element (@{$_}) {
 779               if (ref $element eq 'HASH') {
 780                                         $hash = $self->_merge_attr($hash, $element, $is_prefetch);
 781               } elsif (ref $element eq 'ARRAY') {
 782                                         $array = [@{$array}, @{$element}];
 783               } else {
 784                                         if (($b == $_) && $is_prefetch) {
 785                                                 $self->_merge_array($array, $element, $is_prefetch);
 786                                         } else {
 787                                                 push(@{$array}, $element);
 788                                         }
 789               }
 790                         }
 791                 }
 792
 793                 if ((keys %{$hash}) && (scalar(@{$array} > 0))) {
 794                         return [$hash, @{$array}];
 795                 } else {
 796                         return (keys %{$hash}) ? $hash : $array;
 797                 }
 798   }
 799 }
 800
 801 sub _merge_array {
 802         my ($self, $a, $b) = @_;
 803
 804         $b = [$b] unless (ref $b eq 'ARRAY');
 805         # add elements from @{$b} to @{$a} which aren't already in @{$a}
 806         foreach my $b_element (@{$b}) {
 807                 push(@{$a}, $b_element) unless grep {$b_element eq $_} @{$a};
 808         }
 809 }
 810
 811 sub _construct_object {
 812   my ($self, @row) = @_;
 813   my @as = @{ $self->{_attrs}{as} };
 814
 815   my $info = $self->_collapse_result(\@as, \@row);
 816   my $new = $self->result_class->inflate_result($self->result_source, @$info);
 817   $new = $self->{_attrs}{record_filter}->($new)
 818     if exists $self->{_attrs}{record_filter};
 819   return $new;
 820 }
 821
 822 sub _collapse_result {
 823   my ($self, $as, $row, $prefix) = @_;
 824
 825   my $live_join = $self->{attrs}->{_live_join} ||="";
 826   my %const;
 827
 828   my @copy = @$row;
 829   foreach my $this_as (@$as) {
 830     my $val = shift @copy;
 831     if (defined $prefix) {
 832       if ($this_as =~ m/^\Q${prefix}.\E(.+)$/) {
 833         my $remain = $1;
 834         $remain =~ /^(?:(.*)\.)?([^.]+)$/;
 835         $const{$1||''}{$2} = $val;
 836       }
 837     } else {
 838       $this_as =~ /^(?:(.*)\.)?([^.]+)$/;
 839       $const{$1||''}{$2} = $val;
 840     }
 841   }
 842
 843   my $info = [ {}, {} ];
 844   foreach my $key (keys %const) {
 845     if (length $key && $key ne $live_join) {
 846       my $target = $info;
 847       my @parts = split(/\./, $key);
 848       foreach my $p (@parts) {
 849         $target = $target->[1]->{$p} ||= [];
 850       }
 851       $target->[0] = $const{$key};
 852     } else {
 853       $info->[0] = $const{$key};
 854     }
 855   }
 856
 857   my @collapse;
 858   if (defined $prefix) {
 859     @collapse = map {
 860         m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
 861     } keys %{$self->{_attrs}->{collapse}}
 862   } else {
 863     @collapse = keys %{$self->{_attrs}->{collapse}};
 864   };
 865
 866   if (@collapse) {
 867     my ($c) = sort { length $a <=> length $b } @collapse;
 868     my $target = $info;
 869     foreach my $p (split(/\./, $c)) {
 870       $target = $target->[1]->{$p} ||= [];
 871     }
 872     my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c);
 873     my @co_key = @{$self->{_attrs}->{collapse}{$c_prefix}};
 874     my %co_check = map { ($_, $target->[0]->{$_}); } @co_key;
 875     my $tree = $self->_collapse_result($as, $row, $c_prefix);
 876     my (@final, @raw);
 877     while ( !(grep {
 878                 !defined($tree->[0]->{$_}) ||
 879                 $co_check{$_} ne $tree->[0]->{$_}
 880               } @co_key) ) {
 881       push(@final, $tree);
 882       last unless (@raw = $self->cursor->next);
 883       $row = $self->{stashed_row} = \@raw;
 884       $tree = $self->_collapse_result($as, $row, $c_prefix);
 885     }
 886     @$target = (@final ? @final : [ {}, {} ]);
 887       # single empty result to indicate an empty prefetched has_many
 888   }
 889   return $info;
 890 }
 891
 892 =head2 result_source
 893
 894 =over 4
 895
 896 =item Arguments: $result_source?
 897
 898 =item Return Value: $result_source
 899
 900 =back
 901
 902 An accessor for the primary ResultSource object from which this ResultSet
 903 is derived.
 904
 905 =cut
 906
 907
 908 =head2 count
 909
 910 =over 4
 911
 912 =item Arguments: $cond, \%attrs??
 913
 914 =item Return Value: $count
 915
 916 =back
 917
 918 Performs an SQL C<COUNT> with the same query as the resultset was built
 919 with to find the number of elements. If passed arguments, does a search
 920 on the resultset and counts the results of that.
 921
 922 Note: When using C<count> with C<group_by>, L<DBIX::Class> emulates C<GROUP BY>
 923 using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
 924 not support C<DISTINCT> with multiple columns. If you are using such a
 925 database, you should only use columns from the main table in your C<group_by>
 926 clause.
 927
 928 =cut
 929
 930 sub count {
 931   my $self = shift;
 932   return $self->search(@_)->count if @_ and defined $_[0];
 933   return scalar @{ $self->get_cache } if $self->get_cache;
 934
 935   my $count = $self->_count;
 936   return 0 unless $count;
 937
 938   $count -= $self->{attrs}{offset} if $self->{attrs}{offset};
 939   $count = $self->{attrs}{rows} if
 940     $self->{attrs}{rows} and $self->{attrs}{rows} < $count;
 941   return $count;
 942 }
 943
 944 sub _count { # Separated out so pager can get the full count
 945   my $self = shift;
 946   my $select = { count => '*' };
 947
 948   $self->_resolve;
 949   my $attrs = { %{ $self->{_attrs} } };
 950   if (my $group_by = delete $attrs->{group_by}) {
 951     delete $attrs->{having};
 952     my @distinct = (ref $group_by ?  @$group_by : ($group_by));
 953     # todo: try CONCAT for multi-column pk
 954     my @pk = $self->result_source->primary_columns;
 955     if (@pk == 1) {
 956       foreach my $column (@distinct) {
 957         if ($column =~ qr/^(?:\Q$attrs->{alias}.\E)?$pk[0]$/) {
 958           @distinct = ($column);
 959           last;
 960         }
 961       }
 962     }
 963
 964     $select = { count => { distinct => \@distinct } };
 965   }
 966
 967   $attrs->{select} = $select;
 968   $attrs->{as} = [qw/count/];
 969
 970   # offset, order by and page are not needed to count. record_filter is cdbi
 971   delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
 972   my ($count) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
 973   return $count;
 974 }
 975
 976 =head2 count_literal
 977
 978 =over 4
 979
 980 =item Arguments: $sql_fragment, @bind_values
 981
 982 =item Return Value: $count
 983
 984 =back
 985
 986 Counts the results in a literal query. Equivalent to calling L</search_literal>
 987 with the passed arguments, then L</count>.
 988
 989 =cut
 990
 991 sub count_literal { shift->search_literal(@_)->count; }
 992
 993 =head2 all
 994
 995 =over 4
 996
 997 =item Arguments: none
 998
 999 =item Return Value: @objects
1000
1001 =back
1002
1003 Returns all elements in the resultset. Called implicitly if the resultset
1004 is returned in list context.
1005
1006 =cut
1007
1008 sub all {
1009   my ($self) = @_;
1010   return @{ $self->get_cache } if $self->get_cache;
1011
1012   my @obj;
1013
1014   # TODO: don't call resolve here
1015   $self->_resolve;
1016   if (keys %{$self->{_attrs}->{collapse}}) {
1017 #  if ($self->{attrs}->{prefetch}) {
1018       # Using $self->cursor->all is really just an optimisation.
1019       # If we're collapsing has_many prefetches it probably makes
1020       # very little difference, and this is cleaner than hacking
1021       # _construct_object to survive the approach
1022     my @row = $self->cursor->next;
1023     while (@row) {
1024       push(@obj, $self->_construct_object(@row));
1025       @row = (exists $self->{stashed_row}
1026                ? @{delete $self->{stashed_row}}
1027                : $self->cursor->next);
1028     }
1029   } else {
1030     @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
1031   }
1032
1033   $self->set_cache(\@obj) if $self->{attrs}{cache};
1034   return @obj;
1035 }
1036
1037 =head2 reset
1038
1039 =over 4
1040
1041 =item Arguments: none
1042
1043 =item Return Value: $self
1044
1045 =back
1046
1047 Resets the resultset's cursor, so you can iterate through the elements again.
1048
1049 =cut
1050
1051 sub reset {
1052   my ($self) = @_;
1053   delete $self->{_attrs} if (exists $self->{_attrs});
1054
1055   $self->{all_cache_position} = 0;
1056   $self->cursor->reset;
1057   return $self;
1058 }
1059
1060 =head2 first
1061
1062 =over 4
1063
1064 =item Arguments: none
1065
1066 =item Return Value: $object?
1067
1068 =back
1069
1070 Resets the resultset and returns an object for the first result (if the
1071 resultset returns anything).
1072
1073 =cut
1074
1075 sub first {
1076   return $_[0]->reset->next;
1077 }
1078
1079 # _cond_for_update_delete
1080 #
1081 # update/delete require the condition to be modified to handle
1082 # the differing SQL syntax available.  This transforms the $self->{cond}
1083 # appropriately, returning the new condition.
1084
1085 sub _cond_for_update_delete {
1086   my ($self) = @_;
1087   my $cond = {};
1088
1089   if (!ref($self->{cond})) {
1090     # No-op. No condition, we're updating/deleting everything
1091   }
1092   elsif (ref $self->{cond} eq 'ARRAY') {
1093     $cond = [
1094       map {
1095         my %hash;
1096         foreach my $key (keys %{$_}) {
1097           $key =~ /([^.]+)$/;
1098           $hash{$1} = $_->{$key};
1099         }
1100         \%hash;
1101       } @{$self->{cond}}
1102     ];
1103   }
1104   elsif (ref $self->{cond} eq 'HASH') {
1105     if ((keys %{$self->{cond}})[0] eq '-and') {
1106       $cond->{-and} = [];
1107
1108       my @cond = @{$self->{cond}{-and}};
1109       for (my $i = 0; $i <= @cond - 1; $i++) {
1110         my $entry = $cond[$i];
1111
1112         my %hash;
1113         if (ref $entry eq 'HASH') {
1114           foreach my $key (keys %{$entry}) {
1115             $key =~ /([^.]+)$/;
1116             $hash{$1} = $entry->{$key};
1117           }
1118         }
1119         else {
1120           $entry =~ /([^.]+)$/;
1121           $hash{$1} = $cond[++$i];
1122         }
1123
1124         push @{$cond->{-and}}, \%hash;
1125       }
1126     }
1127     else {
1128       foreach my $key (keys %{$self->{cond}}) {
1129         $key =~ /([^.]+)$/;
1130         $cond->{$1} = $self->{cond}{$key};
1131       }
1132     }
1133   }
1134   else {
1135     $self->throw_exception(
1136       "Can't update/delete on resultset with condition unless hash or array"
1137     );
1138   }
1139
1140   return $cond;
1141 }
1142
1143
1144 =head2 update
1145
1146 =over 4
1147
1148 =item Arguments: \%values
1149
1150 =item Return Value: $storage_rv
1151
1152 =back
1153
1154 Sets the specified columns in the resultset to the supplied values in a
1155 single query. Return value will be true if the update succeeded or false
1156 if no records were updated; exact type of success value is storage-dependent.
1157
1158 =cut
1159
1160 sub update {
1161   my ($self, $values) = @_;
1162   $self->throw_exception("Values for update must be a hash")
1163     unless ref $values eq 'HASH';
1164
1165   my $cond = $self->_cond_for_update_delete;
1166
1167   return $self->result_source->storage->update(
1168     $self->result_source->from, $values, $cond
1169   );
1170 }
1171
1172 =head2 update_all
1173
1174 =over 4
1175
1176 =item Arguments: \%values
1177
1178 =item Return Value: 1
1179
1180 =back
1181
1182 Fetches all objects and updates them one at a time. Note that C<update_all>
1183 will run DBIC cascade triggers, while L</update> will not.
1184
1185 =cut
1186
1187 sub update_all {
1188   my ($self, $values) = @_;
1189   $self->throw_exception("Values for update must be a hash")
1190     unless ref $values eq 'HASH';
1191   foreach my $obj ($self->all) {
1192     $obj->set_columns($values)->update;
1193   }
1194   return 1;
1195 }
1196
1197 =head2 delete
1198
1199 =over 4
1200
1201 =item Arguments: none
1202
1203 =item Return Value: 1
1204
1205 =back
1206
1207 Deletes the contents of the resultset from its result source. Note that this
1208 will not run DBIC cascade triggers. See L</delete_all> if you need triggers
1209 to run.
1210
1211 =cut
1212
1213 sub delete {
1214   my ($self) = @_;
1215   my $del = {};
1216
1217   my $cond = $self->_cond_for_update_delete;
1218
1219   $self->result_source->storage->delete($self->result_source->from, $cond);
1220   return 1;
1221 }
1222
1223 =head2 delete_all
1224
1225 =over 4
1226
1227 =item Arguments: none
1228
1229 =item Return Value: 1
1230
1231 =back
1232
1233 Fetches all objects and deletes them one at a time. Note that C<delete_all>
1234 will run DBIC cascade triggers, while L</delete> will not.
1235
1236 =cut
1237
1238 sub delete_all {
1239   my ($self) = @_;
1240   $_->delete for $self->all;
1241   return 1;
1242 }
1243
1244 =head2 pager
1245
1246 =over 4
1247
1248 =item Arguments: none
1249
1250 =item Return Value: $pager
1251
1252 =back
1253
1254 Return Value a L<Data::Page> object for the current resultset. Only makes
1255 sense for queries with a C<page> attribute.
1256
1257 =cut
1258
1259 sub pager {
1260   my ($self) = @_;
1261   my $attrs = $self->{attrs};
1262   $self->throw_exception("Can't create pager for non-paged rs")
1263     unless $self->{page};
1264   $attrs->{rows} ||= 10;
1265   return $self->{pager} ||= Data::Page->new(
1266     $self->_count, $attrs->{rows}, $self->{page});
1267 }
1268
1269 =head2 page
1270
1271 =over 4
1272
1273 =item Arguments: $page_number
1274
1275 =item Return Value: $rs
1276
1277 =back
1278
1279 Returns a resultset for the $page_number page of the resultset on which page
1280 is called, where each page contains a number of rows equal to the 'rows'
1281 attribute set on the resultset (10 by default).
1282
1283 =cut
1284
1285 sub page {
1286   my ($self, $page) = @_;
1287   my $attrs = { %{$self->{attrs}} };
1288   $attrs->{page} = $page;
1289   return (ref $self)->new($self->result_source, $attrs);
1290 }
1291
1292 =head2 new_result
1293
1294 =over 4
1295
1296 =item Arguments: \%vals
1297
1298 =item Return Value: $object
1299
1300 =back
1301
1302 Creates an object in the resultset's result class and returns it.
1303
1304 =cut
1305
1306 sub new_result {
1307   my ($self, $values) = @_;
1308   $self->throw_exception( "new_result needs a hash" )
1309     unless (ref $values eq 'HASH');
1310   $self->throw_exception(
1311     "Can't abstract implicit construct, condition not a hash"
1312   ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
1313   my %new = %$values;
1314   my $alias = $self->{attrs}{alias};
1315   foreach my $key (keys %{$self->{cond}||{}}) {
1316     $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:\Q${alias}.\E)?([^.]+)$/);
1317   }
1318   my $obj = $self->result_class->new(\%new);
1319   $obj->result_source($self->result_source) if $obj->can('result_source');
1320   return $obj;
1321 }
1322
1323 =head2 find_or_new
1324
1325 =over 4
1326
1327 =item Arguments: \%vals, \%attrs?
1328
1329 =item Return Value: $object
1330
1331 =back
1332
1333 Find an existing record from this resultset. If none exists, instantiate a new
1334 result object and return it. The object will not be saved into your storage
1335 until you call L<DBIx::Class::Row/insert> on it.
1336
1337 If you want objects to be saved immediately, use L</find_or_create> instead.
1338
1339 =cut
1340
1341 sub find_or_new {
1342   my $self     = shift;
1343   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1344   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
1345   my $exists   = $self->find($hash, $attrs);
1346   return defined $exists ? $exists : $self->new_result($hash);
1347 }
1348
1349 =head2 create
1350
1351 =over 4
1352
1353 =item Arguments: \%vals
1354
1355 =item Return Value: $object
1356
1357 =back
1358
1359 Inserts a record into the resultset and returns the object representing it.
1360
1361 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
1362
1363 =cut
1364
1365 sub create {
1366   my ($self, $attrs) = @_;
1367   $self->throw_exception( "create needs a hashref" )
1368     unless ref $attrs eq 'HASH';
1369   return $self->new_result($attrs)->insert;
1370 }
1371
1372 =head2 find_or_create
1373
1374 =over 4
1375
1376 =item Arguments: \%vals, \%attrs?
1377
1378 =item Return Value: $object
1379
1380 =back
1381
1382   $class->find_or_create({ key => $val, ... });
1383
1384 Tries to find a record based on its primary key or unique constraint; if none
1385 is found, creates one and returns that instead.
1386
1387   my $cd = $schema->resultset('CD')->find_or_create({
1388     cdid   => 5,
1389     artist => 'Massive Attack',
1390     title  => 'Mezzanine',
1391     year   => 2005,
1392   });
1393
1394 Also takes an optional C<key> attribute, to search by a specific key or unique
1395 constraint. For example:
1396
1397   my $cd = $schema->resultset('CD')->find_or_create(
1398     {
1399       artist => 'Massive Attack',
1400       title  => 'Mezzanine',
1401     },
1402     { key => 'artist_title' }
1403   );
1404
1405 See also L</find> and L</update_or_create>. For information on how to declare
1406 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
1407
1408 =cut
1409
1410 sub find_or_create {
1411   my $self     = shift;
1412   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1413   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
1414   my $exists   = $self->find($hash, $attrs);
1415   return defined $exists ? $exists : $self->create($hash);
1416 }
1417
1418 =head2 update_or_create
1419
1420 =over 4
1421
1422 =item Arguments: \%col_values, { key => $unique_constraint }?
1423
1424 =item Return Value: $object
1425
1426 =back
1427
1428   $class->update_or_create({ col => $val, ... });
1429
1430 First, searches for an existing row matching one of the unique constraints
1431 (including the primary key) on the source of this resultset. If a row is
1432 found, updates it with the other given column values. Otherwise, creates a new
1433 row.
1434
1435 Takes an optional C<key> attribute to search on a specific unique constraint.
1436 For example:
1437
1438   # In your application
1439   my $cd = $schema->resultset('CD')->update_or_create(
1440     {
1441       artist => 'Massive Attack',
1442       title  => 'Mezzanine',
1443       year   => 1998,
1444     },
1445     { key => 'artist_title' }
1446   );
1447
1448 If no C<key> is specified, it searches on all unique constraints defined on the
1449 source, including the primary key.
1450
1451 If the C<key> is specified as C<primary>, it searches only on the primary key.
1452
1453 See also L</find> and L</find_or_create>. For information on how to declare
1454 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
1455
1456 =cut
1457
1458 sub update_or_create {
1459   my $self = shift;
1460   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1461   my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
1462
1463   my $row = $self->find($cond);
1464   if (defined $row) {
1465     $row->update($cond);
1466     return $row;
1467   }
1468
1469   return $self->create($cond);
1470 }
1471
1472 =head2 get_cache
1473
1474 =over 4
1475
1476 =item Arguments: none
1477
1478 =item Return Value: \@cache_objects?
1479
1480 =back
1481
1482 Gets the contents of the cache for the resultset, if the cache is set.
1483
1484 =cut
1485
1486 sub get_cache {
1487   shift->{all_cache};
1488 }
1489
1490 =head2 set_cache
1491
1492 =over 4
1493
1494 =item Arguments: \@cache_objects
1495
1496 =item Return Value: \@cache_objects
1497
1498 =back
1499
1500 Sets the contents of the cache for the resultset. Expects an arrayref
1501 of objects of the same class as those produced by the resultset. Note that
1502 if the cache is set the resultset will return the cached objects rather
1503 than re-querying the database even if the cache attr is not set.
1504
1505 =cut
1506
1507 sub set_cache {
1508   my ( $self, $data ) = @_;
1509   $self->throw_exception("set_cache requires an arrayref")
1510       if defined($data) && (ref $data ne 'ARRAY');
1511   $self->{all_cache} = $data;
1512 }
1513
1514 =head2 clear_cache
1515
1516 =over 4
1517
1518 =item Arguments: none
1519
1520 =item Return Value: []
1521
1522 =back
1523
1524 Clears the cache for the resultset.
1525
1526 =cut
1527
1528 sub clear_cache {
1529   shift->set_cache(undef);
1530 }
1531
1532 =head2 related_resultset
1533
1534 =over 4
1535
1536 =item Arguments: $relationship_name
1537
1538 =item Return Value: $resultset
1539
1540 =back
1541
1542 Returns a related resultset for the supplied relationship name.
1543
1544   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
1545
1546 =cut
1547
1548 sub related_resultset {
1549   my ( $self, $rel ) = @_;
1550
1551   $self->{related_resultsets} ||= {};
1552   return $self->{related_resultsets}{$rel} ||= do {
1553       #warn "fetching related resultset for rel '$rel' " . $self->result_source->{name};
1554       my $rel_obj = $self->result_source->relationship_info($rel);
1555       $self->throw_exception(
1556         "search_related: result source '" . $self->result_source->name .
1557         "' has no such relationship ${rel}")
1558         unless $rel_obj; #die Dumper $self->{attrs};
1559
1560       my $rs = $self->result_source->schema->resultset($rel_obj->{class}
1561            )->search( undef,
1562              { %{$self->{attrs}},
1563                select => undef,
1564                as => undef,
1565                join => $rel,
1566                _live_join => $rel }
1567            );
1568
1569       # keep reference of the original resultset
1570       $rs->{_parent_rs} = $self->result_source;
1571       return $rs;
1572   };
1573 }
1574
1575 =head2 throw_exception
1576
1577 See L<DBIx::Class::Schema/throw_exception> for details.
1578
1579 =cut
1580
1581 sub throw_exception {
1582   my $self=shift;
1583   $self->result_source->schema->throw_exception(@_);
1584 }
1585
1586 # XXX: FIXME: Attributes docs need clearing up
1587
1588 =head1 ATTRIBUTES
1589
1590 The resultset takes various attributes that modify its behavior. Here's an
1591 overview of them:
1592
1593 =head2 order_by
1594
1595 =over 4
1596
1597 =item Value: ($order_by | \@order_by)
1598
1599 =back
1600
1601 Which column(s) to order the results by. This is currently passed
1602 through directly to SQL, so you can give e.g. C<year DESC> for a
1603 descending order on the column `year'.
1604
1605 Please note that if you have quoting enabled (see
1606 L<DBIx::Class::Storage/quote_char>) you will need to do C<\'year DESC' > to
1607 specify an order. (The scalar ref causes it to be passed as raw sql to the DB,
1608 so you will need to manually quote things as appropriate.)
1609
1610 =head2 columns
1611
1612 =over 4
1613
1614 =item Value: \@columns
1615
1616 =back
1617
1618 Shortcut to request a particular set of columns to be retrieved.  Adds
1619 C<me.> onto the start of any column without a C<.> in it and sets C<select>
1620 from that, then auto-populates C<as> from C<select> as normal. (You may also
1621 use the C<cols> attribute, as in earlier versions of DBIC.)
1622
1623 =head2 include_columns
1624
1625 =over 4
1626
1627 =item Value: \@columns
1628
1629 =back
1630
1631 Shortcut to include additional columns in the returned results - for example
1632
1633   $schema->resultset('CD')->search(undef, {
1634     include_columns => ['artist.name'],
1635     join => ['artist']
1636   });
1637
1638 would return all CDs and include a 'name' column to the information
1639 passed to object inflation
1640
1641 =head2 select
1642
1643 =over 4
1644
1645 =item Value: \@select_columns
1646
1647 =back
1648
1649 Indicates which columns should be selected from the storage. You can use
1650 column names, or in the case of RDBMS back ends, function or stored procedure
1651 names:
1652
1653   $rs = $schema->resultset('Employee')->search(undef, {
1654     select => [
1655       'name',
1656       { count => 'employeeid' },
1657       { sum => 'salary' }
1658     ]
1659   });
1660
1661 When you use function/stored procedure names and do not supply an C<as>
1662 attribute, the column names returned are storage-dependent. E.g. MySQL would
1663 return a column named C<count(employeeid)> in the above example.
1664
1665 =head2 +select
1666
1667 =over 4
1668
1669 Indicates additional columns to be selected from storage.  Works the same as
1670 L<select> but adds columns to the selection.
1671
1672 =back
1673
1674 =head2 +as
1675
1676 =over 4
1677
1678 Indicates additional column names for those added via L<+select>.
1679
1680 =back
1681
1682 =head2 as
1683
1684 =over 4
1685
1686 =item Value: \@inflation_names
1687
1688 =back
1689
1690 Indicates column names for object inflation. This is used in conjunction with
1691 C<select>, usually when C<select> contains one or more function or stored
1692 procedure names:
1693
1694   $rs = $schema->resultset('Employee')->search(undef, {
1695     select => [
1696       'name',
1697       { count => 'employeeid' }
1698     ],
1699     as => ['name', 'employee_count'],
1700   });
1701
1702   my $employee = $rs->first(); # get the first Employee
1703
1704 If the object against which the search is performed already has an accessor
1705 matching a column name specified in C<as>, the value can be retrieved using
1706 the accessor as normal:
1707
1708   my $name = $employee->name();
1709
1710 If on the other hand an accessor does not exist in the object, you need to
1711 use C<get_column> instead:
1712
1713   my $employee_count = $employee->get_column('employee_count');
1714
1715 You can create your own accessors if required - see
1716 L<DBIx::Class::Manual::Cookbook> for details.
1717
1718 Please note: This will NOT insert an C<AS employee_count> into the SQL statement
1719 produced, it is used for internal access only. Thus attempting to use the accessor
1720 in an C<order_by> clause or similar will fail misrably.
1721
1722 =head2 join
1723
1724 =over 4
1725
1726 =item Value: ($rel_name | \@rel_names | \%rel_names)
1727
1728 =back
1729
1730 Contains a list of relationships that should be joined for this query.  For
1731 example:
1732
1733   # Get CDs by Nine Inch Nails
1734   my $rs = $schema->resultset('CD')->search(
1735     { 'artist.name' => 'Nine Inch Nails' },
1736     { join => 'artist' }
1737   );
1738
1739 Can also contain a hash reference to refer to the other relation's relations.
1740 For example:
1741
1742   package MyApp::Schema::Track;
1743   use base qw/DBIx::Class/;
1744   __PACKAGE__->table('track');
1745   __PACKAGE__->add_columns(qw/trackid cd position title/);
1746   __PACKAGE__->set_primary_key('trackid');
1747   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
1748   1;
1749
1750   # In your application
1751   my $rs = $schema->resultset('Artist')->search(
1752     { 'track.title' => 'Teardrop' },
1753     {
1754       join     => { cd => 'track' },
1755       order_by => 'artist.name',
1756     }
1757   );
1758
1759 If the same join is supplied twice, it will be aliased to <rel>_2 (and
1760 similarly for a third time). For e.g.
1761
1762   my $rs = $schema->resultset('Artist')->search({
1763     'cds.title'   => 'Down to Earth',
1764     'cds_2.title' => 'Popular',
1765   }, {
1766     join => [ qw/cds cds/ ],
1767   });
1768
1769 will return a set of all artists that have both a cd with title 'Down
1770 to Earth' and a cd with title 'Popular'.
1771
1772 If you want to fetch related objects from other tables as well, see C<prefetch>
1773 below.
1774
1775 =head2 prefetch
1776
1777 =over 4
1778
1779 =item Value: ($rel_name | \@rel_names | \%rel_names)
1780
1781 =back
1782
1783 Contains one or more relationships that should be fetched along with the main
1784 query (when they are accessed afterwards they will have already been
1785 "prefetched").  This is useful for when you know you will need the related
1786 objects, because it saves at least one query:
1787
1788   my $rs = $schema->resultset('Tag')->search(
1789     undef,
1790     {
1791       prefetch => {
1792         cd => 'artist'
1793       }
1794     }
1795   );
1796
1797 The initial search results in SQL like the following:
1798
1799   SELECT tag.*, cd.*, artist.* FROM tag
1800   JOIN cd ON tag.cd = cd.cdid
1801   JOIN artist ON cd.artist = artist.artistid
1802
1803 L<DBIx::Class> has no need to go back to the database when we access the
1804 C<cd> or C<artist> relationships, which saves us two SQL statements in this
1805 case.
1806
1807 Simple prefetches will be joined automatically, so there is no need
1808 for a C<join> attribute in the above search. If you're prefetching to
1809 depth (e.g. { cd => { artist => 'label' } or similar), you'll need to
1810 specify the join as well.
1811
1812 C<prefetch> can be used with the following relationship types: C<belongs_to>,
1813 C<has_one> (or if you're using C<add_relationship>, any relationship declared
1814 with an accessor type of 'single' or 'filter').
1815
1816 =head2 page
1817
1818 =over 4
1819
1820 =item Value: $page
1821
1822 =back
1823
1824 Makes the resultset paged and specifies the page to retrieve. Effectively
1825 identical to creating a non-pages resultset and then calling ->page($page)
1826 on it.
1827
1828 If L<rows> attribute is not specified it defualts to 10 rows per page.
1829
1830 =head2 rows
1831
1832 =over 4
1833
1834 =item Value: $rows
1835
1836 =back
1837
1838 Specifes the maximum number of rows for direct retrieval or the number of
1839 rows per page if the page attribute or method is used.
1840
1841 =head2 offset
1842
1843 =over 4
1844
1845 =item Value: $offset
1846
1847 =back
1848
1849 Specifies the (zero-based) row number for the  first row to be returned, or the
1850 of the first row of the first page if paging is used.
1851
1852 =head2 group_by
1853
1854 =over 4
1855
1856 =item Value: \@columns
1857
1858 =back
1859
1860 A arrayref of columns to group by. Can include columns of joined tables.
1861
1862   group_by => [qw/ column1 column2 ... /]
1863
1864 =head2 having
1865
1866 =over 4
1867
1868 =item Value: $condition
1869
1870 =back
1871
1872 HAVING is a select statement attribute that is applied between GROUP BY and
1873 ORDER BY. It is applied to the after the grouping calculations have been
1874 done.
1875
1876   having => { 'count(employee)' => { '>=', 100 } }
1877
1878 =head2 distinct
1879
1880 =over 4
1881
1882 =item Value: (0 | 1)
1883
1884 =back
1885
1886 Set to 1 to group by all columns.
1887
1888 =head2 cache
1889
1890 Set to 1 to cache search results. This prevents extra SQL queries if you
1891 revisit rows in your ResultSet:
1892
1893   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
1894
1895   while( my $artist = $resultset->next ) {
1896     ... do stuff ...
1897   }
1898
1899   $rs->first; # without cache, this would issue a query
1900
1901 By default, searches are not cached.
1902
1903 For more examples of using these attributes, see
1904 L<DBIx::Class::Manual::Cookbook>.
1905
1906 =head2 from
1907
1908 =over 4
1909
1910 =item Value: \@from_clause
1911
1912 =back
1913
1914 The C<from> attribute gives you manual control over the C<FROM> clause of SQL
1915 statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
1916 clauses.
1917
1918 NOTE: Use this on your own risk.  This allows you to shoot off your foot!
1919
1920 C<join> will usually do what you need and it is strongly recommended that you
1921 avoid using C<from> unless you cannot achieve the desired result using C<join>.
1922 And we really do mean "cannot", not just tried and failed. Attempting to use
1923 this because you're having problems with C<join> is like trying to use x86
1924 ASM because you've got a syntax error in your C. Trust us on this.
1925
1926 Now, if you're still really, really sure you need to use this (and if you're
1927 not 100% sure, ask the mailing list first), here's an explanation of how this
1928 works.
1929
1930 The syntax is as follows -
1931
1932   [
1933     { <alias1> => <table1> },
1934     [
1935       { <alias2> => <table2>, -join_type => 'inner|left|right' },
1936       [], # nested JOIN (optional)
1937       { <table1.column1> => <table2.column2>, ... (more conditions) },
1938     ],
1939     # More of the above [ ] may follow for additional joins
1940   ]
1941
1942   <table1> <alias1>
1943   JOIN
1944     <table2> <alias2>
1945     [JOIN ...]
1946   ON <table1.column1> = <table2.column2>
1947   <more joins may follow>
1948
1949 An easy way to follow the examples below is to remember the following:
1950
1951     Anything inside "[]" is a JOIN
1952     Anything inside "{}" is a condition for the enclosing JOIN
1953
1954 The following examples utilize a "person" table in a family tree application.
1955 In order to express parent->child relationships, this table is self-joined:
1956
1957     # Person->belongs_to('father' => 'Person');
1958     # Person->belongs_to('mother' => 'Person');
1959
1960 C<from> can be used to nest joins. Here we return all children with a father,
1961 then search against all mothers of those children:
1962
1963   $rs = $schema->resultset('Person')->search(
1964       undef,
1965       {
1966           alias => 'mother', # alias columns in accordance with "from"
1967           from => [
1968               { mother => 'person' },
1969               [
1970                   [
1971                       { child => 'person' },
1972                       [
1973                           { father => 'person' },
1974                           { 'father.person_id' => 'child.father_id' }
1975                       ]
1976                   ],
1977                   { 'mother.person_id' => 'child.mother_id' }
1978               ],
1979           ]
1980       },
1981   );
1982
1983   # Equivalent SQL:
1984   # SELECT mother.* FROM person mother
1985   # JOIN (
1986   #   person child
1987   #   JOIN person father
1988   #   ON ( father.person_id = child.father_id )
1989   # )
1990   # ON ( mother.person_id = child.mother_id )
1991
1992 The type of any join can be controlled manually. To search against only people
1993 with a father in the person table, we could explicitly use C<INNER JOIN>:
1994
1995     $rs = $schema->resultset('Person')->search(
1996         undef,
1997         {
1998             alias => 'child', # alias columns in accordance with "from"
1999             from => [
2000                 { child => 'person' },
2001                 [
2002                     { father => 'person', -join_type => 'inner' },
2003                     { 'father.id' => 'child.father_id' }
2004                 ],
2005             ]
2006         },
2007     );
2008
2009     # Equivalent SQL:
2010     # SELECT child.* FROM person child
2011     # INNER JOIN person father ON child.father_id = father.id
2012
2013 =cut
2014
2015 1;