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