lib/DBIx/Class/ResultSet.pm

   1 package DBIx::Class::ResultSet;
   2
   3 use strict;
   4 use warnings;
   5 use base qw/DBIx::Class/;
   6 use DBIx::Class::Carp;
   7 use DBIx::Class::Exception;
   8 use DBIx::Class::ResultSetColumn;
   9 use Scalar::Util qw/blessed weaken/;
  10 use Try::Tiny;
  11 use Data::Compare (); # no imports!!! guard against insane architecture
  12
  13 # not importing first() as it will clash with our own method
  14 use List::Util ();
  15
  16 BEGIN {
  17   # De-duplication in _merge_attr() is disabled, but left in for reference
  18   # (the merger is used for other things that ought not to be de-duped)
  19   *__HM_DEDUP = sub () { 0 };
  20 }
  21
  22 use namespace::clean;
  23
  24 use overload
  25         '0+'     => "count",
  26         'bool'   => "_bool",
  27         fallback => 1;
  28
  29 __PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/);
  30
  31 =head1 NAME
  32
  33 DBIx::Class::ResultSet - Represents a query used for fetching a set of results.
  34
  35 =head1 SYNOPSIS
  36
  37   my $users_rs   = $schema->resultset('User');
  38   while( $user = $users_rs->next) {
  39     print $user->username;
  40   }
  41
  42   my $registered_users_rs   = $schema->resultset('User')->search({ registered => 1 });
  43   my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all();
  44
  45 =head1 DESCRIPTION
  46
  47 A ResultSet is an object which stores a set of conditions representing
  48 a query. It is the backbone of DBIx::Class (i.e. the really
  49 important/useful bit).
  50
  51 No SQL is executed on the database when a ResultSet is created, it
  52 just stores all the conditions needed to create the query.
  53
  54 A basic ResultSet representing the data of an entire table is returned
  55 by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
  56 L<Source|DBIx::Class::Manual::Glossary/Source> name.
  57
  58   my $users_rs = $schema->resultset('User');
  59
  60 A new ResultSet is returned from calling L</search> on an existing
  61 ResultSet. The new one will contain all the conditions of the
  62 original, plus any new conditions added in the C<search> call.
  63
  64 A ResultSet also incorporates an implicit iterator. L</next> and L</reset>
  65 can be used to walk through all the L<DBIx::Class::Row>s the ResultSet
  66 represents.
  67
  68 The query that the ResultSet represents is B<only> executed against
  69 the database when these methods are called:
  70 L</find>, L</next>, L</all>, L</first>, L</single>, L</count>.
  71
  72 If a resultset is used in a numeric context it returns the L</count>.
  73 However, if it is used in a boolean context it is B<always> true.  So if
  74 you want to check if a resultset has any results, you must use C<if $rs
  75 != 0>.
  76
  77 =head1 CUSTOM ResultSet CLASSES THAT USE Moose
  78
  79 If you want to make your custom ResultSet classes with L<Moose>, use a template
  80 similar to:
  81
  82     package MyApp::Schema::ResultSet::User;
  83
  84     use Moose;
  85     use namespace::autoclean;
  86     use MooseX::NonMoose;
  87     extends 'DBIx::Class::ResultSet';
  88
  89     sub BUILDARGS { $_[2] }
  90
  91     ...your code...
  92
  93     __PACKAGE__->meta->make_immutable;
  94
  95     1;
  96
  97 The L<MooseX::NonMoose> is necessary so that the L<Moose> constructor does not
  98 clash with the regular ResultSet constructor. Alternatively, you can use:
  99
 100     __PACKAGE__->meta->make_immutable(inline_constructor => 0);
 101
 102 The L<BUILDARGS|Moose::Manual::Construction/BUILDARGS> is necessary because the
 103 signature of the ResultSet C<new> is C<< ->new($source, \%args) >>.
 104
 105 =head1 EXAMPLES
 106
 107 =head2 Chaining resultsets
 108
 109 Let's say you've got a query that needs to be run to return some data
 110 to the user. But, you have an authorization system in place that
 111 prevents certain users from seeing certain information. So, you want
 112 to construct the basic query in one method, but add constraints to it in
 113 another.
 114
 115   sub get_data {
 116     my $self = shift;
 117     my $request = $self->get_request; # Get a request object somehow.
 118     my $schema = $self->result_source->schema;
 119
 120     my $cd_rs = $schema->resultset('CD')->search({
 121       title => $request->param('title'),
 122       year => $request->param('year'),
 123     });
 124
 125     $cd_rs = $self->apply_security_policy( $cd_rs );
 126
 127     return $cd_rs->all();
 128   }
 129
 130   sub apply_security_policy {
 131     my $self = shift;
 132     my ($rs) = @_;
 133
 134     return $rs->search({
 135       subversive => 0,
 136     });
 137   }
 138
 139 =head3 Resolving conditions and attributes
 140
 141 When a resultset is chained from another resultset, conditions and
 142 attributes with the same keys need resolving.
 143
 144 L</join>, L</prefetch>, L</+select>, L</+as> attributes are merged
 145 into the existing ones from the original resultset.
 146
 147 The L</where> and L</having> attributes, and any search conditions, are
 148 merged with an SQL C<AND> to the existing condition from the original
 149 resultset.
 150
 151 All other attributes are overridden by any new ones supplied in the
 152 search attributes.
 153
 154 =head2 Multiple queries
 155
 156 Since a resultset just defines a query, you can do all sorts of
 157 things with it with the same object.
 158
 159   # Don't hit the DB yet.
 160   my $cd_rs = $schema->resultset('CD')->search({
 161     title => 'something',
 162     year => 2009,
 163   });
 164
 165   # Each of these hits the DB individually.
 166   my $count = $cd_rs->count;
 167   my $most_recent = $cd_rs->get_column('date_released')->max();
 168   my @records = $cd_rs->all;
 169
 170 And it's not just limited to SELECT statements.
 171
 172   $cd_rs->delete();
 173
 174 This is even cooler:
 175
 176   $cd_rs->create({ artist => 'Fred' });
 177
 178 Which is the same as:
 179
 180   $schema->resultset('CD')->create({
 181     title => 'something',
 182     year => 2009,
 183     artist => 'Fred'
 184   });
 185
 186 See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
 187
 188 =head1 METHODS
 189
 190 =head2 new
 191
 192 =over 4
 193
 194 =item Arguments: $source, \%$attrs
 195
 196 =item Return Value: $rs
 197
 198 =back
 199
 200 The resultset constructor. Takes a source object (usually a
 201 L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
 202 L</ATTRIBUTES> below).  Does not perform any queries -- these are
 203 executed as needed by the other methods.
 204
 205 Generally you won't need to construct a resultset manually.  You'll
 206 automatically get one from e.g. a L</search> called in scalar context:
 207
 208   my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
 209
 210 IMPORTANT: If called on an object, proxies to new_result instead so
 211
 212   my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
 213
 214 will return a CD object, not a ResultSet.
 215
 216 =cut
 217
 218 sub new {
 219   my $class = shift;
 220   return $class->new_result(@_) if ref $class;
 221
 222   my ($source, $attrs) = @_;
 223   $source = $source->resolve
 224     if $source->isa('DBIx::Class::ResultSourceHandle');
 225   $attrs = { %{$attrs||{}} };
 226
 227   if ($attrs->{page}) {
 228     $attrs->{rows} ||= 10;
 229   }
 230
 231   $attrs->{alias} ||= 'me';
 232
 233   my $self = bless {
 234     result_source => $source,
 235     cond => $attrs->{where},
 236     pager => undef,
 237     attrs => $attrs,
 238   }, $class;
 239
 240   # if there is a dark selector, this means we are already in a
 241   # chain and the cleanup/sanification was taken care of by
 242   # _search_rs already
 243   $self->_normalize_selection($attrs)
 244     unless $attrs->{_dark_selector};
 245
 246   $self->result_class(
 247     $attrs->{result_class} || $source->result_class
 248   );
 249
 250   $self;
 251 }
 252
 253 =head2 search
 254
 255 =over 4
 256
 257 =item Arguments: $cond, \%attrs?
 258
 259 =item Return Value: $resultset (scalar context) ||  @row_objs (list context)
 260
 261 =back
 262
 263   my @cds    = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
 264   my $new_rs = $cd_rs->search({ year => 2005 });
 265
 266   my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
 267                  # year = 2005 OR year = 2004
 268
 269 In list context, C<< ->all() >> is called implicitly on the resultset, thus
 270 returning a list of row objects instead. To avoid that, use L</search_rs>.
 271
 272 If you need to pass in additional attributes but no additional condition,
 273 call it as C<search(undef, \%attrs)>.
 274
 275   # "SELECT name, artistid FROM $artist_table"
 276   my @all_artists = $schema->resultset('Artist')->search(undef, {
 277     columns => [qw/name artistid/],
 278   });
 279
 280 For a list of attributes that can be passed to C<search>, see
 281 L</ATTRIBUTES>. For more examples of using this function, see
 282 L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
 283 documentation for the first argument, see L<SQL::Abstract>
 284 and its extension L<DBIx::Class::SQLMaker>.
 285
 286 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
 287
 288 =head3 CAVEAT
 289
 290 Note that L</search> does not process/deflate any of the values passed in the
 291 L<SQL::Abstract>-compatible search condition structure. This is unlike other
 292 condition-bound methods L</new>, L</create> and L</find>. The user must ensure
 293 manually that any value passed to this method will stringify to something the
 294 RDBMS knows how to deal with. A notable example is the handling of L<DateTime>
 295 objects, for more info see:
 296 L<DBIx::Class::Manual::Cookbook/Formatting DateTime objects in queries>.
 297
 298 =cut
 299
 300 sub search {
 301   my $self = shift;
 302   my $rs = $self->search_rs( @_ );
 303
 304   if (wantarray) {
 305     return $rs->all;
 306   }
 307   elsif (defined wantarray) {
 308     return $rs;
 309   }
 310   else {
 311     # we can be called by a relationship helper, which in
 312     # turn may be called in void context due to some braindead
 313     # overload or whatever else the user decided to be clever
 314     # at this particular day. Thus limit the exception to
 315     # external code calls only
 316     $self->throw_exception ('->search is *not* a mutator, calling it in void context makes no sense')
 317       if (caller)[0] !~ /^\QDBIx::Class::/;
 318
 319     return ();
 320   }
 321 }
 322
 323 =head2 search_rs
 324
 325 =over 4
 326
 327 =item Arguments: $cond, \%attrs?
 328
 329 =item Return Value: $resultset
 330
 331 =back
 332
 333 This method does the same exact thing as search() except it will
 334 always return a resultset, even in list context.
 335
 336 =cut
 337
 338 sub search_rs {
 339   my $self = shift;
 340
 341   # Special-case handling for (undef, undef).
 342   if ( @_ == 2 && !defined $_[1] && !defined $_[0] ) {
 343     @_ = ();
 344   }
 345
 346   my $call_attrs = {};
 347   if (@_ > 1) {
 348     if (ref $_[-1] eq 'HASH') {
 349       # copy for _normalize_selection
 350       $call_attrs = { %{ pop @_ } };
 351     }
 352     elsif (! defined $_[-1] ) {
 353       pop @_;   # search({}, undef)
 354     }
 355   }
 356
 357   # see if we can keep the cache (no $rs changes)
 358   my $cache;
 359   my %safe = (alias => 1, cache => 1);
 360   if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and (
 361     ! defined $_[0]
 362       or
 363     ref $_[0] eq 'HASH' && ! keys %{$_[0]}
 364       or
 365     ref $_[0] eq 'ARRAY' && ! @{$_[0]}
 366   )) {
 367     $cache = $self->get_cache;
 368   }
 369
 370   my $rsrc = $self->result_source;
 371
 372   my $old_attrs = { %{$self->{attrs}} };
 373   my $old_having = delete $old_attrs->{having};
 374   my $old_where = delete $old_attrs->{where};
 375
 376   my $new_attrs = { %$old_attrs };
 377
 378   # take care of call attrs (only if anything is changing)
 379   if (keys %$call_attrs) {
 380
 381     my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/;
 382
 383     # reset the current selector list if new selectors are supplied
 384     if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) {
 385       delete @{$old_attrs}{(@selector_attrs, '_dark_selector')};
 386     }
 387
 388     # Normalize the new selector list (operates on the passed-in attr structure)
 389     # Need to do it on every chain instead of only once on _resolved_attrs, in
 390     # order to allow detection of empty vs partial 'as'
 391     $call_attrs->{_dark_selector} = $old_attrs->{_dark_selector}
 392       if $old_attrs->{_dark_selector};
 393     $self->_normalize_selection ($call_attrs);
 394
 395     # start with blind overwriting merge, exclude selector attrs
 396     $new_attrs = { %{$old_attrs}, %{$call_attrs} };
 397     delete @{$new_attrs}{@selector_attrs};
 398
 399     for (@selector_attrs) {
 400       $new_attrs->{$_} = $self->_merge_attr($old_attrs->{$_}, $call_attrs->{$_})
 401         if ( exists $old_attrs->{$_} or exists $call_attrs->{$_} );
 402     }
 403
 404     # older deprecated name, use only if {columns} is not there
 405     if (my $c = delete $new_attrs->{cols}) {
 406       if ($new_attrs->{columns}) {
 407         carp "Resultset specifies both the 'columns' and the legacy 'cols' attributes - ignoring 'cols'";
 408       }
 409       else {
 410         $new_attrs->{columns} = $c;
 411       }
 412     }
 413
 414
 415     # join/prefetch use their own crazy merging heuristics
 416     foreach my $key (qw/join prefetch/) {
 417       $new_attrs->{$key} = $self->_merge_joinpref_attr($old_attrs->{$key}, $call_attrs->{$key})
 418         if exists $call_attrs->{$key};
 419     }
 420
 421     # stack binds together
 422     $new_attrs->{bind} = [ @{ $old_attrs->{bind} || [] }, @{ $call_attrs->{bind} || [] } ];
 423   }
 424
 425
 426   # rip apart the rest of @_, parse a condition
 427   my $call_cond = do {
 428
 429     if (ref $_[0] eq 'HASH') {
 430       (keys %{$_[0]}) ? $_[0] : undef
 431     }
 432     elsif (@_ == 1) {
 433       $_[0]
 434     }
 435     elsif (@_ % 2) {
 436       $self->throw_exception('Odd number of arguments to search')
 437     }
 438     else {
 439       +{ @_ }
 440     }
 441
 442   } if @_;
 443
 444   if( @_ > 1 and ! $rsrc->result_class->isa('DBIx::Class::CDBICompat') ) {
 445     carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead';
 446   }
 447
 448   for ($old_where, $call_cond) {
 449     if (defined $_) {
 450       $new_attrs->{where} = $self->_stack_cond (
 451         $_, $new_attrs->{where}
 452       );
 453     }
 454   }
 455
 456   if (defined $old_having) {
 457     $new_attrs->{having} = $self->_stack_cond (
 458       $old_having, $new_attrs->{having}
 459     )
 460   }
 461
 462   my $rs = (ref $self)->new($rsrc, $new_attrs);
 463
 464   $rs->set_cache($cache) if ($cache);
 465
 466   return $rs;
 467 }
 468
 469 my $dark_sel_dumper;
 470 sub _normalize_selection {
 471   my ($self, $attrs) = @_;
 472
 473   # legacy syntax
 474   $attrs->{'+columns'} = $self->_merge_attr($attrs->{'+columns'}, delete $attrs->{include_columns})
 475     if exists $attrs->{include_columns};
 476
 477   # columns are always placed first, however
 478
 479   # Keep the X vs +X separation until _resolved_attrs time - this allows to
 480   # delay the decision on whether to use a default select list ($rsrc->columns)
 481   # allowing stuff like the remove_columns helper to work
 482   #
 483   # select/as +select/+as pairs need special handling - the amount of select/as
 484   # elements in each pair does *not* have to be equal (think multicolumn
 485   # selectors like distinct(foo, bar) ). If the selector is bare (no 'as'
 486   # supplied at all) - try to infer the alias, either from the -as parameter
 487   # of the selector spec, or use the parameter whole if it looks like a column
 488   # name (ugly legacy heuristic). If all fails - leave the selector bare (which
 489   # is ok as well), but make sure no more additions to the 'as' chain take place
 490   for my $pref ('', '+') {
 491
 492     my ($sel, $as) = map {
 493       my $key = "${pref}${_}";
 494
 495       my $val = [ ref $attrs->{$key} eq 'ARRAY'
 496         ? @{$attrs->{$key}}
 497         : $attrs->{$key} || ()
 498       ];
 499       delete $attrs->{$key};
 500       $val;
 501     } qw/select as/;
 502
 503     if (! @$as and ! @$sel ) {
 504       next;
 505     }
 506     elsif (@$as and ! @$sel) {
 507       $self->throw_exception(
 508         "Unable to handle ${pref}as specification (@$as) without a corresponding ${pref}select"
 509       );
 510     }
 511     elsif( ! @$as ) {
 512       # no as part supplied at all - try to deduce (unless explicit end of named selection is declared)
 513       # if any @$as has been supplied we assume the user knows what (s)he is doing
 514       # and blindly keep stacking up pieces
 515       unless ($attrs->{_dark_selector}) {
 516         SELECTOR:
 517         for (@$sel) {
 518           if ( ref $_ eq 'HASH' and exists $_->{-as} ) {
 519             push @$as, $_->{-as};
 520           }
 521           # assume any plain no-space, no-parenthesis string to be a column spec
 522           # FIXME - this is retarded but is necessary to support shit like 'count(foo)'
 523           elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) {
 524             push @$as, $_;
 525           }
 526           # if all else fails - raise a flag that no more aliasing will be allowed
 527           else {
 528             $attrs->{_dark_selector} = {
 529               plus_stage => $pref,
 530               string => ($dark_sel_dumper ||= do {
 531                   require Data::Dumper::Concise;
 532                   Data::Dumper::Concise::DumperObject()->Indent(0);
 533                 })->Values([$_])->Dump
 534               ,
 535             };
 536             last SELECTOR;
 537           }
 538         }
 539       }
 540     }
 541     elsif (@$as < @$sel) {
 542       $self->throw_exception(
 543         "Unable to handle an ${pref}as specification (@$as) with less elements than the corresponding ${pref}select"
 544       );
 545     }
 546     elsif ($pref and $attrs->{_dark_selector}) {
 547       $self->throw_exception(
 548         "Unable to process named '+select', resultset contains an unnamed selector $attrs->{_dark_selector}{string}"
 549       );
 550     }
 551
 552
 553     # merge result
 554     $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel);
 555     $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as);
 556   }
 557 }
 558
 559 sub _stack_cond {
 560   my ($self, $left, $right) = @_;
 561
 562   # collapse single element top-level conditions
 563   # (single pass only, unlikely to need recursion)
 564   for ($left, $right) {
 565     if (ref $_ eq 'ARRAY') {
 566       if (@$_ == 0) {
 567         $_ = undef;
 568       }
 569       elsif (@$_ == 1) {
 570         $_ = $_->[0];
 571       }
 572     }
 573     elsif (ref $_ eq 'HASH') {
 574       my ($first, $more) = keys %$_;
 575
 576       # empty hash
 577       if (! defined $first) {
 578         $_ = undef;
 579       }
 580       # one element hash
 581       elsif (! defined $more) {
 582         if ($first eq '-and' and ref $_->{'-and'} eq 'HASH') {
 583           $_ = $_->{'-and'};
 584         }
 585         elsif ($first eq '-or' and ref $_->{'-or'} eq 'ARRAY') {
 586           $_ = $_->{'-or'};
 587         }
 588       }
 589     }
 590   }
 591
 592   # merge hashes with weeding out of duplicates (simple cases only)
 593   if (ref $left eq 'HASH' and ref $right eq 'HASH') {
 594
 595     # shallow copy to destroy
 596     $right = { %$right };
 597     for (grep { exists $right->{$_} } keys %$left) {
 598       # the use of eq_deeply here is justified - the rhs of an
 599       # expression can contain a lot of twisted weird stuff
 600       delete $right->{$_} if Data::Compare::Compare( $left->{$_}, $right->{$_} );
 601     }
 602
 603     $right = undef unless keys %$right;
 604   }
 605
 606
 607   if (defined $left xor defined $right) {
 608     return defined $left ? $left : $right;
 609   }
 610   elsif (! defined $left) {
 611     return undef;
 612   }
 613   else {
 614     return { -and => [ $left, $right ] };
 615   }
 616 }
 617
 618 =head2 search_literal
 619
 620 =over 4
 621
 622 =item Arguments: $sql_fragment, @bind_values
 623
 624 =item Return Value: $resultset (scalar context) || @row_objs (list context)
 625
 626 =back
 627
 628   my @cds   = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
 629   my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
 630
 631 Pass a literal chunk of SQL to be added to the conditional part of the
 632 resultset query.
 633
 634 CAVEAT: C<search_literal> is provided for Class::DBI compatibility and should
 635 only be used in that context. C<search_literal> is a convenience method.
 636 It is equivalent to calling $schema->search(\[]), but if you want to ensure
 637 columns are bound correctly, use C<search>.
 638
 639 Example of how to use C<search> instead of C<search_literal>
 640
 641   my @cds = $cd_rs->search_literal('cdid = ? AND (artist = ? OR artist = ?)', (2, 1, 2));
 642   my @cds = $cd_rs->search(\[ 'cdid = ? AND (artist = ? OR artist = ?)', [ 'cdid', 2 ], [ 'artist', 1 ], [ 'artist', 2 ] ]);
 643
 644
 645 See L<DBIx::Class::Manual::Cookbook/Searching> and
 646 L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
 647 require C<search_literal>.
 648
 649 =cut
 650
 651 sub search_literal {
 652   my ($self, $sql, @bind) = @_;
 653   my $attr;
 654   if ( @bind && ref($bind[-1]) eq 'HASH' ) {
 655     $attr = pop @bind;
 656   }
 657   return $self->search(\[ $sql, map [ __DUMMY__ => $_ ], @bind ], ($attr || () ));
 658 }
 659
 660 =head2 find
 661
 662 =over 4
 663
 664 =item Arguments: \%columns_values | @pk_values, \%attrs?
 665
 666 =item Return Value: $row_object | undef
 667
 668 =back
 669
 670 Finds and returns a single row based on supplied criteria. Takes either a
 671 hashref with the same format as L</create> (including inference of foreign
 672 keys from related objects), or a list of primary key values in the same
 673 order as the L<primary columns|DBIx::Class::ResultSource/primary_columns>
 674 declaration on the L</result_source>.
 675
 676 In either case an attempt is made to combine conditions already existing on
 677 the resultset with the condition passed to this method.
 678
 679 To aid with preparing the correct query for the storage you may supply the
 680 C<key> attribute, which is the name of a
 681 L<unique constraint|DBIx::Class::ResultSource/add_unique_constraint> (the
 682 unique constraint corresponding to the
 683 L<primary columns|DBIx::Class::ResultSource/primary_columns> is always named
 684 C<primary>). If the C<key> attribute has been supplied, and DBIC is unable
 685 to construct a query that satisfies the named unique constraint fully (
 686 non-NULL values for each column member of the constraint) an exception is
 687 thrown.
 688
 689 If no C<key> is specified, the search is carried over all unique constraints
 690 which are fully defined by the available condition.
 691
 692 If no such constraint is found, C<find> currently defaults to a simple
 693 C<< search->(\%column_values) >> which may or may not do what you expect.
 694 Note that this fallback behavior may be deprecated in further versions. If
 695 you need to search with arbitrary conditions - use L</search>. If the query
 696 resulting from this fallback produces more than one row, a warning to the
 697 effect is issued, though only the first row is constructed and returned as
 698 C<$row_object>.
 699
 700 In addition to C<key>, L</find> recognizes and applies standard
 701 L<resultset attributes|/ATTRIBUTES> in the same way as L</search> does.
 702
 703 Note that if you have extra concerns about the correctness of the resulting
 704 query you need to specify the C<key> attribute and supply the entire condition
 705 as an argument to find (since it is not always possible to perform the
 706 combination of the resultset condition with the supplied one, especially if
 707 the resultset condition contains literal sql).
 708
 709 For example, to find a row by its primary key:
 710
 711   my $cd = $schema->resultset('CD')->find(5);
 712
 713 You can also find a row by a specific unique constraint:
 714
 715   my $cd = $schema->resultset('CD')->find(
 716     {
 717       artist => 'Massive Attack',
 718       title  => 'Mezzanine',
 719     },
 720     { key => 'cd_artist_title' }
 721   );
 722
 723 See also L</find_or_create> and L</update_or_create>.
 724
 725 =cut
 726
 727 sub find {
 728   my $self = shift;
 729   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 730
 731   my $rsrc = $self->result_source;
 732
 733   my $constraint_name;
 734   if (exists $attrs->{key}) {
 735     $constraint_name = defined $attrs->{key}
 736       ? $attrs->{key}
 737       : $self->throw_exception("An undefined 'key' resultset attribute makes no sense")
 738     ;
 739   }
 740
 741   # Parse out the condition from input
 742   my $call_cond;
 743
 744   if (ref $_[0] eq 'HASH') {
 745     $call_cond = { %{$_[0]} };
 746   }
 747   else {
 748     # if only values are supplied we need to default to 'primary'
 749     $constraint_name = 'primary' unless defined $constraint_name;
 750
 751     my @c_cols = $rsrc->unique_constraint_columns($constraint_name);
 752
 753     $self->throw_exception(
 754       "No constraint columns, maybe a malformed '$constraint_name' constraint?"
 755     ) unless @c_cols;
 756
 757     $self->throw_exception (
 758       'find() expects either a column/value hashref, or a list of values '
 759     . "corresponding to the columns of the specified unique constraint '$constraint_name'"
 760     ) unless @c_cols == @_;
 761
 762     $call_cond = {};
 763     @{$call_cond}{@c_cols} = @_;
 764   }
 765
 766   my %related;
 767   for my $key (keys %$call_cond) {
 768     if (
 769       my $keyref = ref($call_cond->{$key})
 770         and
 771       my $relinfo = $rsrc->relationship_info($key)
 772     ) {
 773       my $val = delete $call_cond->{$key};
 774
 775       next if $keyref eq 'ARRAY'; # has_many for multi_create
 776
 777       my $rel_q = $rsrc->_resolve_condition(
 778         $relinfo->{cond}, $val, $key, $key
 779       );
 780       die "Can't handle complex relationship conditions in find" if ref($rel_q) ne 'HASH';
 781       @related{keys %$rel_q} = values %$rel_q;
 782     }
 783   }
 784
 785   # relationship conditions take precedence (?)
 786   @{$call_cond}{keys %related} = values %related;
 787
 788   my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
 789   my $final_cond;
 790   if (defined $constraint_name) {
 791     $final_cond = $self->_qualify_cond_columns (
 792
 793       $self->_build_unique_cond (
 794         $constraint_name,
 795         $call_cond,
 796       ),
 797
 798       $alias,
 799     );
 800   }
 801   elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') {
 802     # This means that we got here after a merger of relationship conditions
 803     # in ::Relationship::Base::search_related (the row method), and furthermore
 804     # the relationship is of the 'single' type. This means that the condition
 805     # provided by the relationship (already attached to $self) is sufficient,
 806     # as there can be only one row in the database that would satisfy the
 807     # relationship
 808   }
 809   else {
 810     # no key was specified - fall down to heuristics mode:
 811     # run through all unique queries registered on the resultset, and
 812     # 'OR' all qualifying queries together
 813     my (@unique_queries, %seen_column_combinations);
 814     for my $c_name ($rsrc->unique_constraint_names) {
 815       next if $seen_column_combinations{
 816         join "\x00", sort $rsrc->unique_constraint_columns($c_name)
 817       }++;
 818
 819       push @unique_queries, try {
 820         $self->_build_unique_cond ($c_name, $call_cond, 'croak_on_nulls')
 821       } || ();
 822     }
 823
 824     $final_cond = @unique_queries
 825       ? [ map { $self->_qualify_cond_columns($_, $alias) } @unique_queries ]
 826       : $self->_non_unique_find_fallback ($call_cond, $attrs)
 827     ;
 828   }
 829
 830   # Run the query, passing the result_class since it should propagate for find
 831   my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs});
 832   if ($rs->_resolved_attrs->{collapse}) {
 833     my $row = $rs->next;
 834     carp "Query returned more than one row" if $rs->next;
 835     return $row;
 836   }
 837   else {
 838     return $rs->single;
 839   }
 840 }
 841
 842 # This is a stop-gap method as agreed during the discussion on find() cleanup:
 843 # http://lists.scsys.co.uk/pipermail/dbix-class/2010-October/009535.html
 844 #
 845 # It is invoked when find() is called in legacy-mode with insufficiently-unique
 846 # condition. It is provided for overrides until a saner way forward is devised
 847 #
 848 # *NOTE* This is not a public method, and it's *GUARANTEED* to disappear down
 849 # the road. Please adjust your tests accordingly to catch this situation early
 850 # DBIx::Class::ResultSet->can('_non_unique_find_fallback') is reasonable
 851 #
 852 # The method will not be removed without an adequately complete replacement
 853 # for strict-mode enforcement
 854 sub _non_unique_find_fallback {
 855   my ($self, $cond, $attrs) = @_;
 856
 857   return $self->_qualify_cond_columns(
 858     $cond,
 859     exists $attrs->{alias}
 860       ? $attrs->{alias}
 861       : $self->{attrs}{alias}
 862   );
 863 }
 864
 865
 866 sub _qualify_cond_columns {
 867   my ($self, $cond, $alias) = @_;
 868
 869   my %aliased = %$cond;
 870   for (keys %aliased) {
 871     $aliased{"$alias.$_"} = delete $aliased{$_}
 872       if $_ !~ /\./;
 873   }
 874
 875   return \%aliased;
 876 }
 877
 878 sub _build_unique_cond {
 879   my ($self, $constraint_name, $extra_cond, $croak_on_null) = @_;
 880
 881   my @c_cols = $self->result_source->unique_constraint_columns($constraint_name);
 882
 883   # combination may fail if $self->{cond} is non-trivial
 884   my ($final_cond) = try {
 885     $self->_merge_with_rscond ($extra_cond)
 886   } catch {
 887     +{ %$extra_cond }
 888   };
 889
 890   # trim out everything not in $columns
 891   $final_cond = { map {
 892     exists $final_cond->{$_}
 893       ? ( $_ => $final_cond->{$_} )
 894       : ()
 895   } @c_cols };
 896
 897   if (my @missing = grep
 898     { ! ($croak_on_null ? defined $final_cond->{$_} : exists $final_cond->{$_}) }
 899     (@c_cols)
 900   ) {
 901     $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', no values for column(s): %s",
 902       $constraint_name,
 903       join (', ', map { "'$_'" } @missing),
 904     ) );
 905   }
 906
 907   if (
 908     !$croak_on_null
 909       and
 910     !$ENV{DBIC_NULLABLE_KEY_NOWARN}
 911       and
 912     my @undefs = grep { ! defined $final_cond->{$_} } (keys %$final_cond)
 913   ) {
 914     carp_unique ( sprintf (
 915       "NULL/undef values supplied for requested unique constraint '%s' (NULL "
 916     . 'values in column(s): %s). This is almost certainly not what you wanted, '
 917     . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
 918       $constraint_name,
 919       join (', ', map { "'$_'" } @undefs),
 920     ));
 921   }
 922
 923   return $final_cond;
 924 }
 925
 926 =head2 search_related
 927
 928 =over 4
 929
 930 =item Arguments: $rel, $cond?, \%attrs?
 931
 932 =item Return Value: $new_resultset (scalar context) || @row_objs (list context)
 933
 934 =back
 935
 936   $new_rs = $cd_rs->search_related('artist', {
 937     name => 'Emo-R-Us',
 938   });
 939
 940 Searches the specified relationship, optionally specifying a condition and
 941 attributes for matching records. See L</ATTRIBUTES> for more information.
 942
 943 In list context, C<< ->all() >> is called implicitly on the resultset, thus
 944 returning a list of row objects instead. To avoid that, use L</search_related_rs>.
 945
 946 See also L</search_related_rs>.
 947
 948 =cut
 949
 950 sub search_related {
 951   return shift->related_resultset(shift)->search(@_);
 952 }
 953
 954 =head2 search_related_rs
 955
 956 This method works exactly the same as search_related, except that
 957 it guarantees a resultset, even in list context.
 958
 959 =cut
 960
 961 sub search_related_rs {
 962   return shift->related_resultset(shift)->search_rs(@_);
 963 }
 964
 965 =head2 cursor
 966
 967 =over 4
 968
 969 =item Arguments: none
 970
 971 =item Return Value: $cursor
 972
 973 =back
 974
 975 Returns a storage-driven cursor to the given resultset. See
 976 L<DBIx::Class::Cursor> for more information.
 977
 978 =cut
 979
 980 sub cursor {
 981   my ($self) = @_;
 982
 983   my $attrs = $self->_resolved_attrs_copy;
 984
 985   return $self->{cursor}
 986     ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
 987           $attrs->{where},$attrs);
 988 }
 989
 990 =head2 single
 991
 992 =over 4
 993
 994 =item Arguments: $cond?
 995
 996 =item Return Value: $row_object | undef
 997
 998 =back
 999
