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