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