1000   my $cd = $schema->resultset('CD')->single({ year => 2001 });
1001
1002 Inflates the first result without creating a cursor if the resultset has
1003 any records in it; if not returns C<undef>. Used by L</find> as a lean version
1004 of L</search>.
1005
1006 While this method can take an optional search condition (just like L</search>)
1007 being a fast-code-path it does not recognize search attributes. If you need to
1008 add extra joins or similar, call L</search> and then chain-call L</single> on the
1009 L<DBIx::Class::ResultSet> returned.
1010
1011 =over
1012
1013 =item B<Note>
1014
1015 As of 0.08100, this method enforces the assumption that the preceding
1016 query returns only one row. If more than one row is returned, you will receive
1017 a warning:
1018
1019   Query returned more than one row
1020
1021 In this case, you should be using L</next> or L</find> instead, or if you really
1022 know what you are doing, use the L</rows> attribute to explicitly limit the size
1023 of the resultset.
1024
1025 This method will also throw an exception if it is called on a resultset prefetching
1026 has_many, as such a prefetch implies fetching multiple rows from the database in
1027 order to assemble the resulting object.
1028
1029 =back
1030
1031 =cut
1032
1033 sub single {
1034   my ($self, $where) = @_;
1035   if(@_ > 2) {
1036       $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()');
1037   }
1038
1039   my $attrs = $self->_resolved_attrs_copy;
1040
1041   $self->throw_exception(
1042     'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead'
1043   ) if $attrs->{collapse};
1044
1045   if ($where) {
1046     if (defined $attrs->{where}) {
1047       $attrs->{where} = {
1048         '-and' =>
1049             [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
1050                $where, delete $attrs->{where} ]
1051       };
1052     } else {
1053       $attrs->{where} = $where;
1054     }
1055   }
1056
1057   my $data = [ $self->result_source->storage->select_single(
1058     $attrs->{from}, $attrs->{select},
1059     $attrs->{where}, $attrs
1060   )];
1061   return undef unless @$data;
1062   $self->{stashed_rows} = [ $data ];
1063   $self->_construct_objects->[0];
1064 }
1065
1066
1067 # _collapse_query
1068 #
1069 # Recursively collapse the query, accumulating values for each column.
1070
1071 sub _collapse_query {
1072   my ($self, $query, $collapsed) = @_;
1073
1074   $collapsed ||= {};
1075
1076   if (ref $query eq 'ARRAY') {
1077     foreach my $subquery (@$query) {
1078       next unless ref $subquery;  # -or
1079       $collapsed = $self->_collapse_query($subquery, $collapsed);
1080     }
1081   }
1082   elsif (ref $query eq 'HASH') {
1083     if (keys %$query and (keys %$query)[0] eq '-and') {
1084       foreach my $subquery (@{$query->{-and}}) {
1085         $collapsed = $self->_collapse_query($subquery, $collapsed);
1086       }
1087     }
1088     else {
1089       foreach my $col (keys %$query) {
1090         my $value = $query->{$col};
1091         $collapsed->{$col}{$value}++;
1092       }
1093     }
1094   }
1095
1096   return $collapsed;
1097 }
1098
1099 =head2 get_column
1100
1101 =over 4
1102
1103 =item Arguments: $cond?
1104
1105 =item Return Value: $resultsetcolumn
1106
1107 =back
1108
1109   my $max_length = $rs->get_column('length')->max;
1110
1111 Returns a L<DBIx::Class::ResultSetColumn> instance for a column of the ResultSet.
1112
1113 =cut
1114
1115 sub get_column {
1116   my ($self, $column) = @_;
1117   my $new = DBIx::Class::ResultSetColumn->new($self, $column);
1118   return $new;
1119 }
1120
1121 =head2 search_like
1122
1123 =over 4
1124
1125 =item Arguments: $cond, \%attrs?
1126
1127 =item Return Value: $resultset (scalar context) || @row_objs (list context)
1128
1129 =back
1130
1131   # WHERE title LIKE '%blue%'
1132   $cd_rs = $rs->search_like({ title => '%blue%'});
1133
1134 Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
1135 that this is simply a convenience method retained for ex Class::DBI users.
1136 You most likely want to use L</search> with specific operators.
1137
1138 For more information, see L<DBIx::Class::Manual::Cookbook>.
1139
1140 This method is deprecated and will be removed in 0.09. Use L</search()>
1141 instead. An example conversion is:
1142
1143   ->search_like({ foo => 'bar' });
1144
1145   # Becomes
1146
1147   ->search({ foo => { like => 'bar' } });
1148
1149 =cut
1150
1151 sub search_like {
1152   my $class = shift;
1153   carp_unique (
1154     'search_like() is deprecated and will be removed in DBIC version 0.09.'
1155    .' Instead use ->search({ x => { -like => "y%" } })'
1156    .' (note the outer pair of {}s - they are important!)'
1157   );
1158   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1159   my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
1160   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
1161   return $class->search($query, { %$attrs });
1162 }
1163
1164 =head2 slice
1165
1166 =over 4
1167
1168 =item Arguments: $first, $last
1169
1170 =item Return Value: $resultset (scalar context) || @row_objs (list context)
1171
1172 =back
1173
1174 Returns a resultset or object list representing a subset of elements from the
1175 resultset slice is called on. Indexes are from 0, i.e., to get the first
1176 three records, call:
1177
1178   my ($one, $two, $three) = $rs->slice(0, 2);
1179
1180 =cut
1181
1182 sub slice {
1183   my ($self, $min, $max) = @_;
1184   my $attrs = {}; # = { %{ $self->{attrs} || {} } };
1185   $attrs->{offset} = $self->{attrs}{offset} || 0;
1186   $attrs->{offset} += $min;
1187   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
1188   return $self->search(undef, $attrs);
1189   #my $slice = (ref $self)->new($self->result_source, $attrs);
1190   #return (wantarray ? $slice->all : $slice);
1191 }
1192
1193 =head2 next
1194
1195 =over 4
1196
1197 =item Arguments: none
1198
1199 =item Return Value: $result | undef
1200
1201 =back
1202
1203 Returns the next element in the resultset (C<undef> is there is none).
1204
1205 Can be used to efficiently iterate over records in the resultset:
1206
1207   my $rs = $schema->resultset('CD')->search;
1208   while (my $cd = $rs->next) {
1209     print $cd->title;
1210   }
1211
1212 Note that you need to store the resultset object, and call C<next> on it.
1213 Calling C<< resultset('Table')->next >> repeatedly will always return the
1214 first record from the resultset.
1215
1216 =cut
1217
1218 sub next {
1219   my ($self) = @_;
1220
1221   if (my $cache = $self->get_cache) {
1222     $self->{all_cache_position} ||= 0;
1223     return $cache->[$self->{all_cache_position}++];
1224   }
1225
1226   if ($self->{attrs}{cache}) {
1227     delete $self->{pager};
1228     $self->{all_cache_position} = 1;
1229     return ($self->all)[0];
1230   }
1231
1232   return shift(@{$self->{stashed_objects}}) if @{ $self->{stashed_objects}||[] };
1233
1234   $self->{stashed_objects} = $self->_construct_objects
1235     or return undef;
1236
1237   return shift @{$self->{stashed_objects}};
1238 }
1239
1240 # takes a single DBI-row of data and coinstructs as many objects
1241 # as the resultset attributes call for.
1242 # This can be a bit of an action at a distance - it takes as an argument
1243 # the *current* cursor-row (already taken off the $sth), but if
1244 # collapsing is requested it will keep advancing the cursor either
1245 # until the current row-object is assembled (the collapser was able to
1246 # order the result sensibly) OR until the cursor is exhausted (an
1247 # unordered collapsing resultset effectively triggers ->all)
1248 sub _construct_objects {
1249   my ($self, $fetch_all) = @_;
1250
1251   my $rsrc = $self->result_source;
1252   my $attrs = $self->_resolved_attrs;
1253   my $cursor = $self->cursor;
1254
1255   # this will be used as both initial raw-row collector AND as a RV of
1256   # _construct_objects. Not regrowing the array twice matters a lot...
1257   # a suprising amount actually
1258   my $rows = (delete $self->{stashed_rows}) || [];
1259   if ($fetch_all) {
1260     # FIXME - we can do better, cursor->next/all (well diff. methods) should return a ref
1261     $rows = [ @$rows, $cursor->all ];
1262   }
1263   elsif (!$attrs->{collapse}) {
1264     push @$rows, do { my @r = $cursor->next; @r ? \@r : () }
1265       unless @$rows;
1266   }
1267   else {
1268     $attrs->{_ordered_for_collapse} ||= (!$attrs->{order_by}) ? undef : do {
1269       my $st = $rsrc->schema->storage;
1270       my @ord_cols = map
1271         { $_->[0] }
1272         ( $st->_extract_order_criteria($attrs->{order_by}) )
1273       ;
1274
1275       my $colinfos = $st->_resolve_column_info($attrs->{from}, \@ord_cols);
1276
1277       for (0 .. $#ord_cols) {
1278         if (
1279           ! $colinfos->{$ord_cols[$_]}
1280             or
1281           $colinfos->{$ord_cols[$_]}{-result_source} != $rsrc
1282         ) {
1283           splice @ord_cols, $_;
1284           last;
1285         }
1286       }
1287
1288       # since all we check here are the start of the order_by belonging to the
1289       # top level $rsrc, the order stability check will fail unless the whole
1290       # thing is ordered as we need it
1291       (@ord_cols and $rsrc->_identifying_column_set({ map
1292         { $colinfos->{$_}{-colname} => $colinfos->{$_} }
1293         @ord_cols
1294       })) ? 1 : 0;
1295     };
1296
1297     if ($attrs->{_ordered_for_collapse}) {
1298       push @$rows, do { my @r = $cursor->next; @r ? \@r : () };
1299     }
1300     # instead of looping over ->next, use ->all in stealth mode
1301     elsif (! $cursor->{done}) {
1302       push @$rows, $cursor->all;
1303       $cursor->{done} = 1;
1304       $fetch_all = 1;
1305     }
1306   }
1307
1308   return undef unless @$rows;
1309
1310   my $res_class = $self->result_class;
1311   my $inflator = $res_class->can ('inflate_result')
1312     or $self->throw_exception("Inflator $res_class does not provide an inflate_result() method");
1313
1314   my $infmap = $attrs->{as};
1315
1316   if (!$attrs->{collapse} and $attrs->{_single_object_inflation}) {
1317     # construct a much simpler array->hash folder for the one-table cases right here
1318
1319     # FIXME SUBOPTIMAL this is a very very very hot spot
1320     # while rather optimal we can *still* do much better, by
1321     # building a smarter [Row|HRI]::inflate_result(), and
1322     # switch to feeding it data via a much leaner interface
1323     #
1324     # crude unscientific benchmarking indicated the shortcut eval is not worth it for
1325     # this particular resultset size
1326     if (@$rows < 60) {
1327       my @as_idx = 0..$#$infmap;
1328       for my $r (@$rows) {
1329         $r = $inflator->($res_class, $rsrc, { map { $infmap->[$_] => $r->[$_] } @as_idx } );
1330       }
1331     }
1332     else {
1333       eval sprintf (
1334         '$_ = $inflator->($res_class, $rsrc, { %s }) for @$rows',
1335         join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap )
1336       );
1337     }
1338   }
1339   else {
1340     ($self->{_row_parser} ||= eval sprintf 'sub { %s }', $rsrc->_mk_row_parser({
1341       inflate_map => $infmap,
1342       selection => $attrs->{select},
1343       collapse => $attrs->{collapse},
1344     }) or die $@)->($rows, $fetch_all ? () : (
1345       sub { my @r = $cursor->next or return; \@r },
1346       ($self->{stashed_rows} = []),
1347     ));  # modify $rows in-place, shrinking/extending as necessary
1348
1349     $_ = $inflator->($res_class, $rsrc, @$_) for @$rows;
1350
1351   }
1352
1353   # CDBI compat stuff
1354   if ($attrs->{record_filter}) {
1355     $_ = $attrs->{record_filter}->($_) for @$rows;
1356   }
1357
1358   return $rows;
1359 }
1360
1361 =head2 result_source
1362
1363 =over 4
1364
1365 =item Arguments: $result_source?
1366
1367 =item Return Value: $result_source
1368
1369 =back
1370
1371 An accessor for the primary ResultSource object from which this ResultSet
1372 is derived.
1373
1374 =head2 result_class
1375
1376 =over 4
1377
1378 =item Arguments: $result_class?
1379
1380 =item Return Value: $result_class
1381
1382 =back
1383
1384 An accessor for the class to use when creating row objects. Defaults to
1385 C<< result_source->result_class >> - which in most cases is the name of the
1386 L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
1387
1388 Note that changing the result_class will also remove any components
1389 that were originally loaded in the source class via
1390 L<DBIx::Class::ResultSource/load_components>. Any overloaded methods
1391 in the original source class will not run.
1392
1393 =cut
1394
1395 sub result_class {
1396   my ($self, $result_class) = @_;
1397   if ($result_class) {
1398     unless (ref $result_class) { # don't fire this for an object
1399       $self->ensure_class_loaded($result_class);
1400     }
1401     $self->_result_class($result_class);
1402     # THIS LINE WOULD BE A BUG - this accessor specifically exists to
1403     # permit the user to set result class on one result set only; it only
1404     # chains if provided to search()
1405     #$self->{attrs}{result_class} = $result_class if ref $self;
1406   }
1407   $self->_result_class;
1408 }
1409
1410 =head2 count
1411
1412 =over 4
1413
1414 =item Arguments: $cond, \%attrs??
1415
1416 =item Return Value: $count
1417
1418 =back
1419
1420 Performs an SQL C<COUNT> with the same query as the resultset was built
1421 with to find the number of elements. Passing arguments is equivalent to
1422 C<< $rs->search ($cond, \%attrs)->count >>
1423
1424 =cut
1425
1426 sub count {
1427   my $self = shift;
1428   return $self->search(@_)->count if @_ and defined $_[0];
1429   return scalar @{ $self->get_cache } if $self->get_cache;
1430
1431   my $attrs = $self->_resolved_attrs_copy;
1432
1433   # this is a little optimization - it is faster to do the limit
1434   # adjustments in software, instead of a subquery
1435   my $rows = delete $attrs->{rows};
1436   my $offset = delete $attrs->{offset};
1437
1438   my $crs;
1439   if ($self->_has_resolved_attr (qw/collapse group_by/)) {
1440     $crs = $self->_count_subq_rs ($attrs);
1441   }
1442   else {
1443     $crs = $self->_count_rs ($attrs);
1444   }
1445   my $count = $crs->next;
1446
1447   $count -= $offset if $offset;
1448   $count = $rows if $rows and $rows < $count;
1449   $count = 0 if ($count < 0);
1450
1451   return $count;
1452 }
1453
1454 =head2 count_rs
1455
1456 =over 4
1457
1458 =item Arguments: $cond, \%attrs??
1459
1460 =item Return Value: $count_rs
1461
1462 =back
1463
1464 Same as L</count> but returns a L<DBIx::Class::ResultSetColumn> object.
1465 This can be very handy for subqueries:
1466
1467   ->search( { amount => $some_rs->count_rs->as_query } )
1468
1469 As with regular resultsets the SQL query will be executed only after
1470 the resultset is accessed via L</next> or L</all>. That would return
1471 the same single value obtainable via L</count>.
1472
1473 =cut
1474
1475 sub count_rs {
1476   my $self = shift;
1477   return $self->search(@_)->count_rs if @_;
1478
1479   # this may look like a lack of abstraction (count() does about the same)
1480   # but in fact an _rs *must* use a subquery for the limits, as the
1481   # software based limiting can not be ported if this $rs is to be used
1482   # in a subquery itself (i.e. ->as_query)
1483   if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) {
1484     return $self->_count_subq_rs;
1485   }
1486   else {
1487     return $self->_count_rs;
1488   }
1489 }
1490
1491 #
1492 # returns a ResultSetColumn object tied to the count query
1493 #
1494 sub _count_rs {
1495   my ($self, $attrs) = @_;
1496
1497   my $rsrc = $self->result_source;
1498   $attrs ||= $self->_resolved_attrs;
1499
1500   my $tmp_attrs = { %$attrs };
1501   # take off any limits, record_filter is cdbi, and no point of ordering nor locking a count
1502   delete @{$tmp_attrs}{qw/rows offset order_by record_filter for/};
1503
1504   # overwrite the selector (supplied by the storage)
1505   $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs);
1506   $tmp_attrs->{as} = 'count';
1507   delete @{$tmp_attrs}{qw/columns/};
1508
1509   my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
1510
1511   return $tmp_rs;
1512 }
1513
1514 #
1515 # same as above but uses a subquery
1516 #
1517 sub _count_subq_rs {
1518   my ($self, $attrs) = @_;
1519
1520   my $rsrc = $self->result_source;
1521   $attrs ||= $self->_resolved_attrs;
1522
1523   my $sub_attrs = { %$attrs };
1524   # extra selectors do not go in the subquery and there is no point of ordering it, nor locking it
1525   delete @{$sub_attrs}{qw/collapse columns as select _prefetch_selector_range order_by for/};
1526
1527   # if we multi-prefetch we group_by something unique, as this is what we would
1528   # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
1529   if ( $attrs->{collapse}  ) {
1530     $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } @{
1531       $rsrc->_identifying_column_set || $self->throw_exception(
1532         'Unable to construct a unique group_by criteria properly collapsing the '
1533       . 'has_many prefetch before count()'
1534       );
1535     } ]
1536   }
1537
1538   # Calculate subquery selector
1539   if (my $g = $sub_attrs->{group_by}) {
1540
1541     my $sql_maker = $rsrc->storage->sql_maker;
1542
1543     # necessary as the group_by may refer to aliased functions
1544     my $sel_index;
1545     for my $sel (@{$attrs->{select}}) {
1546       $sel_index->{$sel->{-as}} = $sel
1547         if (ref $sel eq 'HASH' and $sel->{-as});
1548     }
1549
1550     # anything from the original select mentioned on the group-by needs to make it to the inner selector
1551     # also look for named aggregates referred in the having clause
1552     # having often contains scalarrefs - thus parse it out entirely
1553     my @parts = @$g;
1554     if ($attrs->{having}) {
1555       local $sql_maker->{having_bind};
1556       local $sql_maker->{quote_char} = $sql_maker->{quote_char};
1557       local $sql_maker->{name_sep} = $sql_maker->{name_sep};
1558       unless (defined $sql_maker->{quote_char} and length $sql_maker->{quote_char}) {
1559         $sql_maker->{quote_char} = [ "\x00", "\xFF" ];
1560         # if we don't unset it we screw up retarded but unfortunately working
1561         # 'MAX(foo.bar)' => { '>', 3 }
1562         $sql_maker->{name_sep} = '';
1563       }
1564
1565       my ($lquote, $rquote, $sep) = map { quotemeta $_ } ($sql_maker->_quote_chars, $sql_maker->name_sep);
1566
1567       my $sql = $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} });
1568
1569       # search for both a proper quoted qualified string, for a naive unquoted scalarref
1570       # and if all fails for an utterly naive quoted scalar-with-function
1571       while ($sql =~ /
1572         $rquote $sep $lquote (.+?) $rquote
1573           |
1574         [\s,] \w+ \. (\w+) [\s,]
1575           |
1576         [\s,] $lquote (.+?) $rquote [\s,]
1577       /gx) {
1578         push @parts, ($1 || $2 || $3);  # one of them matched if we got here
1579       }
1580     }
1581
1582     for (@parts) {
1583       my $colpiece = $sel_index->{$_} || $_;
1584
1585       # unqualify join-based group_by's. Arcane but possible query
1586       # also horrible horrible hack to alias a column (not a func.)
1587       # (probably need to introduce SQLA syntax)
1588       if ($colpiece =~ /\./ && $colpiece !~ /^$attrs->{alias}\./) {
1589         my $as = $colpiece;
1590         $as =~ s/\./__/;
1591         $colpiece = \ sprintf ('%s AS %s', map { $sql_maker->_quote ($_) } ($colpiece, $as) );
1592       }
1593       push @{$sub_attrs->{select}}, $colpiece;
1594     }
1595   }
1596   else {
1597     my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns);
1598     $sub_attrs->{select} = @pcols ? \@pcols : [ 1 ];
1599   }
1600
1601   return $rsrc->resultset_class
1602                ->new ($rsrc, $sub_attrs)
1603                 ->as_subselect_rs
1604                  ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } })
1605                   ->get_column ('count');
1606 }
1607
1608 sub _bool {
1609   return 1;
1610 }
1611
1612 =head2 count_literal
1613
1614 =over 4
1615
1616 =item Arguments: $sql_fragment, @bind_values
1617
1618 =item Return Value: $count
1619
1620 =back
1621
1622 Counts the results in a literal query. Equivalent to calling L</search_literal>
1623 with the passed arguments, then L</count>.
1624
1625 =cut
1626
1627 sub count_literal { shift->search_literal(@_)->count; }
1628
1629 =head2 all
1630
1631 =over 4
1632
1633 =item Arguments: none
1634
1635 =item Return Value: @objects
1636
1637 =back
1638
1639 Returns all elements in the resultset.
1640
1641 =cut
1642
1643 sub all {
1644   my $self = shift;
1645   if(@_) {
1646     $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
1647   }
1648
1649   delete $self->{stashed_rows};
1650   delete $self->{stashed_objects};
1651
1652   if (my $c = $self->get_cache) {
1653     return @$c;
1654   }
1655
1656   $self->cursor->reset;
1657
1658   my $objs = $self->_construct_objects('fetch_all') || [];
1659
1660   $self->set_cache($objs) if $self->{attrs}{cache};
1661
1662   return @$objs;
1663 }
1664
1665 =head2 reset
1666
1667 =over 4
1668
1669 =item Arguments: none
1670
1671 =item Return Value: $self
1672
1673 =back
1674
1675 Resets the resultset's cursor, so you can iterate through the elements again.
1676 Implicitly resets the storage cursor, so a subsequent L</next> will trigger
1677 another query.
1678
1679 =cut
1680
1681 sub reset {
1682   my ($self) = @_;
1683   delete $self->{_attrs};
1684   delete $self->{stashed_rows};
1685   delete $self->{stashed_objects};
1686
1687   $self->{all_cache_position} = 0;
1688   $self->cursor->reset;
1689   return $self;
1690 }
1691
1692 =head2 first
1693
1694 =over 4
1695
1696 =item Arguments: none
1697
1698 =item Return Value: $object | undef
1699
1700 =back
1701
1702 Resets the resultset and returns an object for the first result (or C<undef>
1703 if the resultset is empty).
1704
1705 =cut
1706
1707 sub first {
1708   return $_[0]->reset->next;
1709 }
1710
1711
1712 # _rs_update_delete
1713 #
1714 # Determines whether and what type of subquery is required for the $rs operation.
1715 # If grouping is necessary either supplies its own, or verifies the current one
1716 # After all is done delegates to the proper storage method.
1717
1718 sub _rs_update_delete {
1719   my ($self, $op, $values) = @_;
1720
1721   my $cond = $self->{cond};
1722   my $rsrc = $self->result_source;
1723   my $storage = $rsrc->schema->storage;
1724
1725   my $attrs = { %{$self->_resolved_attrs} };
1726
1727   # "needs" is a strong word here - if the subquery is part of an IN clause - no point of
1728   # even adding the group_by. It will really be used only when composing a poor-man's
1729   # multicolumn-IN equivalent OR set
1730   my $needs_group_by_subq = defined $attrs->{group_by};
1731
1732   # simplify the joinmap and maybe decide if a grouping (and thus subquery) is necessary
1733   my $relation_classifications;
1734   if (ref($attrs->{from}) eq 'ARRAY') {
1735     $attrs->{from} = $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $cond, $attrs);
1736
1737     $relation_classifications = $storage->_resolve_aliastypes_from_select_args (
1738       [ @{$attrs->{from}}[1 .. $#{$attrs->{from}}] ],
1739       $attrs->{select},
1740       $cond,
1741       $attrs
1742     ) unless $needs_group_by_subq;  # we already know we need a group, no point of resolving them
1743   }
1744   else {
1745     $needs_group_by_subq ||= 1; # if {from} is unparseable assume the worst
1746   }
1747
1748   $needs_group_by_subq ||= exists $relation_classifications->{multiplying};
1749
1750   # if no subquery - life is easy-ish
1751   unless (
1752     $needs_group_by_subq
1753       or
1754     keys %$relation_classifications # if any joins at all - need to wrap a subq
1755       or
1756     $self->_has_resolved_attr(qw/rows offset/) # limits call for a subq
1757   ) {
1758     # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
1759     # a condition containing 'me' or other table prefixes will not work
1760     # at all. What this code tries to do (badly) is to generate a condition
1761     # with the qualifiers removed, by exploiting the quote mechanism of sqla
1762     #
1763     # this is atrocious and should be replaced by normal sqla introspection
1764     # one sunny day
1765     my ($sql, @bind) = do {
1766       my $sqla = $rsrc->storage->sql_maker;
1767       local $sqla->{_dequalify_idents} = 1;
1768       $sqla->_recurse_where($self->{cond});
1769     } if $self->{cond};
1770
1771     return $rsrc->storage->$op(
1772       $rsrc,
1773       $op eq 'update' ? $values : (),
1774       $self->{cond} ? \[$sql, @bind] : (),
1775     );
1776   }
1777
1778   # we got this far - means it is time to wrap a subquery
1779   my $idcols = $rsrc->_identifying_column_set || $self->throw_exception(
1780     sprintf(
1781       "Unable to perform complex resultset %s() without an identifying set of columns on source '%s'",
1782       $op,
1783       $rsrc->source_name,
1784     )
1785   );
1786   my $existing_group_by = delete $attrs->{group_by};
1787
1788   # make a new $rs selecting only the PKs (that's all we really need for the subq)
1789   delete $attrs->{$_} for qw/collapse select _prefetch_selector_range as/;
1790   $attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ];
1791   $attrs->{group_by} = \ '';  # FIXME - this is an evil hack, it causes the optimiser to kick in and throw away the LEFT joins
1792   my $subrs = (ref $self)->new($rsrc, $attrs);
1793
1794   if (@$idcols == 1) {
1795     return $storage->$op (
1796       $rsrc,
1797       $op eq 'update' ? $values : (),
1798       { $idcols->[0] => { -in => $subrs->as_query } },
1799     );
1800   }
1801   elsif ($storage->_use_multicolumn_in) {
1802     # This is hideously ugly, but SQLA does not understand multicol IN expressions
1803     my $sql_maker = $storage->sql_maker;
1804     my ($sql, @bind) = @${$subrs->as_query};
1805     $sql = sprintf ('(%s) IN %s', # the as_query already comes with a set of parenthesis
1806       join (', ', map { $sql_maker->_quote ($_) } @$idcols),
1807       $sql,
1808     );
1809
1810     return $storage->$op (
1811       $rsrc,
1812       $op eq 'update' ? $values : (),
1813       \[$sql, @bind],
1814     );
1815   }
1816   else {
1817     # if all else fails - get all primary keys and operate over a ORed set
1818     # wrap in a transaction for consistency
1819     # this is where the group_by starts to matter
1820     my $subq_group_by;
1821     if ($needs_group_by_subq) {
1822       $subq_group_by = $attrs->{columns};
1823
1824       # make sure if there is a supplied group_by it matches the columns compiled above
1825       # perfectly. Anything else can not be sanely executed on most databases so croak
1826       # right then and there
1827       if ($existing_group_by) {
1828         my @current_group_by = map
1829           { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
1830           @$existing_group_by
1831         ;
1832
1833         if (
1834           join ("\x00", sort @current_group_by)
1835             ne
1836           join ("\x00", sort @$subq_group_by )
1837         ) {
1838           $self->throw_exception (
1839             "You have just attempted a $op operation on a resultset which does group_by"
1840             . ' on columns other than the primary keys, while DBIC internally needs to retrieve'
1841             . ' the primary keys in a subselect. All sane RDBMS engines do not support this'
1842             . ' kind of queries. Please retry the operation with a modified group_by or'
1843             . ' without using one at all.'
1844           );
1845         }
1846       }
1847     }
1848
1849     my $guard = $storage->txn_scope_guard;
1850
1851     my @op_condition;
1852     for my $row ($subrs->search({}, { group_by => $subq_group_by })->cursor->all) {
1853       push @op_condition, { map
1854         { $idcols->[$_] => $row->[$_] }
1855         (0 .. $#$idcols)
1856       };
1857     }
1858
1859     my $res = $storage->$op (
1860       $rsrc,
1861       $op eq 'update' ? $values : (),
1862       \@op_condition,
1863     );
1864
1865     $guard->commit;
1866
1867     return $res;
1868   }
1869 }
1870
1871 =head2 update
1872
1873 =over 4
1874
1875 =item Arguments: \%values
1876
1877 =item Return Value: $storage_rv
1878
1879 =back
1880
1881 Sets the specified columns in the resultset to the supplied values in a
1882 single query. Note that this will not run any accessor/set_column/update
1883 triggers, nor will it update any row object instances derived from this
1884 resultset (this includes the contents of the L<resultset cache|/set_cache>
1885 if any). See L</update_all> if you need to execute any on-update
1886 triggers or cascades defined either by you or a
1887 L<result component|DBIx::Class::Manual::Component/WHAT IS A COMPONENT>.
1888
1889 The return value is a pass through of what the underlying
1890 storage backend returned, and may vary. See L<DBI/execute> for the most
1891 common case.
1892
1893 =head3 CAVEAT
1894
1895 Note that L</update> does not process/deflate any of the values passed in.
1896 This is unlike the corresponding L<DBIx::Class::Row/update>. The user must
1897 ensure manually that any value passed to this method will stringify to
1898 something the RDBMS knows how to deal with. A notable example is the
1899 handling of L<DateTime> objects, for more info see:
1900 L<DBIx::Class::Manual::Cookbook/Formatting DateTime objects in queries>.
1901
1902 =cut
1903
1904 sub update {
1905   my ($self, $values) = @_;
1906   $self->throw_exception('Values for update must be a hash')
1907     unless ref $values eq 'HASH';
1908
1909   return $self->_rs_update_delete ('update', $values);
1910 }
1911
1912 =head2 update_all
1913
1914 =over 4
1915
1916 =item Arguments: \%values
1917
1918 =item Return Value: 1
1919
1920 =back
1921
1922 Fetches all objects and updates them one at a time via
1923 L<DBIx::Class::Row/update>. Note that C<update_all> will run DBIC defined
1924 triggers, while L</update> will not.
1925
1926 =cut
1927
1928 sub update_all {
1929   my ($self, $values) = @_;
1930   $self->throw_exception('Values for update_all must be a hash')
1931     unless ref $values eq 'HASH';
1932
1933   my $guard = $self->result_source->schema->txn_scope_guard;
1934   $_->update({%$values}) for $self->all;  # shallow copy - update will mangle it
1935   $guard->commit;
1936   return 1;
1937 }
1938
1939 =head2 delete
1940
1941 =over 4
1942
1943 =item Arguments: none
1944
1945 =item Return Value: $storage_rv
1946
1947 =back
1948
1949 Deletes the rows matching this resultset in a single query. Note that this
1950 will not run any delete triggers, nor will it alter the
1951 L<in_storage|DBIx::Class::Row/in_storage> status of any row object instances
1952 derived from this resultset (this includes the contents of the
1953 L<resultset cache|/set_cache> if any). See L</delete_all> if you need to
1954 execute any on-delete triggers or cascades defined either by you or a
1955 L<result component|DBIx::Class::Manual::Component/WHAT IS A COMPONENT>.
1956
1957 The return value is a pass through of what the underlying storage backend
1958 returned, and may vary. See L<DBI/execute> for the most common case.
1959
1960 =cut
1961
1962 sub delete {
1963   my $self = shift;
1964   $self->throw_exception('delete does not accept any arguments')
1965     if @_;
1966
1967   return $self->_rs_update_delete ('delete');
1968 }
1969
1970 =head2 delete_all
1971
1972 =over 4
1973
1974 =item Arguments: none
1975
1976 =item Return Value: 1
1977
1978 =back
1979
1980 Fetches all objects and deletes them one at a time via
1981 L<DBIx::Class::Row/delete>. Note that C<delete_all> will run DBIC defined
1982 triggers, while L</delete> will not.
1983
1984 =cut
1985
1986 sub delete_all {
1987   my $self = shift;
1988   $self->throw_exception('delete_all does not accept any arguments')
1989     if @_;
1990
1991   my $guard = $self->result_source->schema->txn_scope_guard;
1992   $_->delete for $self->all;
1993   $guard->commit;
1994   return 1;
1995 }
1996
1997 =head2 populate
1998
1999 =over 4
2000
2001 =item Arguments: \@data;
2002
2003 =back
2004
2005 Accepts either an arrayref of hashrefs or alternatively an arrayref of arrayrefs.
2006 For the arrayref of hashrefs style each hashref should be a structure suitable
2007 for submitting to a $resultset->create(...) method.
2008
2009 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
2010 to insert the data, as this is a faster method.
2011
2012 Otherwise, each set of data is inserted into the database using
2013 L<DBIx::Class::ResultSet/create>, and the resulting objects are
2014 accumulated into an array. The array itself, or an array reference
2015 is returned depending on scalar or list context.
2016
2017 Example:  Assuming an Artist Class that has many CDs Classes relating:
2018
2019   my $Artist_rs = $schema->resultset("Artist");
2020
2021   ## Void Context Example
2022   $Artist_rs->populate([
2023      { artistid => 4, name => 'Manufactured Crap', cds => [
2024         { title => 'My First CD', year => 2006 },
2025         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2026       ],
2027      },
2028      { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
2029         { title => 'My parents sold me to a record company', year => 2005 },
2030         { title => 'Why Am I So Ugly?', year => 2006 },
2031         { title => 'I Got Surgery and am now Popular', year => 2007 }
2032       ],
2033      },
2034   ]);
2035
2036   ## Array Context Example
2037   my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([
2038     { name => "Artist One"},
2039     { name => "Artist Two"},
2040     { name => "Artist Three", cds=> [
2041     { title => "First CD", year => 2007},
2042     { title => "Second CD", year => 2008},
2043   ]}
2044   ]);
2045
2046   print $ArtistOne->name; ## response is 'Artist One'
2047   print $ArtistThree->cds->count ## reponse is '2'
2048
2049 For the arrayref of arrayrefs style,  the first element should be a list of the
2050 fieldsnames to which the remaining elements are rows being inserted.  For
2051 example:
2052
2053   $Arstist_rs->populate([
2054     [qw/artistid name/],
2055     [100, 'A Formally Unknown Singer'],
2056     [101, 'A singer that jumped the shark two albums ago'],
2057     [102, 'An actually cool singer'],
2058   ]);
2059
2060 Please note an important effect on your data when choosing between void and
2061 wantarray context. Since void context goes straight to C<insert_bulk> in
2062 L<DBIx::Class::Storage::DBI> this will skip any component that is overriding
2063 C<insert>.  So if you are using something like L<DBIx-Class-UUIDColumns> to
2064 create primary keys for you, you will find that your PKs are empty.  In this
2065 case you will have to use the wantarray context in order to create those
2066 values.
2067
2068 =cut
2069
2070 sub populate {
2071   my $self = shift;
2072
2073   # cruft placed in standalone method
2074   my $data = $self->_normalize_populate_args(@_);
2075
2076   return unless @$data;
2077
2078   if(defined wantarray) {
2079     my @created;
2080     foreach my $item (@$data) {
2081       push(@created, $self->create($item));
2082     }
2083     return wantarray ? @created : \@created;
2084   }
2085   else {
2086     my $first = $data->[0];
2087
2088     # if a column is a registered relationship, and is a non-blessed hash/array, consider
2089     # it relationship data
2090     my (@rels, @columns);
2091     my $rsrc = $self->result_source;
2092     my $rels = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships };
2093     for (keys %$first) {
2094       my $ref = ref $first->{$_};
2095       $rels->{$_} && ($ref eq 'ARRAY' or $ref eq 'HASH')
2096         ? push @rels, $_
2097         : push @columns, $_
2098       ;
2099     }
2100
2101     my @pks = $rsrc->primary_columns;
2102
2103     ## do the belongs_to relationships
2104     foreach my $index (0..$#$data) {
2105
2106       # delegate to create() for any dataset without primary keys with specified relationships
2107       if (grep { !defined $data->[$index]->{$_} } @pks ) {
2108         for my $r (@rels) {
2109           if (grep { ref $data->[$index]{$r} eq $_ } qw/HASH ARRAY/) {  # a related set must be a HASH or AoH
2110             my @ret = $self->populate($data);
2111             return;
2112           }
2113         }
2114       }
2115
2116       foreach my $rel (@rels) {
2117         next unless ref $data->[$index]->{$rel} eq "HASH";
2118         my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
2119         my ($reverse_relname, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)};
2120         my $related = $result->result_source->_resolve_condition(
2121           $reverse_relinfo->{cond},
2122           $self,
2123           $result,
2124           $rel,
2125         );
2126
2127         delete $data->[$index]->{$rel};
2128         $data->[$index] = {%{$data->[$index]}, %$related};
2129
2130         push @columns, keys %$related if $index == 0;
2131       }
2132     }
2133
2134     ## inherit the data locked in the conditions of the resultset
2135     my ($rs_data) = $self->_merge_with_rscond({});
2136     delete @{$rs_data}{@columns};
2137     my @inherit_cols = keys %$rs_data;
2138     my @inherit_data = values %$rs_data;
2139
2140     ## do bulk insert on current row
2141     $rsrc->storage->insert_bulk(
2142       $rsrc,
2143       [@columns, @inherit_cols],
2144       [ map { [ @$_{@columns}, @inherit_data ] } @$data ],
2145     );
2146
2147     ## do the has_many relationships
2148     foreach my $item (@$data) {
2149
2150       my $main_row;
2151
2152       foreach my $rel (@rels) {
2153         next unless ref $item->{$rel} eq "ARRAY" && @{ $item->{$rel} };
2154
2155         $main_row ||= $self->new_result({map { $_ => $item->{$_} } @pks});
2156
2157         my $child = $main_row->$rel;
2158
2159         my $related = $child->result_source->_resolve_condition(
2160           $rels->{$rel}{cond},
2161           $child,
2162           $main_row,
2163           $rel,
2164         );
2165
2166         my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
2167         my @populate = map { {%$_, %$related} } @rows_to_add;
2168
2169         $child->populate( \@populate );
2170       }
2171     }
2172   }
2173 }
2174
2175
2176 # populate() argumnets went over several incarnations
2177 # What we ultimately support is AoH
2178 sub _normalize_populate_args {
2179   my ($self, $arg) = @_;
2180
2181   if (ref $arg eq 'ARRAY') {
2182     if (!@$arg) {
2183       return [];
2184     }
2185     elsif (ref $arg->[0] eq 'HASH') {
2186       return $arg;
2187     }
2188     elsif (ref $arg->[0] eq 'ARRAY') {
2189       my @ret;
2190       my @colnames = @{$arg->[0]};
2191       foreach my $values (@{$arg}[1 .. $#$arg]) {
2192         push @ret, { map { $colnames[$_] => $values->[$_] } (0 .. $#colnames) };
2193       }
2194       return \@ret;
2195     }
2196   }
2197
2198   $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs');
2199 }
2200
2201 =head2 pager
2202
2203 =over 4
2204
2205 =item Arguments: none
2206
2207 =item Return Value: $pager
2208
2209 =back
2210
2211 Return Value a L<Data::Page> object for the current resultset. Only makes
2212 sense for queries with a C<page> attribute.
2213
2214 To get the full count of entries for a paged resultset, call
2215 C<total_entries> on the L<Data::Page> object.
2216
2217 =cut
2218
2219 sub pager {
2220   my ($self) = @_;
2221
2222   return $self->{pager} if $self->{pager};
2223
2224   my $attrs = $self->{attrs};
2225   if (!defined $attrs->{page}) {
2226     $self->throw_exception("Can't create pager for non-paged rs");
2227   }
2228   elsif ($attrs->{page} <= 0) {
2229     $self->throw_exception('Invalid page number (page-numbers are 1-based)');
2230   }
2231   $attrs->{rows} ||= 10;
2232
2233   # throw away the paging flags and re-run the count (possibly
2234   # with a subselect) to get the real total count
2235   my $count_attrs = { %$attrs };
2236   delete $count_attrs->{$_} for qw/rows offset page pager/;
2237
2238   my $total_rs = (ref $self)->new($self->result_source, $count_attrs);
2239
2240   require DBIx::Class::ResultSet::Pager;
2241   return $self->{pager} = DBIx::Class::ResultSet::Pager->new(
2242     sub { $total_rs->count },  #lazy-get the total
2243     $attrs->{rows},
2244     $self->{attrs}{page},
2245   );
2246 }
2247
2248 =head2 page
2249
2250 =over 4
2251
2252 =item Arguments: $page_number
2253
2254 =item Return Value: $rs
2255
2256 =back
2257
2258 Returns a resultset for the $page_number page of the resultset on which page
2259 is called, where each page contains a number of rows equal to the 'rows'
2260 attribute set on the resultset (10 by default).
2261
2262 =cut
2263
2264 sub page {
2265   my ($self, $page) = @_;
2266   return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
2267 }
2268
2269 =head2 new_result
2270
2271 =over 4
2272
2273 =item Arguments: \%vals
2274
2275 =item Return Value: $rowobject
2276
2277 =back
2278
2279 Creates a new row object in the resultset's result class and returns
2280 it. The row is not inserted into the database at this point, call
2281 L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
2282 will tell you whether the row object has been inserted or not.
2283
2284 Passes the hashref of input on to L<DBIx::Class::Row/new>.
2285
2286 =cut
2287
2288 sub new_result {
2289   my ($self, $values) = @_;
2290   $self->throw_exception( "new_result needs a hash" )
2291     unless (ref $values eq 'HASH');
2292
2293   my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values);
2294
2295   my %new = (
2296     %$merged_cond,
2297     @$cols_from_relations
2298       ? (-cols_from_relations => $cols_from_relations)
2299       : (),
2300     -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
2301   );
2302
2303   return $self->result_class->new(\%new);
2304 }
2305
2306 # _merge_with_rscond
2307 #
2308 # Takes a simple hash of K/V data and returns its copy merged with the
2309 # condition already present on the resultset. Additionally returns an
2310 # arrayref of value/condition names, which were inferred from related
2311 # objects (this is needed for in-memory related objects)
2312 sub _merge_with_rscond {
2313   my ($self, $data) = @_;
2314
2315   my (%new_data, @cols_from_relations);
2316
2317   my $alias = $self->{attrs}{alias};
2318
2319   if (! defined $self->{cond}) {
2320     # just massage $data below
2321   }
2322   elsif ($self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
2323     %new_data = %{ $self->{attrs}{related_objects} || {} };  # nothing might have been inserted yet
2324     @cols_from_relations = keys %new_data;
2325   }
2326   elsif (ref $self->{cond} ne 'HASH') {
2327     $self->throw_exception(
2328       "Can't abstract implicit construct, resultset condition not a hash"
2329     );
2330   }
2331   else {
2332     # precendence must be given to passed values over values inherited from
2333     # the cond, so the order here is important.
2334     my $collapsed_cond = $self->_collapse_cond($self->{cond});
2335     my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
2336
2337     while ( my($col, $value) = each %implied ) {
2338       my $vref = ref $value;
2339       if (
2340         $vref eq 'HASH'
2341           and
2342         keys(%$value) == 1
2343           and
2344         (keys %$value)[0] eq '='
2345       ) {
2346         $new_data{$col} = $value->{'='};
2347       }
2348       elsif( !$vref or $vref eq 'SCALAR' or blessed($value) ) {
2349         $new_data{$col} = $value;
2350       }
2351     }
2352   }
2353
2354   %new_data = (
2355     %new_data,
2356     %{ $self->_remove_alias($data, $alias) },
2357   );
2358
2359   return (\%new_data, \@cols_from_relations);
2360 }
2361
2362 # _has_resolved_attr
2363 #
2364 # determines if the resultset defines at least one
2365 # of the attributes supplied
2366 #
2367 # used to determine if a subquery is neccessary
2368 #
2369 # supports some virtual attributes:
2370 #   -join
2371 #     This will scan for any joins being present on the resultset.
2372 #     It is not a mere key-search but a deep inspection of {from}
2373 #
2374
2375 sub _has_resolved_attr {
2376   my ($self, @attr_names) = @_;
2377
2378   my $attrs = $self->_resolved_attrs;
2379
2380   my %extra_checks;
2381
2382   for my $n (@attr_names) {
2383     if (grep { $n eq $_ } (qw/-join/) ) {
2384       $extra_checks{$n}++;
2385       next;
2386     }
2387
2388     my $attr =  $attrs->{$n};
2389
2390     next if not defined $attr;
2391
2392     if (ref $attr eq 'HASH') {
2393       return 1 if keys %$attr;
2394     }
2395     elsif (ref $attr eq 'ARRAY') {
2396       return 1 if @$attr;
2397     }
2398     else {
2399       return 1 if $attr;
2400     }
2401   }
2402
2403   # a resolved join is expressed as a multi-level from
2404   return 1 if (
2405     $extra_checks{-join}
2406       and
2407     ref $attrs->{from} eq 'ARRAY'
2408       and
2409     @{$attrs->{from}} > 1
2410   );
2411
2412   return 0;
2413 }
2414
2415 # _collapse_cond
2416 #
2417 # Recursively collapse the condition.
2418
2419 sub _collapse_cond {
2420   my ($self, $cond, $collapsed) = @_;
2421
2422   $collapsed ||= {};
2423
2424   if (ref $cond eq 'ARRAY') {
2425     foreach my $subcond (@$cond) {
2426       next unless ref $subcond;  # -or
2427       $collapsed = $self->_collapse_cond($subcond, $collapsed);
2428     }
2429   }
2430   elsif (ref $cond eq 'HASH') {
2431     if (keys %$cond and (keys %$cond)[0] eq '-and') {
2432       foreach my $subcond (@{$cond->{-and}}) {
2433         $collapsed = $self->_collapse_cond($subcond, $collapsed);
2434       }
2435     }
2436     else {
2437       foreach my $col (keys %$cond) {
2438         my $value = $cond->{$col};
2439         $collapsed->{$col} = $value;
2440       }
2441     }
2442   }
2443
2444   return $collapsed;
2445 }
2446
2447 # _remove_alias
2448 #
2449 # Remove the specified alias from the specified query hash. A copy is made so
2450 # the original query is not modified.
2451
2452 sub _remove_alias {
2453   my ($self, $query, $alias) = @_;
2454
2455   my %orig = %{ $query || {} };
2456   my %unaliased;
2457
2458   foreach my $key (keys %orig) {
2459     if ($key !~ /\./) {
2460       $unaliased{$key} = $orig{$key};
2461       next;
2462     }
2463     $unaliased{$1} = $orig{$key}
2464       if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
2465   }
2466
2467   return \%unaliased;
2468 }
2469
2470 =head2 as_query
2471
2472 =over 4
2473
2474 =item Arguments: none
2475
2476 =item Return Value: \[ $sql, @bind ]
2477
2478 =back
2479
2480 Returns the SQL query and bind vars associated with the invocant.
2481
2482 This is generally used as the RHS for a subquery.
2483
2484 =cut
2485
2486 sub as_query {
2487   my $self = shift;
2488
2489   my $attrs = $self->_resolved_attrs_copy;
2490
2491   # For future use:
2492   #
2493   # in list ctx:
2494   # my ($sql, \@bind, \%dbi_bind_attrs) = _select_args_to_query (...)
2495   # $sql also has no wrapping parenthesis in list ctx
2496   #
2497   my $sqlbind = $self->result_source->storage
2498     ->_select_args_to_query ($attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs);
2499
2500   return $sqlbind;
2501 }
2502
2503 =head2 find_or_new
2504
2505 =over 4
2506
2507 =item Arguments: \%vals, \%attrs?
2508
2509 =item Return Value: $rowobject
2510
2511 =back
2512
2513   my $artist = $schema->resultset('Artist')->find_or_new(
2514     { artist => 'fred' }, { key => 'artists' });
2515
2516   $cd->cd_to_producer->find_or_new({ producer => $producer },
2517                                    { key => 'primary });
2518
2519 Find an existing record from this resultset using L</find>. if none exists,
2520 instantiate a new result object and return it. The object will not be saved
2521 into your storage until you call L<DBIx::Class::Row/insert> on it.
2522
2523 You most likely want this method when looking for existing rows using a unique
2524 constraint that is not the primary key, or looking for related rows.
2525
2526 If you want objects to be saved immediately, use L</find_or_create> instead.
2527
2528 B<Note>: Make sure to read the documentation of L</find> and understand the
2529 significance of the C<key> attribute, as its lack may skew your search, and
2530 subsequently result in spurious new objects.
2531
2532 B<Note>: Take care when using C<find_or_new> with a table having
2533 columns with default values that you intend to be automatically
2534 supplied by the database (e.g. an auto_increment primary key column).
2535 In normal usage, the value of such columns should NOT be included at
2536 all in the call to C<find_or_new>, even when set to C<undef>.
2537
2538 =cut
2539
2540 sub find_or_new {
2541   my $self     = shift;
2542   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2543   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2544   if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2545     return $row;
2546   }
2547   return $self->new_result($hash);
2548 }
2549
2550 =head2 create
2551
2552 =over 4
2553
2554 =item Arguments: \%vals
2555
2556 =item Return Value: a L<DBIx::Class::Row> $object
2557
2558 =back
2559
2560 Attempt to create a single new row or a row with multiple related rows
2561 in the table represented by the resultset (and related tables). This
2562 will not check for duplicate rows before inserting, use
2563 L</find_or_create> to do that.
2564
2565 To create one row for this resultset, pass a hashref of key/value
2566 pairs representing the columns of the table and the values you wish to
2567 store. If the appropriate relationships are set up, foreign key fields
2568 can also be passed an object representing the foreign row, and the
2569 value will be set to its primary key.
2570
2571 To create related objects, pass a hashref of related-object column values
2572 B<keyed on the relationship name>. If the relationship is of type C<multi>
2573 (L<DBIx::Class::Relationship/has_many>) - pass an arrayref of hashrefs.
2574 The process will correctly identify columns holding foreign keys, and will
2575 transparently populate them from the keys of the corresponding relation.
2576 This can be applied recursively, and will work correctly for a structure
2577 with an arbitrary depth and width, as long as the relationships actually
2578 exists and the correct column data has been supplied.
2579
2580
2581 Instead of hashrefs of plain related data (key/value pairs), you may
2582 also pass new or inserted objects. New objects (not inserted yet, see
2583 L</new>), will be inserted into their appropriate tables.
2584
2585 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
2586
2587 Example of creating a new row.
2588
2589   $person_rs->create({
2590     name=>"Some Person",
2591     email=>"somebody@someplace.com"
2592   });
2593
2594 Example of creating a new row and also creating rows in a related C<has_many>
2595 or C<has_one> resultset.  Note Arrayref.
2596
2597   $artist_rs->create(
2598      { artistid => 4, name => 'Manufactured Crap', cds => [
2599         { title => 'My First CD', year => 2006 },
2600         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2601       ],
2602      },
2603   );
2604
2605 Example of creating a new row and also creating a row in a related
2606 C<belongs_to> resultset. Note Hashref.
2607
2608   $cd_rs->create({
2609     title=>"Music for Silly Walks",
2610     year=>2000,
2611     artist => {
2612       name=>"Silly Musician",
2613     }
2614   });
2615
2616 =over
2617
2618 =item WARNING
2619
2620 When subclassing ResultSet never attempt to override this method. Since
2621 it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a
2622 lot of the internals simply never call it, so your override will be
2623 bypassed more often than not. Override either L<new|DBIx::Class::Row/new>
2624 or L<insert|DBIx::Class::Row/insert> depending on how early in the
2625 L</create> process you need to intervene.
2626
2627 =back
2628
2629 =cut
2630
2631 sub create {
2632   my ($self, $attrs) = @_;
2633   $self->throw_exception( "create needs a hashref" )
2634     unless ref $attrs eq 'HASH';
2635   return $self->new_result($attrs)->insert;
2636 }
2637
2638 =head2 find_or_create
2639
2640 =over 4
2641
2642 =item Arguments: \%vals, \%attrs?
2643
2644 =item Return Value: $rowobject
2645
2646 =back
2647
2648   $cd->cd_to_producer->find_or_create({ producer => $producer },
2649                                       { key => 'primary' });
2650
2651 Tries to find a record based on its primary key or unique constraints; if none
2652 is found, creates one and returns that instead.
2653
2654   my $cd = $schema->resultset('CD')->find_or_create({
2655     cdid   => 5,
2656     artist => 'Massive Attack',
2657     title  => 'Mezzanine',
2658     year   => 2005,
2659   });
2660
2661 Also takes an optional C<key> attribute, to search by a specific key or unique
2662 constraint. For example:
2663
2664   my $cd = $schema->resultset('CD')->find_or_create(
2665     {
2666       artist => 'Massive Attack',
2667       title  => 'Mezzanine',
2668     },
2669     { key => 'cd_artist_title' }
2670   );
2671
2672 B<Note>: Make sure to read the documentation of L</find> and understand the
2673 significance of the C<key> attribute, as its lack may skew your search, and
2674 subsequently result in spurious row creation.
2675
2676 B<Note>: Because find_or_create() reads from the database and then
2677 possibly inserts based on the result, this method is subject to a race
2678 condition. Another process could create a record in the table after
2679 the find has completed and before the create has started. To avoid
2680 this problem, use find_or_create() inside a transaction.
2681
2682 B<Note>: Take care when using C<find_or_create> with a table having
2683 columns with default values that you intend to be automatically
2684 supplied by the database (e.g. an auto_increment primary key column).
2685 In normal usage, the value of such columns should NOT be included at
2686 all in the call to C<find_or_create>, even when set to C<undef>.
2687
2688 See also L</find> and L</update_or_create>. For information on how to declare
2689 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2690
2691 If you need to know if an existing row was found or a new one created use
2692 L</find_or_new> and L<DBIx::Class::Row/in_storage> instead. Don't forget
2693 to call L<DBIx::Class::Row/insert> to save the newly created row to the
2694 database!
2695
2696   my $cd = $schema->resultset('CD')->find_or_new({
2697     cdid   => 5,
2698     artist => 'Massive Attack',
2699     title  => 'Mezzanine',
2700     year   => 2005,
2701   });
2702
2703   if( $cd->in_storage ) {
2704       # do some stuff
2705       $cd->insert;
2706   }
2707
2708 =cut
2709
2710 sub find_or_create {
2711   my $self     = shift;
2712   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2713   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2714   if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2715     return $row;
2716   }
2717   return $self->create($hash);
2718 }
2719
2720 =head2 update_or_create
2721
2722 =over 4
2723
2724 =item Arguments: \%col_values, { key => $unique_constraint }?
2725
2726 =item Return Value: $row_object
2727
2728 =back
2729
2730   $resultset->update_or_create({ col => $val, ... });
2731
2732 Like L</find_or_create>, but if a row is found it is immediately updated via
2733 C<< $found_row->update (\%col_values) >>.
2734
2735
2736 Takes an optional C<key> attribute to search on a specific unique constraint.
2737 For example:
2738
2739   # In your application
2740   my $cd = $schema->resultset('CD')->update_or_create(
2741     {
2742       artist => 'Massive Attack',
2743       title  => 'Mezzanine',
2744       year   => 1998,
2745     },
2746     { key => 'cd_artist_title' }
2747   );
2748
2749   $cd->cd_to_producer->update_or_create({
2750     producer => $producer,
2751     name => 'harry',
2752   }, {
2753     key => 'primary',
2754   });
2755
2756 B<Note>: Make sure to read the documentation of L</find> and understand the
2757 significance of the C<key> attribute, as its lack may skew your search, and
2758 subsequently result in spurious row creation.
2759
2760 B<Note>: Take care when using C<update_or_create> with a table having
2761 columns with default values that you intend to be automatically
2762 supplied by the database (e.g. an auto_increment primary key column).
2763 In normal usage, the value of such columns should NOT be included at
2764 all in the call to C<update_or_create>, even when set to C<undef>.
2765
2766 See also L</find> and L</find_or_create>. For information on how to declare
2767 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2768
2769 If you need to know if an existing row was updated or a new one created use
2770 L</update_or_new> and L<DBIx::Class::Row/in_storage> instead. Don't forget
2771 to call L<DBIx::Class::Row/insert> to save the newly created row to the
2772 database!
2773
2774   my $cd = $schema->resultset('CD')->update_or_new(
2775     {
2776       artist => 'Massive Attack',
2777       title  => 'Mezzanine',
2778       year   => 1998,
2779     },
2780     { key => 'cd_artist_title' }
2781   );
2782
2783   if( $cd->in_storage ) {
2784       # do some stuff
2785       $cd->insert;
2786   }
2787
2788 =cut
2789
2790 sub update_or_create {
2791   my $self = shift;
2792   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2793   my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
2794
2795   my $row = $self->find($cond, $attrs);
2796   if (defined $row) {
2797     $row->update($cond);
2798     return $row;
2799   }
2800
2801   return $self->create($cond);
2802 }
2803
2804 =head2 update_or_new
2805
2806 =over 4
2807
2808 =item Arguments: \%col_values, { key => $unique_constraint }?
2809
2810 =item Return Value: $rowobject
2811
2812 =back
2813
2814   $resultset->update_or_new({ col => $val, ... });
2815
2816 Like L</find_or_new> but if a row is found it is immediately updated via
2817 C<< $found_row->update (\%col_values) >>.
2818
2819 For example:
2820
2821   # In your application
2822   my $cd = $schema->resultset('CD')->update_or_new(
2823     {
2824       artist => 'Massive Attack',
2825       title  => 'Mezzanine',
2826       year   => 1998,
2827     },
2828     { key => 'cd_artist_title' }
2829   );
2830
2831   if ($cd->in_storage) {
2832       # the cd was updated
2833   }
2834   else {
2835       # the cd is not yet in the database, let's insert it
2836       $cd->insert;
2837   }
2838
2839 B<Note>: Make sure to read the documentation of L</find> and understand the
2840 significance of the C<key> attribute, as its lack may skew your search, and
2841 subsequently result in spurious new objects.
2842
2843 B<Note>: Take care when using C<update_or_new> with a table having
2844 columns with default values that you intend to be automatically
2845 supplied by the database (e.g. an auto_increment primary key column).
2846 In normal usage, the value of such columns should NOT be included at
2847 all in the call to C<update_or_new>, even when set to C<undef>.
2848
2849 See also L</find>, L</find_or_create> and L</find_or_new>.
2850
2851 =cut
2852
2853 sub update_or_new {
2854     my $self  = shift;
2855     my $attrs = ( @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {} );
2856     my $cond  = ref $_[0] eq 'HASH' ? shift : {@_};
2857
2858     my $row = $self->find( $cond, $attrs );
2859     if ( defined $row ) {
2860         $row->update($cond);
2861         return $row;
2862     }
2863
2864     return $self->new_result($cond);
2865 }
2866
2867 =head2 get_cache
2868
2869 =over 4
2870
2871 =item Arguments: none
2872
2873 =item Return Value: \@cache_objects | undef
2874
2875 =back
2876
2877 Gets the contents of the cache for the resultset, if the cache is set.
2878
2879 The cache is populated either by using the L</prefetch> attribute to
2880 L</search> or by calling L</set_cache>.
2881
2882 =cut
2883
2884 sub get_cache {
2885   shift->{all_cache};
2886 }
2887
2888 =head2 set_cache
2889
2890 =over 4
2891
2892 =item Arguments: \@cache_objects
2893
2894 =item Return Value: \@cache_objects
2895
2896 =back
2897
2898 Sets the contents of the cache for the resultset. Expects an arrayref
2899 of objects of the same class as those produced by the resultset. Note that
2900 if the cache is set the resultset will return the cached objects rather
2901 than re-querying the database even if the cache attr is not set.
2902
2903 The contents of the cache can also be populated by using the
2904 L</prefetch> attribute to L</search>.
2905
2906 =cut
2907
2908 sub set_cache {
2909   my ( $self, $data ) = @_;
2910   $self->throw_exception("set_cache requires an arrayref")
2911       if defined($data) && (ref $data ne 'ARRAY');
2912   $self->{all_cache} = $data;
2913 }
2914
2915 =head2 clear_cache
2916
2917 =over 4
2918
2919 =item Arguments: none
2920
2921 =item Return Value: undef
2922
2923 =back
2924
2925 Clears the cache for the resultset.
2926
2927 =cut
2928
2929 sub clear_cache {
2930   shift->set_cache(undef);
2931 }
2932
2933 =head2 is_paged
2934
2935 =over 4
2936
2937 =item Arguments: none
2938
2939 =item Return Value: true, if the resultset has been paginated
2940
2941 =back
2942
2943 =cut
2944
2945 sub is_paged {
2946   my ($self) = @_;
2947   return !!$self->{attrs}{page};
2948 }
2949
2950 =head2 is_ordered
2951
2952 =over 4
2953
2954 =item Arguments: none
2955
2956 =item Return Value: true, if the resultset has been ordered with C<order_by>.
2957
2958 =back
2959
2960 =cut
2961
2962 sub is_ordered {
2963   my ($self) = @_;
2964   return scalar $self->result_source->storage->_extract_order_criteria($self->{attrs}{order_by});
2965 }
2966
2967 =head2 related_resultset
2968
2969 =over 4
2970
2971 =item Arguments: $relationship_name
2972
2973 =item Return Value: $resultset
2974
2975 =back
2976
2977 Returns a related resultset for the supplied relationship name.
2978
2979   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
2980
2981 =cut
2982
2983 sub related_resultset {
2984   my ($self, $rel) = @_;
2985
2986   $self->{related_resultsets} ||= {};
2987   return $self->{related_resultsets}{$rel} ||= do {
2988     my $rsrc = $self->result_source;
2989     my $rel_info = $rsrc->relationship_info($rel);
2990
2991     $self->throw_exception(
2992       "search_related: result source '" . $rsrc->source_name .
2993         "' has no such relationship $rel")
2994       unless $rel_info;
2995
2996     my $attrs = $self->_chain_relationship($rel);
2997
2998     my $join_count = $attrs->{seen_join}{$rel};
2999
3000     my $alias = $self->result_source->storage
3001         ->relname_to_table_alias($rel, $join_count);
3002
3003     # since this is search_related, and we already slid the select window inwards
3004     # (the select/as attrs were deleted in the beginning), we need to flip all
3005     # left joins to inner, so we get the expected results
3006     # read the comment on top of the actual function to see what this does
3007     $attrs->{from} = $rsrc->schema->storage->_inner_join_to_node ($attrs->{from}, $alias);
3008
3009
3010     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
3011     delete @{$attrs}{qw(result_class alias)};
3012
3013     my $new_cache;
3014
3015     if (my $cache = $self->get_cache) {
3016       if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) {
3017         $new_cache = [ map { @{$_->related_resultset($rel)->get_cache||[]} }
3018                         @$cache ];
3019       }
3020     }
3021
3022     my $rel_source = $rsrc->related_source($rel);
3023
3024     my $new = do {
3025
3026       # The reason we do this now instead of passing the alias to the
3027       # search_rs below is that if you wrap/overload resultset on the
3028       # source you need to know what alias it's -going- to have for things
3029       # to work sanely (e.g. RestrictWithObject wants to be able to add
3030       # extra query restrictions, and these may need to be $alias.)
3031
3032       my $rel_attrs = $rel_source->resultset_attributes;
3033       local $rel_attrs->{alias} = $alias;
3034
3035       $rel_source->resultset
3036                  ->search_rs(
3037                      undef, {
3038                        %$attrs,
3039                        where => $attrs->{where},
3040                    });
3041     };
3042     $new->set_cache($new_cache) if $new_cache;
3043     $new;
3044   };
3045 }
3046
3047 =head2 current_source_alias
3048
3049 =over 4
3050
3051 =item Arguments: none
3052
3053 =item Return Value: $source_alias
3054
3055 =back
3056
3057 Returns the current table alias for the result source this resultset is built
3058 on, that will be used in the SQL query. Usually it is C<me>.
3059
3060 Currently the source alias that refers to the result set returned by a
3061 L</search>/L</find> family method depends on how you got to the resultset: it's
3062 C<me> by default, but eg. L</search_related> aliases it to the related result
3063 source name (and keeps C<me> referring to the original result set). The long
3064 term goal is to make L<DBIx::Class> always alias the current resultset as C<me>
3065 (and make this method unnecessary).
3066
3067 Thus it's currently necessary to use this method in predefined queries (see
3068 L<DBIx::Class::Manual::Cookbook/Predefined searches>) when referring to the
3069 source alias of the current result set:
3070
3071   # in a result set class
3072   sub modified_by {
3073     my ($self, $user) = @_;
3074
3075     my $me = $self->current_source_alias;
3076
3077     return $self->search({
3078       "$me.modified" => $user->id,
3079     });
3080   }
3081
3082 =cut
3083
3084 sub current_source_alias {
3085   my ($self) = @_;
3086
3087   return ($self->{attrs} || {})->{alias} || 'me';
3088 }
3089
3090 =head2 as_subselect_rs
3091
3092 =over 4
3093
3094 =item Arguments: none
3095
3096 =item Return Value: $resultset
3097
3098 =back
3099
3100 Act as a barrier to SQL symbols.  The resultset provided will be made into a
3101 "virtual view" by including it as a subquery within the from clause.  From this
3102 point on, any joined tables are inaccessible to ->search on the resultset (as if
3103 it were simply where-filtered without joins).  For example:
3104
3105  my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' });
3106
3107  # 'x' now pollutes the query namespace
3108
3109  # So the following works as expected
3110  my $ok_rs = $rs->search({'x.other' => 1});
3111
3112  # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and
3113  # def) we look for one row with contradictory terms and join in another table
3114  # (aliased 'x_2') which we never use
3115  my $broken_rs = $rs->search({'x.name' => 'def'});
3116
3117  my $rs2 = $rs->as_subselect_rs;
3118
3119  # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away
3120  my $not_joined_rs = $rs2->search({'x.other' => 1});
3121
3122  # works as expected: finds a 'table' row related to two x rows (abc and def)
3123  my $correctly_joined_rs = $rs2->search({'x.name' => 'def'});
3124
3125 Another example of when one might use this would be to select a subset of
3126 columns in a group by clause:
3127
3128  my $rs = $schema->resultset('Bar')->search(undef, {
3129    group_by => [qw{ id foo_id baz_id }],
3130  })->as_subselect_rs->search(undef, {
3131    columns => [qw{ id foo_id }]
3132  });
3133
3134 In the above example normally columns would have to be equal to the group by,
3135 but because we isolated the group by into a subselect the above works.
3136
3137 =cut
3138
3139 sub as_subselect_rs {
3140   my $self = shift;
3141
3142   my $attrs = $self->_resolved_attrs;
3143
3144   my $fresh_rs = (ref $self)->new (
3145     $self->result_source
3146   );
3147
3148   # these pieces will be locked in the subquery
3149   delete $fresh_rs->{cond};
3150   delete @{$fresh_rs->{attrs}}{qw/where bind/};
3151
3152   return $fresh_rs->search( {}, {
3153     from => [{
3154       $attrs->{alias} => $self->as_query,
3155       -alias  => $attrs->{alias},
3156       -rsrc   => $self->result_source,
3157     }],
3158     alias => $attrs->{alias},
3159   });
3160 }
3161
3162 # This code is called by search_related, and makes sure there
3163 # is clear separation between the joins before, during, and
3164 # after the relationship. This information is needed later
3165 # in order to properly resolve prefetch aliases (any alias
3166 # with a relation_chain_depth less than the depth of the
3167 # current prefetch is not considered)
3168 #
3169 # The increments happen twice per join. An even number means a
3170 # relationship specified via a search_related, whereas an odd
3171 # number indicates a join/prefetch added via attributes
3172 #
3173 # Also this code will wrap the current resultset (the one we
3174 # chain to) in a subselect IFF it contains limiting attributes
3175 sub _chain_relationship {
3176   my ($self, $rel) = @_;
3177   my $source = $self->result_source;
3178   my $attrs = { %{$self->{attrs}||{}} };
3179
3180   # we need to take the prefetch the attrs into account before we
3181   # ->_resolve_join as otherwise they get lost - captainL
3182   my $join = $self->_merge_joinpref_attr( $attrs->{join}, $attrs->{prefetch} );
3183
3184   delete @{$attrs}{qw/join prefetch collapse group_by distinct select as columns +select +as +columns/};
3185
3186   my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
3187
3188   my $from;
3189   my @force_subq_attrs = qw/offset rows group_by having/;
3190
3191   if (
3192     ($attrs->{from} && ref $attrs->{from} ne 'ARRAY')
3193       ||
3194     $self->_has_resolved_attr (@force_subq_attrs)
3195   ) {
3196     # Nuke the prefetch (if any) before the new $rs attrs
3197     # are resolved (prefetch is useless - we are wrapping
3198     # a subquery anyway).
3199     my $rs_copy = $self->search;
3200     $rs_copy->{attrs}{join} = $self->_merge_joinpref_attr (
3201       $rs_copy->{attrs}{join},
3202       delete $rs_copy->{attrs}{prefetch},
3203     );
3204
3205     $from = [{
3206       -rsrc   => $source,
3207       -alias  => $attrs->{alias},
3208       $attrs->{alias} => $rs_copy->as_query,
3209     }];
3210     delete @{$attrs}{@force_subq_attrs, qw/where bind/};
3211     $seen->{-relation_chain_depth} = 0;
3212   }
3213   elsif ($attrs->{from}) {  #shallow copy suffices
3214     $from = [ @{$attrs->{from}} ];
3215   }
3216   else {
3217     $from = [{
3218       -rsrc  => $source,
3219       -alias => $attrs->{alias},
3220       $attrs->{alias} => $source->from,
3221     }];
3222   }
3223
3224   my $jpath = ($seen->{-relation_chain_depth})
3225     ? $from->[-1][0]{-join_path}
3226     : [];
3227
3228   my @requested_joins = $source->_resolve_join(
3229     $join,
3230     $attrs->{alias},
3231     $seen,
3232     $jpath,
3233   );
3234
3235   push @$from, @requested_joins;
3236
3237   $seen->{-relation_chain_depth}++;
3238
3239   # if $self already had a join/prefetch specified on it, the requested
3240   # $rel might very well be already included. What we do in this case
3241   # is effectively a no-op (except that we bump up the chain_depth on
3242   # the join in question so we could tell it *is* the search_related)
3243   my $already_joined;
3244
3245   # we consider the last one thus reverse
3246   for my $j (reverse @requested_joins) {
3247     my ($last_j) = keys %{$j->[0]{-join_path}[-1]};
3248     if ($rel eq $last_j) {
3249       $j->[0]{-relation_chain_depth}++;
3250       $already_joined++;
3251       last;
3252     }
3253   }
3254
3255   unless ($already_joined) {
3256     push @$from, $source->_resolve_join(
3257       $rel,
3258       $attrs->{alias},
3259       $seen,
3260       $jpath,
3261     );
3262   }
3263
3264   $seen->{-relation_chain_depth}++;
3265
3266   return {%$attrs, from => $from, seen_join => $seen};
3267 }
3268
3269 # too many times we have to do $attrs = { %{$self->_resolved_attrs} }
3270 sub _resolved_attrs_copy {
3271   my $self = shift;
3272   return { %{$self->_resolved_attrs (@_)} };
3273 }
3274
3275 sub _resolved_attrs {
3276   my $self = shift;
3277   return $self->{_attrs} if $self->{_attrs};
3278
3279   my $attrs  = { %{ $self->{attrs} || {} } };
3280   my $source = $self->result_source;
3281   my $alias  = $attrs->{alias};
3282
3283   # default selection list
3284   $attrs->{columns} = [ $source->columns ]
3285     unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/;
3286
3287   # merge selectors together
3288   for (qw/columns select as/) {
3289     $attrs->{$_} = $self->_merge_attr($attrs->{$_}, delete $attrs->{"+$_"})
3290       if $attrs->{$_} or $attrs->{"+$_"};
3291   }
3292
3293   # disassemble columns
3294   my (@sel, @as);
3295   if (my $cols = delete $attrs->{columns}) {
3296     for my $c (ref $cols eq 'ARRAY' ? @$cols : $cols) {
3297       if (ref $c eq 'HASH') {
3298         for my $as (keys %$c) {
3299           push @sel, $c->{$as};
3300           push @as, $as;
3301         }
3302       }
3303       else {
3304         push @sel, $c;
3305         push @as, $c;
3306       }
3307     }
3308   }
3309
3310   # when trying to weed off duplicates later do not go past this point -
3311   # everything added from here on is unbalanced "anyone's guess" stuff
3312   my $dedup_stop_idx = $#as;
3313
3314   push @as, @{ ref $attrs->{as} eq 'ARRAY' ? $attrs->{as} : [ $attrs->{as} ] }
3315     if $attrs->{as};
3316   push @sel, @{ ref $attrs->{select} eq 'ARRAY' ? $attrs->{select} : [ $attrs->{select} ] }
3317     if $attrs->{select};
3318
3319   # assume all unqualified selectors to apply to the current alias (legacy stuff)
3320   $_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_" for @sel;
3321
3322   # disqualify all $alias.col as-bits (inflate-map mandated)
3323   $_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_ for @as;
3324
3325   # de-duplicate the result (remove *identical* select/as pairs)
3326   # and also die on duplicate {as} pointing to different {select}s
3327   # not using a c-style for as the condition is prone to shrinkage
3328   my $seen;
3329   my $i = 0;
3330   while ($i <= $dedup_stop_idx) {
3331     if ($seen->{"$sel[$i] \x00\x00 $as[$i]"}++) {
3332       splice @sel, $i, 1;
3333       splice @as, $i, 1;
3334       $dedup_stop_idx--;
3335     }
3336     elsif ($seen->{$as[$i]}++) {
3337       $self->throw_exception(
3338         "inflate_result() alias '$as[$i]' specified twice with different SQL-side {select}-ors"
3339       );
3340     }
3341     else {
3342       $i++;
3343     }
3344   }
3345
3346   $attrs->{select} = \@sel;
3347   $attrs->{as} = \@as;
3348
3349   $attrs->{from} ||= [{
3350     -rsrc   => $source,
3351     -alias  => $self->{attrs}{alias},
3352     $self->{attrs}{alias} => $source->from,
3353   }];
3354
3355   if ( $attrs->{join} || $attrs->{prefetch} ) {
3356
3357     $self->throw_exception ('join/prefetch can not be used with a custom {from}')
3358       if ref $attrs->{from} ne 'ARRAY';
3359
3360     my $join = (delete $attrs->{join}) || {};
3361
3362     if ( defined $attrs->{prefetch} ) {
3363       $join = $self->_merge_joinpref_attr( $join, $attrs->{prefetch} );
3364     }
3365
3366     $attrs->{from} =    # have to copy here to avoid corrupting the original
3367       [
3368         @{ $attrs->{from} },
3369         $source->_resolve_join(
3370           $join,
3371           $alias,
3372           { %{ $attrs->{seen_join} || {} } },
3373           ( $attrs->{seen_join} && keys %{$attrs->{seen_join}})
3374             ? $attrs->{from}[-1][0]{-join_path}
3375             : []
3376           ,
3377         )
3378       ];
3379   }
3380
3381   if ( defined $attrs->{order_by} ) {
3382     $attrs->{order_by} = (
3383       ref( $attrs->{order_by} ) eq 'ARRAY'
3384       ? [ @{ $attrs->{order_by} } ]
3385       : [ $attrs->{order_by} || () ]
3386     );
3387   }
3388
3389   if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') {
3390     $attrs->{group_by} = [ $attrs->{group_by} ];
3391   }
3392
3393   # generate the distinct induced group_by early, as prefetch will be carried via a
3394   # subquery (since a group_by is present)
3395   if (delete $attrs->{distinct}) {
3396     if ($attrs->{group_by}) {
3397       carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
3398     }
3399     else {
3400       # distinct affects only the main selection part, not what prefetch may
3401       # add below.
3402       $attrs->{group_by} = $source->storage->_group_over_selection (
3403         $attrs->{from},
3404         $attrs->{select},
3405         $attrs->{order_by},
3406       );
3407     }
3408   }
3409
3410   # generate selections based on the prefetch helper
3411   my $prefetch;
3412   $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} )
3413     if defined $attrs->{prefetch};
3414
3415   if ($prefetch) {
3416
3417     $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
3418       if $attrs->{_dark_selector};
3419
3420     $attrs->{collapse} = 1;
3421
3422     # this is a separate structure (we don't look in {from} directly)
3423     # as the resolver needs to shift things off the lists to work
3424     # properly (identical-prefetches on different branches)
3425     my $join_map = {};
3426     if (ref $attrs->{from} eq 'ARRAY') {
3427
3428       my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0;
3429
3430       for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
3431         next unless $j->[0]{-alias};
3432         next unless $j->[0]{-join_path};
3433         next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth;
3434
3435         my @jpath = map { keys %$_ } @{$j->[0]{-join_path}};
3436
3437         my $p = $join_map;
3438         $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries
3439         push @{$p->{-join_aliases} }, $j->[0]{-alias};
3440       }
3441     }
3442
3443     my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map );
3444
3445     # we need to somehow mark which columns came from prefetch
3446     if (@prefetch) {
3447       my $sel_end = $#{$attrs->{select}};
3448       $attrs->{_prefetch_selector_range} = [ $sel_end + 1, $sel_end + @prefetch ];
3449     }
3450
3451     push @{ $attrs->{select} }, (map { $_->[0] } @prefetch);
3452     push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
3453   }
3454
3455   $attrs->{_single_object_inflation} = ! List::Util::first { $_ =~ /\./ } @{$attrs->{as}};
3456
3457   # run through the resulting joinstructure (starting from our current slot)
3458   # and unset collapse if proven unnesessary
3459   if ($attrs->{collapse} && ref $attrs->{from} eq 'ARRAY') {
3460
3461     if (@{$attrs->{from}} > 1) {
3462
3463       # find where our table-spec starts and consider only things after us
3464       my @fromlist = @{$attrs->{from}};
3465       while (@fromlist) {
3466         my $t = shift @fromlist;
3467         $t = $t->[0] if ref $t eq 'ARRAY';  #me vs join from-spec mismatch
3468         last if ($t->{-alias} && $t->{-alias} eq $alias);
3469       }
3470
3471       for (@fromlist) {
3472         $attrs->{collapse} = ! $_->[0]{-is_single}
3473           and last;
3474       }
3475     }
3476     else {
3477       # no joins - no collapse
3478       $attrs->{collapse} = 0;
3479     }
3480   }
3481
3482   if (! $attrs->{order_by} and $attrs->{collapse}) {
3483     # default order for collapsing unless the user asked for something
3484     $attrs->{order_by} = [ map { "$alias.$_" } $source->primary_columns ];
3485     $attrs->{_ordered_for_collapse} = 1;
3486   }
3487
3488   # if both page and offset are specified, produce a combined offset
3489   # even though it doesn't make much sense, this is what pre 081xx has
3490   # been doing
3491   if (my $page = delete $attrs->{page}) {
3492     $attrs->{offset} =
3493       ($attrs->{rows} * ($page - 1))
3494             +
3495       ($attrs->{offset} || 0)
3496     ;
3497   }
3498
3499   return $self->{_attrs} = $attrs;
3500 }
3501
3502 sub _rollout_attr {
3503   my ($self, $attr) = @_;
3504
3505   if (ref $attr eq 'HASH') {
3506     return $self->_rollout_hash($attr);
3507   } elsif (ref $attr eq 'ARRAY') {
3508     return $self->_rollout_array($attr);
3509   } else {
3510     return [$attr];
3511   }
3512 }
3513
3514 sub _rollout_array {
3515   my ($self, $attr) = @_;
3516
3517   my @rolled_array;
3518   foreach my $element (@{$attr}) {
3519     if (ref $element eq 'HASH') {
3520       push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
3521     } elsif (ref $element eq 'ARRAY') {
3522       #  XXX - should probably recurse here
3523       push( @rolled_array, @{$self->_rollout_array($element)} );
3524     } else {
3525       push( @rolled_array, $element );
3526     }
3527   }
3528   return \@rolled_array;
3529 }
3530
3531 sub _rollout_hash {
3532   my ($self, $attr) = @_;
3533
3534   my @rolled_array;
3535   foreach my $key (keys %{$attr}) {
3536     push( @rolled_array, { $key => $attr->{$key} } );
3537   }
3538   return \@rolled_array;
3539 }
3540
3541 sub _calculate_score {
3542   my ($self, $a, $b) = @_;
3543
3544   if (defined $a xor defined $b) {
3545     return 0;
3546   }
3547   elsif (not defined $a) {
3548     return 1;
3549   }
3550
3551   if (ref $b eq 'HASH') {
3552     my ($b_key) = keys %{$b};
3553     if (ref $a eq 'HASH') {
3554       my ($a_key) = keys %{$a};
3555       if ($a_key eq $b_key) {
3556         return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
3557       } else {
3558         return 0;
3559       }
3560     } else {
3561       return ($a eq $b_key) ? 1 : 0;
3562     }
3563   } else {
3564     if (ref $a eq 'HASH') {
3565       my ($a_key) = keys %{$a};
3566       return ($b eq $a_key) ? 1 : 0;
3567     } else {
3568       return ($b eq $a) ? 1 : 0;
3569     }
3570   }
3571 }
3572
3573 sub _merge_joinpref_attr {
3574   my ($self, $orig, $import) = @_;
3575
3576   return $import unless defined($orig);
3577   return $orig unless defined($import);
3578
3579   $orig = $self->_rollout_attr($orig);
3580   $import = $self->_rollout_attr($import);
3581
3582   my $seen_keys;
3583   foreach my $import_element ( @{$import} ) {
3584     # find best candidate from $orig to merge $b_element into
3585     my $best_candidate = { position => undef, score => 0 }; my $position = 0;
3586     foreach my $orig_element ( @{$orig} ) {
3587       my $score = $self->_calculate_score( $orig_element, $import_element );
3588       if ($score > $best_candidate->{score}) {
3589         $best_candidate->{position} = $position;
3590         $best_candidate->{score} = $score;
3591       }
3592       $position++;
3593     }
3594     my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
3595     $import_key = '' if not defined $import_key;
3596
3597     if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
3598       push( @{$orig}, $import_element );
3599     } else {
3600       my $orig_best = $orig->[$best_candidate->{position}];
3601       # merge orig_best and b_element together and replace original with merged
3602       if (ref $orig_best ne 'HASH') {
3603         $orig->[$best_candidate->{position}] = $import_element;
3604       } elsif (ref $import_element eq 'HASH') {
3605         my ($key) = keys %{$orig_best};
3606         $orig->[$best_candidate->{position}] = { $key => $self->_merge_joinpref_attr($orig_best->{$key}, $import_element->{$key}) };
3607       }
3608     }
3609     $seen_keys->{$import_key} = 1; # don't merge the same key twice
3610   }
3611
3612   return $orig;
3613 }
3614
3615 {
3616   my $hm;
3617
3618   sub _merge_attr {
3619     $hm ||= do {
3620       require Hash::Merge;
3621       my $hm = Hash::Merge->new;
3622
3623       $hm->specify_behavior({
3624         SCALAR => {
3625           SCALAR => sub {
3626             my ($defl, $defr) = map { defined $_ } (@_[0,1]);
3627
3628             if ($defl xor $defr) {
3629               return [ $defl ? $_[0] : $_[1] ];
3630             }
3631             elsif (! $defl) {
3632               return [];
3633             }
3634             elsif (__HM_DEDUP and $_[0] eq $_[1]) {
3635               return [ $_[0] ];
3636             }
3637             else {
3638               return [$_[0], $_[1]];
3639             }
3640           },
3641           ARRAY => sub {
3642             return $_[1] if !defined $_[0];
3643             return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
3644             return [$_[0], @{$_[1]}]
3645           },
3646           HASH  => sub {
3647             return [] if !defined $_[0] and !keys %{$_[1]};
3648             return [ $_[1] ] if !defined $_[0];
3649             return [ $_[0] ] if !keys %{$_[1]};
3650             return [$_[0], $_[1]]
3651           },
3652         },
3653         ARRAY => {
3654           SCALAR => sub {
3655             return $_[0] if !defined $_[1];
3656             return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
3657             return [@{$_[0]}, $_[1]]
3658           },
3659           ARRAY => sub {
3660             my @ret = @{$_[0]} or return $_[1];
3661             return [ @ret, @{$_[1]} ] unless __HM_DEDUP;
3662             my %idx = map { $_ => 1 } @ret;
3663             push @ret, grep { ! defined $idx{$_} } (@{$_[1]});
3664             \@ret;
3665           },
3666           HASH => sub {
3667             return [ $_[1] ] if ! @{$_[0]};
3668             return $_[0] if !keys %{$_[1]};
3669             return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
3670             return [ @{$_[0]}, $_[1] ];
3671           },
3672         },
3673         HASH => {
3674           SCALAR => sub {
3675             return [] if !keys %{$_[0]} and !defined $_[1];
3676             return [ $_[0] ] if !defined $_[1];
3677             return [ $_[1] ] if !keys %{$_[0]};
3678             return [$_[0], $_[1]]
3679           },
3680           ARRAY => sub {
3681             return [] if !keys %{$_[0]} and !@{$_[1]};
3682             return [ $_[0] ] if !@{$_[1]};
3683             return $_[1] if !keys %{$_[0]};
3684             return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
3685             return [ $_[0], @{$_[1]} ];
3686           },
3687           HASH => sub {
3688             return [] if !keys %{$_[0]} and !keys %{$_[1]};
3689             return [ $_[0] ] if !keys %{$_[1]};
3690             return [ $_[1] ] if !keys %{$_[0]};
3691             return [ $_[0] ] if $_[0] eq $_[1];
3692             return [ $_[0], $_[1] ];
3693           },
3694         }
3695       } => 'DBIC_RS_ATTR_MERGER');
3696       $hm;
3697     };
3698
3699     return $hm->merge ($_[1], $_[2]);
3700   }
3701 }
3702
3703 sub STORABLE_freeze {
3704   my ($self, $cloning) = @_;
3705   my $to_serialize = { %$self };
3706
3707   # A cursor in progress can't be serialized (and would make little sense anyway)
3708   delete $to_serialize->{cursor};
3709
3710   # the parser can be regenerated
3711   delete $to_serialize->{_row_parser};
3712
3713   # nor is it sensical to store a not-yet-fired-count pager
3714   if ($to_serialize->{pager} and ref $to_serialize->{pager}{total_entries} eq 'CODE') {
3715     delete $to_serialize->{pager};
3716   }
3717
3718   Storable::nfreeze($to_serialize);
3719 }
3720
3721 # need this hook for symmetry
3722 sub STORABLE_thaw {
3723   my ($self, $cloning, $serialized) = @_;
3724
3725   %$self = %{ Storable::thaw($serialized) };
3726
3727   $self;
3728 }
3729
3730
3731 =head2 throw_exception
3732
3733 See L<DBIx::Class::Schema/throw_exception> for details.
3734
3735 =cut
3736
3737 sub throw_exception {
3738   my $self=shift;
3739
3740   if (ref $self and my $rsrc = $self->result_source) {
3741     $rsrc->throw_exception(@_)
3742   }
3743   else {
3744     DBIx::Class::Exception->throw(@_);
3745   }
3746 }
3747
3748 # XXX: FIXME: Attributes docs need clearing up
3749
3750 =head1 ATTRIBUTES
3751
3752 Attributes are used to refine a ResultSet in various ways when
3753 searching for data. They can be passed to any method which takes an
3754 C<\%attrs> argument. See L</search>, L</search_rs>, L</find>,
3755 L</count>.
3756
3757 These are in no particular order:
3758
3759 =head2 order_by
3760
3761 =over 4
3762
3763 =item Value: ( $order_by | \@order_by | \%order_by )
3764
3765 =back
3766
3767 Which column(s) to order the results by.
3768
3769 [The full list of suitable values is documented in
3770 L<SQL::Abstract/"ORDER BY CLAUSES">; the following is a summary of
3771 common options.]
3772
3773 If a single column name, or an arrayref of names is supplied, the
3774 argument is passed through directly to SQL. The hashref syntax allows
3775 for connection-agnostic specification of ordering direction:
3776
3777  For descending order:
3778
3779   order_by => { -desc => [qw/col1 col2 col3/] }
3780
3781  For explicit ascending order:
3782
3783   order_by => { -asc => 'col' }
3784
3785 The old scalarref syntax (i.e. order_by => \'year DESC') is still
3786 supported, although you are strongly encouraged to use the hashref
3787 syntax as outlined above.
3788
3789 =head2 columns
3790
3791 =over 4
3792
3793 =item Value: \@columns
3794
3795 =back
3796
3797 Shortcut to request a particular set of columns to be retrieved. Each
3798 column spec may be a string (a table column name), or a hash (in which
3799 case the key is the C<as> value, and the value is used as the C<select>
3800 expression). Adds C<me.> onto the start of any column without a C<.> in
3801 it and sets C<select> from that, then auto-populates C<as> from
3802 C<select> as normal. (You may also use the C<cols> attribute, as in
3803 earlier versions of DBIC.)
3804
3805 Essentially C<columns> does the same as L</select> and L</as>.
3806
3807     columns => [ 'foo', { bar => 'baz' } ]
3808
3809 is the same as
3810
3811     select => [qw/foo baz/],
3812     as => [qw/foo bar/]
3813
3814 =head2 +columns
3815
3816 =over 4
3817
3818 =item Value: \@columns
3819
3820 =back
3821
3822 Indicates additional columns to be selected from storage. Works the same
3823 as L</columns> but adds columns to the selection. (You may also use the
3824 C<include_columns> attribute, as in earlier versions of DBIC). For
3825 example:-
3826
3827   $schema->resultset('CD')->search(undef, {
3828     '+columns' => ['artist.name'],
3829     join => ['artist']
3830   });
3831
3832 would return all CDs and include a 'name' column to the information
3833 passed to object inflation. Note that the 'artist' is the name of the
3834 column (or relationship) accessor, and 'name' is the name of the column
3835 accessor in the related table.
3836
3837 B<NOTE:> You need to explicitly quote '+columns' when defining the attribute.
3838 Not doing so causes Perl to incorrectly interpret +columns as a bareword with a
3839 unary plus operator before it.
3840
3841 =head2 include_columns
3842
3843 =over 4
3844
3845 =item Value: \@columns
3846
3847 =back
3848
3849 Deprecated.  Acts as a synonym for L</+columns> for backward compatibility.
3850
3851 =head2 select
3852
3853 =over 4
3854
3855 =item Value: \@select_columns
3856
3857 =back
3858
3859 Indicates which columns should be selected from the storage. You can use
3860 column names, or in the case of RDBMS back ends, function or stored procedure
3861 names:
3862
3863   $rs = $schema->resultset('Employee')->search(undef, {
3864     select => [
3865       'name',
3866       { count => 'employeeid' },
3867       { max => { length => 'name' }, -as => 'longest_name' }
3868     ]
3869   });
3870
3871   # Equivalent SQL
3872   SELECT name, COUNT( employeeid ), MAX( LENGTH( name ) ) AS longest_name FROM employee
3873
3874 B<NOTE:> You will almost always need a corresponding L</as> attribute when you
3875 use L</select>, to instruct DBIx::Class how to store the result of the column.
3876 Also note that the L</as> attribute has nothing to do with the SQL-side 'AS'
3877 identifier aliasing. You can however alias a function, so you can use it in
3878 e.g. an C<ORDER BY> clause. This is done via the C<-as> B<select function
3879 attribute> supplied as shown in the example above.
3880
3881 B<NOTE:> You need to explicitly quote '+select'/'+as' when defining the attributes.
3882 Not doing so causes Perl to incorrectly interpret them as a bareword with a
3883 unary plus operator before it.
3884
3885 =head2 +select
3886
3887 =over 4
3888
3889 Indicates additional columns to be selected from storage.  Works the same as
3890 L</select> but adds columns to the default selection, instead of specifying
3891 an explicit list.
3892
3893 =back
3894
3895 =head2 +as
3896
3897 =over 4
3898
3899 Indicates additional column names for those added via L</+select>. See L</as>.
3900
3901 =back
3902
3903 =head2 as
3904
3905 =over 4
3906
3907 =item Value: \@inflation_names
3908
3909 =back
3910
3911 Indicates column names for object inflation. That is L</as> indicates the
3912 slot name in which the column value will be stored within the
3913 L<Row|DBIx::Class::Row> object. The value will then be accessible via this
3914 identifier by the C<get_column> method (or via the object accessor B<if one
3915 with the same name already exists>) as shown below. The L</as> attribute has
3916 B<nothing to do> with the SQL-side C<AS>. See L</select> for details.
3917
3918   $rs = $schema->resultset('Employee')->search(undef, {
3919     select => [
3920       'name',
3921       { count => 'employeeid' },
3922       { max => { length => 'name' }, -as => 'longest_name' }
3923     ],
3924     as => [qw/
3925       name
3926       employee_count
3927       max_name_length
3928     /],
3929   });
3930
3931 If the object against which the search is performed already has an accessor
3932 matching a column name specified in C<as>, the value can be retrieved using
3933 the accessor as normal:
3934
3935   my $name = $employee->name();
3936
3937 If on the other hand an accessor does not exist in the object, you need to
3938 use C<get_column> instead:
3939
3940   my $employee_count = $employee->get_column('employee_count');
3941
3942 You can create your own accessors if required - see
3943 L<DBIx::Class::Manual::Cookbook> for details.
3944
3945 =head2 join
3946
3947 =over 4
3948
3949 =item Value: ($rel_name | \@rel_names | \%rel_names)
3950
3951 =back
3952
3953 Contains a list of relationships that should be joined for this query.  For
3954 example:
3955
3956   # Get CDs by Nine Inch Nails
3957   my $rs = $schema->resultset('CD')->search(
3958     { 'artist.name' => 'Nine Inch Nails' },
3959     { join => 'artist' }
3960   );
3961
3962 Can also contain a hash reference to refer to the other relation's relations.
3963 For example:
3964
3965   package MyApp::Schema::Track;
3966   use base qw/DBIx::Class/;
3967   __PACKAGE__->table('track');
3968   __PACKAGE__->add_columns(qw/trackid cd position title/);
3969   __PACKAGE__->set_primary_key('trackid');
3970   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
3971   1;
3972
3973   # In your application
3974   my $rs = $schema->resultset('Artist')->search(
3975     { 'track.title' => 'Teardrop' },
3976     {
3977       join     => { cd => 'track' },
3978       order_by => 'artist.name',
3979     }
3980   );
3981
3982 You need to use the relationship (not the table) name in  conditions,
3983 because they are aliased as such. The current table is aliased as "me", so
3984 you need to use me.column_name in order to avoid ambiguity. For example:
3985
3986   # Get CDs from 1984 with a 'Foo' track
3987   my $rs = $schema->resultset('CD')->search(
3988     {
3989       'me.year' => 1984,
3990       'tracks.name' => 'Foo'
3991     },
3992     { join => 'tracks' }
3993   );
3994
3995 If the same join is supplied twice, it will be aliased to <rel>_2 (and
3996 similarly for a third time). For e.g.
3997
3998   my $rs = $schema->resultset('Artist')->search({
3999     'cds.title'   => 'Down to Earth',
4000     'cds_2.title' => 'Popular',
4001   }, {
4002     join => [ qw/cds cds/ ],
4003   });
4004
4005 will return a set of all artists that have both a cd with title 'Down
4006 to Earth' and a cd with title 'Popular'.
4007
4008 If you want to fetch related objects from other tables as well, see C<prefetch>
4009 below.
4010
4011 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
4012
4013 =head2 prefetch
4014
4015 =over 4
4016
4017 =item Value: ($rel_name | \@rel_names | \%rel_names)
4018
4019 =back
4020
4021 Contains one or more relationships that should be fetched along with
4022 the main query (when they are accessed afterwards the data will
4023 already be available, without extra queries to the database).  This is
4024 useful for when you know you will need the related objects, because it
4025 saves at least one query:
4026
4027   my $rs = $schema->resultset('Tag')->search(
4028     undef,
4029     {
4030       prefetch => {
4031         cd => 'artist'
4032       }
4033     }
4034   );
4035
4036 The initial search results in SQL like the following:
4037
4038   SELECT tag.*, cd.*, artist.* FROM tag
4039   JOIN cd ON tag.cd = cd.cdid
4040   JOIN artist ON cd.artist = artist.artistid
4041
4042 L<DBIx::Class> has no need to go back to the database when we access the
4043 C<cd> or C<artist> relationships, which saves us two SQL statements in this
4044 case.
4045
4046 Simple prefetches will be joined automatically, so there is no need
4047 for a C<join> attribute in the above search.
4048
4049 L</prefetch> can be used with the any of the relationship types and
4050 multiple prefetches can be specified together. Below is a more complex
4051 example that prefetches a CD's artist, its liner notes (if present),
4052 the cover image, the tracks on that cd, and the guests on those
4053 tracks.
4054
4055  # Assuming:
4056  My::Schema::CD->belongs_to( artist      => 'My::Schema::Artist'     );
4057  My::Schema::CD->might_have( liner_note  => 'My::Schema::LinerNotes' );
4058  My::Schema::CD->has_one(    cover_image => 'My::Schema::Artwork'    );
4059  My::Schema::CD->has_many(   tracks      => 'My::Schema::Track'      );
4060
4061  My::Schema::Artist->belongs_to( record_label => 'My::Schema::RecordLabel' );
4062
4063  My::Schema::Track->has_many( guests => 'My::Schema::Guest' );
4064
4065
4066  my $rs = $schema->resultset('CD')->search(
4067    undef,
4068    {
4069      prefetch => [
4070        { artist => 'record_label'},  # belongs_to => belongs_to
4071        'liner_note',                 # might_have
4072        'cover_image',                # has_one
4073        { tracks => 'guests' },       # has_many => has_many
4074      ]
4075    }
4076  );
4077
4078 This will produce SQL like the following:
4079
4080  SELECT cd.*, artist.*, record_label.*, liner_note.*, cover_image.*,
4081         tracks.*, guests.*
4082    FROM cd me
4083    JOIN artist artist
4084      ON artist.artistid = me.artistid
4085    JOIN record_label record_label
4086      ON record_label.labelid = artist.labelid
4087    LEFT JOIN track tracks
4088      ON tracks.cdid = me.cdid
4089    LEFT JOIN guest guests
4090      ON guests.trackid = track.trackid
4091    LEFT JOIN liner_notes liner_note
4092      ON liner_note.cdid = me.cdid
4093    JOIN cd_artwork cover_image
4094      ON cover_image.cdid = me.cdid
4095  ORDER BY tracks.cd
4096
4097 Now the C<artist>, C<record_label>, C<liner_note>, C<cover_image>,
4098 C<tracks>, and C<guests> of the CD will all be available through the
4099 relationship accessors without the need for additional queries to the
4100 database.
4101
4102 However, there is one caveat to be observed: it can be dangerous to
4103 prefetch more than one L<has_many|DBIx::Class::Relationship/has_many>
4104 relationship on a given level. e.g.:
4105
4106  my $rs = $schema->resultset('CD')->search(
4107    undef,
4108    {
4109      prefetch => [
4110        'tracks',                         # has_many
4111        { cd_to_producer => 'producer' }, # has_many => belongs_to (i.e. m2m)
4112      ]
4113    }
4114  );
4115
4116 In fact, C<DBIx::Class> will emit the following warning:
4117
4118  Prefetching multiple has_many rels tracks and cd_to_producer at top
4119  level will explode the number of row objects retrievable via ->next
4120  or ->all. Use at your own risk.
4121
4122 The collapser currently can't identify duplicate tuples for multiple
4123 L<has_many|DBIx::Class::Relationship/has_many> relationships and as a
4124 result the second L<has_many|DBIx::Class::Relationship/has_many>
4125 relation could contain redundant objects.
4126
4127 =head3 Using L</prefetch> with L</join>
4128
4129 L</prefetch> implies a L</join> with the equivalent argument, and is
4130 properly merged with any existing L</join> specification. So the
4131 following:
4132
4133   my $rs = $schema->resultset('CD')->search(
4134    {'record_label.name' => 'Music Product Ltd.'},
4135    {
4136      join     => {artist => 'record_label'},
4137      prefetch => 'artist',
4138    }
4139  );
4140
4141 ... will work, searching on the record label's name, but only
4142 prefetching the C<artist>.
4143
4144 =head3 Using L</prefetch> with L</select> / L</+select> / L</as> / L</+as>
4145
4146 L</prefetch> implies a L</+select>/L</+as> with the fields of the
4147 prefetched relations.  So given:
4148
4149   my $rs = $schema->resultset('CD')->search(
4150    undef,
4151    {
4152      select   => ['cd.title'],
4153      as       => ['cd_title'],
4154      prefetch => 'artist',
4155    }
4156  );
4157
4158 The L</select> becomes: C<'cd.title', 'artist.*'> and the L</as>
4159 becomes: C<'cd_title', 'artist.*'>.
4160
4161 =head3 CAVEATS
4162
4163 Prefetch does a lot of deep magic. As such, it may not behave exactly
4164 as you might expect.
4165
4166 =over 4
4167
4168 =item *
4169
4170 Prefetch uses the L</cache> to populate the prefetched relationships. This
4171 may or may not be what you want.
4172
4173 =item *
4174
4175 If you specify a condition on a prefetched relationship, ONLY those
4176 rows that match the prefetched condition will be fetched into that relationship.
4177 This means that adding prefetch to a search() B<may alter> what is returned by
4178 traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
4179
4180   my $artist_rs = $schema->resultset('Artist')->search({
4181       'cds.year' => 2008,
4182   }, {
4183       join => 'cds',
4184   });
4185
4186   my $count = $artist_rs->first->cds->count;
4187
4188   my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
4189
4190   my $prefetch_count = $artist_rs_prefetch->first->cds->count;
4191
4192   cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
4193
4194 that cmp_ok() may or may not pass depending on the datasets involved. This
4195 behavior may or may not survive the 0.09 transition.
4196
4197 =back
4198
4199 =head2 page
4200
4201 =over 4
4202
4203 =item Value: $page
4204
4205 =back
4206
4207 Makes the resultset paged and specifies the page to retrieve. Effectively
4208 identical to creating a non-pages resultset and then calling ->page($page)
4209 on it.
4210
4211 If L</rows> attribute is not specified it defaults to 10 rows per page.
4212
4213 When you have a paged resultset, L</count> will only return the number
4214 of rows in the page. To get the total, use the L</pager> and call
4215 C<total_entries> on it.
4216
4217 =head2 rows
4218
4219 =over 4
4220
4221 =item Value: $rows
4222
4223 =back
4224
4225 Specifies the maximum number of rows for direct retrieval or the number of
4226 rows per page if the page attribute or method is used.
4227
4228 =head2 offset
4229
4230 =over 4
4231
4232 =item Value: $offset
4233
4234 =back
4235
4236 Specifies the (zero-based) row number for the  first row to be returned, or the
4237 of the first row of the first page if paging is used.
4238
4239 =head2 software_limit
4240
4241 =over 4
4242
4243 =item Value: (0 | 1)
4244
4245 =back
4246
4247 When combined with L</rows> and/or L</offset> the generated SQL will not
4248 include any limit dialect stanzas. Instead the entire result will be selected
4249 as if no limits were specified, and DBIC will perform the limit locally, by
4250 artificially advancing and finishing the resulting L</cursor>.
4251
4252 This is the recommended way of performing resultset limiting when no sane RDBMS
4253 implementation is available (e.g.
4254 L<Sybase ASE|DBIx::Class::Storage::DBI::Sybase::ASE> using the
4255 L<Generic Sub Query|DBIx::Class::SQLMaker::LimitDialects/GenericSubQ> hack)
4256
4257 =head2 group_by
4258
4259 =over 4
4260
4261 =item Value: \@columns
4262
4263 =back
4264
4265 A arrayref of columns to group by. Can include columns of joined tables.
4266
4267   group_by => [qw/ column1 column2 ... /]
4268
4269 =head2 having
4270
4271 =over 4
4272
4273 =item Value: $condition
4274
4275 =back
4276
4277 HAVING is a select statement attribute that is applied between GROUP BY and
4278 ORDER BY. It is applied to the after the grouping calculations have been
4279 done.
4280
4281   having => { 'count_employee' => { '>=', 100 } }
4282
4283 or with an in-place function in which case literal SQL is required:
4284
4285   having => \[ 'count(employee) >= ?', [ count => 100 ] ]
4286
4287 =head2 distinct
4288
4289 =over 4
4290
4291 =item Value: (0 | 1)
4292
4293 =back
4294
4295 Set to 1 to group by all columns. If the resultset already has a group_by
4296 attribute, this setting is ignored and an appropriate warning is issued.
4297
4298 =head2 where
4299
4300 =over 4
4301
4302 Adds to the WHERE clause.
4303
4304   # only return rows WHERE deleted IS NULL for all searches
4305   __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
4306
4307 Can be overridden by passing C<< { where => undef } >> as an attribute
4308 to a resultset.
4309
4310 For more complicated where clauses see L<SQL::Abstract/WHERE CLAUSES>.
4311
4312 =back
4313
4314 =head2 cache
4315
4316 Set to 1 to cache search results. This prevents extra SQL queries if you
4317 revisit rows in your ResultSet:
4318
4319   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
4320
4321   while( my $artist = $resultset->next ) {
4322     ... do stuff ...
4323   }
4324
4325   $rs->first; # without cache, this would issue a query
4326
4327 By default, searches are not cached.
4328
4329 For more examples of using these attributes, see
4330 L<DBIx::Class::Manual::Cookbook>.
4331
4332 =head2 for
4333
4334 =over 4
4335
4336 =item Value: ( 'update' | 'shared' )
4337
4338 =back
4339
4340 Set to 'update' for a SELECT ... FOR UPDATE or 'shared' for a SELECT
4341 ... FOR SHARED.
4342
4343 =cut
4344
4345 1;