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