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   my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/);
1658   my $needs_subq = $needs_group_by_subq || $self->_has_resolved_attr(qw/rows offset/);
1659
1660   if ($needs_group_by_subq or $needs_subq) {
1661
1662     # make a new $rs selecting only the PKs (that's all we really need)
1663     my $attrs = $self->_resolved_attrs_copy;
1664
1665
1666     delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_selector_range as/;
1667     $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ];
1668
1669     if ($needs_group_by_subq) {
1670       # make sure no group_by was supplied, or if there is one - make sure it matches
1671       # the columns compiled above perfectly. Anything else can not be sanely executed
1672       # on most databases so croak right then and there
1673
1674       if (my $g = $attrs->{group_by}) {
1675         my @current_group_by = map
1676           { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
1677           @$g
1678         ;
1679
1680         if (
1681           join ("\x00", sort @current_group_by)
1682             ne
1683           join ("\x00", sort @{$attrs->{columns}} )
1684         ) {
1685           $self->throw_exception (
1686             "You have just attempted a $op operation on a resultset which does group_by"
1687             . ' on columns other than the primary keys, while DBIC internally needs to retrieve'
1688             . ' the primary keys in a subselect. All sane RDBMS engines do not support this'
1689             . ' kind of queries. Please retry the operation with a modified group_by or'
1690             . ' without using one at all.'
1691           );
1692         }
1693       }
1694       else {
1695         $attrs->{group_by} = $attrs->{columns};
1696       }
1697     }
1698
1699     my $subrs = (ref $self)->new($rsrc, $attrs);
1700     return $self->result_source->storage->_subq_update_delete($subrs, $op, $values);
1701   }
1702   else {
1703     # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
1704     # a condition containing 'me' or other table prefixes will not work
1705     # at all. What this code tries to do (badly) is to generate a condition
1706     # with the qualifiers removed, by exploiting the quote mechanism of sqla
1707     #
1708     # this is atrocious and should be replaced by normal sqla introspection
1709     # one sunny day
1710     my ($sql, @bind) = do {
1711       my $sqla = $rsrc->storage->sql_maker;
1712       local $sqla->{_dequalify_idents} = 1;
1713       $sqla->_recurse_where($self->{cond});
1714     } if $self->{cond};
1715
1716     return $rsrc->storage->$op(
1717       $rsrc,
1718       $op eq 'update' ? $values : (),
1719       $self->{cond} ? \[$sql, @bind] : (),
1720     );
1721   }
1722 }
1723
1724 =head2 update
1725
1726 =over 4
1727
1728 =item Arguments: \%values
1729
1730 =item Return Value: $storage_rv
1731
1732 =back
1733
1734 Sets the specified columns in the resultset to the supplied values in a
1735 single query. Note that this will not run any accessor/set_column/update
1736 triggers, nor will it update any row object instances derived from this
1737 resultset (this includes the contents of the L<resultset cache|/set_cache>
1738 if any). See L</update_all> if you need to execute any on-update
1739 triggers or cascades defined either by you or a
1740 L<result component|DBIx::Class::Manual::Component/WHAT_IS_A_COMPONENT>.
1741
1742 The return value is a pass through of what the underlying
1743 storage backend returned, and may vary. See L<DBI/execute> for the most
1744 common case.
1745
1746 =head3 CAVEAT
1747
1748 Note that L</update> does not process/deflate any of the values passed in.
1749 This is unlike the corresponding L<DBIx::Class::Row/update>. The user must
1750 ensure manually that any value passed to this method will stringify to
1751 something the RDBMS knows how to deal with. A notable example is the
1752 handling of L<DateTime> objects, for more info see:
1753 L<DBIx::Class::Manual::Cookbook/Formatting_DateTime_objects_in_queries>.
1754
1755 =cut
1756
1757 sub update {
1758   my ($self, $values) = @_;
1759   $self->throw_exception('Values for update must be a hash')
1760     unless ref $values eq 'HASH';
1761
1762   return $self->_rs_update_delete ('update', $values);
1763 }
1764
1765 =head2 update_all
1766
1767 =over 4
1768
1769 =item Arguments: \%values
1770
1771 =item Return Value: 1
1772
1773 =back
1774
1775 Fetches all objects and updates them one at a time via
1776 L<DBIx::Class::Row/update>. Note that C<update_all> will run DBIC defined
1777 triggers, while L</update> will not.
1778
1779 =cut
1780
1781 sub update_all {
1782   my ($self, $values) = @_;
1783   $self->throw_exception('Values for update_all must be a hash')
1784     unless ref $values eq 'HASH';
1785
1786   my $guard = $self->result_source->schema->txn_scope_guard;
1787   $_->update($values) for $self->all;
1788   $guard->commit;
1789   return 1;
1790 }
1791
1792 =head2 delete
1793
1794 =over 4
1795
1796 =item Arguments: none
1797
1798 =item Return Value: $storage_rv
1799
1800 =back
1801
1802 Deletes the rows matching this resultset in a single query. Note that this
1803 will not run any delete triggers, nor will it alter the
1804 L<in_storage|DBIx::Class::Row/in_storage> status of any row object instances
1805 derived from this resultset (this includes the contents of the
1806 L<resultset cache|/set_cache> if any). See L</delete_all> if you need to
1807 execute any on-delete triggers or cascades defined either by you or a
1808 L<result component|DBIx::Class::Manual::Component/WHAT_IS_A_COMPONENT>.
1809
1810 The return value is a pass through of what the underlying storage backend
1811 returned, and may vary. See L<DBI/execute> for the most common case.
1812
1813 =cut
1814
1815 sub delete {
1816   my $self = shift;
1817   $self->throw_exception('delete does not accept any arguments')
1818     if @_;
1819
1820   return $self->_rs_update_delete ('delete');
1821 }
1822
1823 =head2 delete_all
1824
1825 =over 4
1826
1827 =item Arguments: none
1828
1829 =item Return Value: 1
1830
1831 =back
1832
1833 Fetches all objects and deletes them one at a time via
1834 L<DBIx::Class::Row/delete>. Note that C<delete_all> will run DBIC defined
1835 triggers, while L</delete> will not.
1836
1837 =cut
1838
1839 sub delete_all {
1840   my $self = shift;
1841   $self->throw_exception('delete_all does not accept any arguments')
1842     if @_;
1843
1844   my $guard = $self->result_source->schema->txn_scope_guard;
1845   $_->delete for $self->all;
1846   $guard->commit;
1847   return 1;
1848 }
1849
1850 =head2 populate
1851
1852 =over 4
1853
1854 =item Arguments: \@data;
1855
1856 =back
1857
1858 Accepts either an arrayref of hashrefs or alternatively an arrayref of arrayrefs.
1859 For the arrayref of hashrefs style each hashref should be a structure suitable
1860 for submitting to a $resultset->create(...) method.
1861
1862 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
1863 to insert the data, as this is a faster method.
1864
1865 Otherwise, each set of data is inserted into the database using
1866 L<DBIx::Class::ResultSet/create>, and the resulting objects are
1867 accumulated into an array. The array itself, or an array reference
1868 is returned depending on scalar or list context.
1869
1870 Example:  Assuming an Artist Class that has many CDs Classes relating:
1871
1872   my $Artist_rs = $schema->resultset("Artist");
1873
1874   ## Void Context Example
1875   $Artist_rs->populate([
1876      { artistid => 4, name => 'Manufactured Crap', cds => [
1877         { title => 'My First CD', year => 2006 },
1878         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
1879       ],
1880      },
1881      { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
1882         { title => 'My parents sold me to a record company', year => 2005 },
1883         { title => 'Why Am I So Ugly?', year => 2006 },
1884         { title => 'I Got Surgery and am now Popular', year => 2007 }
1885       ],
1886      },
1887   ]);
1888
1889   ## Array Context Example
1890   my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([
1891     { name => "Artist One"},
1892     { name => "Artist Two"},
1893     { name => "Artist Three", cds=> [
1894     { title => "First CD", year => 2007},
1895     { title => "Second CD", year => 2008},
1896   ]}
1897   ]);
1898
1899   print $ArtistOne->name; ## response is 'Artist One'
1900   print $ArtistThree->cds->count ## reponse is '2'
1901
1902 For the arrayref of arrayrefs style,  the first element should be a list of the
1903 fieldsnames to which the remaining elements are rows being inserted.  For
1904 example:
1905
1906   $Arstist_rs->populate([
1907     [qw/artistid name/],
1908     [100, 'A Formally Unknown Singer'],
1909     [101, 'A singer that jumped the shark two albums ago'],
1910     [102, 'An actually cool singer'],
1911   ]);
1912
1913 Please note an important effect on your data when choosing between void and
1914 wantarray context. Since void context goes straight to C<insert_bulk> in
1915 L<DBIx::Class::Storage::DBI> this will skip any component that is overriding
1916 C<insert>.  So if you are using something like L<DBIx-Class-UUIDColumns> to
1917 create primary keys for you, you will find that your PKs are empty.  In this
1918 case you will have to use the wantarray context in order to create those
1919 values.
1920
1921 =cut
1922
1923 sub populate {
1924   my $self = shift;
1925
1926   # cruft placed in standalone method
1927   my $data = $self->_normalize_populate_args(@_);
1928
1929   if(defined wantarray) {
1930     my @created;
1931     foreach my $item (@$data) {
1932       push(@created, $self->create($item));
1933     }
1934     return wantarray ? @created : \@created;
1935   }
1936   else {
1937     my $first = $data->[0];
1938
1939     # if a column is a registered relationship, and is a non-blessed hash/array, consider
1940     # it relationship data
1941     my (@rels, @columns);
1942     my $rsrc = $self->result_source;
1943     my $rels = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships };
1944     for (keys %$first) {
1945       my $ref = ref $first->{$_};
1946       $rels->{$_} && ($ref eq 'ARRAY' or $ref eq 'HASH')
1947         ? push @rels, $_
1948         : push @columns, $_
1949       ;
1950     }
1951
1952     my @pks = $rsrc->primary_columns;
1953
1954     ## do the belongs_to relationships
1955     foreach my $index (0..$#$data) {
1956
1957       # delegate to create() for any dataset without primary keys with specified relationships
1958       if (grep { !defined $data->[$index]->{$_} } @pks ) {
1959         for my $r (@rels) {
1960           if (grep { ref $data->[$index]{$r} eq $_ } qw/HASH ARRAY/) {  # a related set must be a HASH or AoH
1961             my @ret = $self->populate($data);
1962             return;
1963           }
1964         }
1965       }
1966
1967       foreach my $rel (@rels) {
1968         next unless ref $data->[$index]->{$rel} eq "HASH";
1969         my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
1970         my ($reverse_relname, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)};
1971         my $related = $result->result_source->_resolve_condition(
1972           $reverse_relinfo->{cond},
1973           $self,
1974           $result,
1975           $rel,
1976         );
1977
1978         delete $data->[$index]->{$rel};
1979         $data->[$index] = {%{$data->[$index]}, %$related};
1980
1981         push @columns, keys %$related if $index == 0;
1982       }
1983     }
1984
1985     ## inherit the data locked in the conditions of the resultset
1986     my ($rs_data) = $self->_merge_with_rscond({});
1987     delete @{$rs_data}{@columns};
1988     my @inherit_cols = keys %$rs_data;
1989     my @inherit_data = values %$rs_data;
1990
1991     ## do bulk insert on current row
1992     $rsrc->storage->insert_bulk(
1993       $rsrc,
1994       [@columns, @inherit_cols],
1995       [ map { [ @$_{@columns}, @inherit_data ] } @$data ],
1996     );
1997
1998     ## do the has_many relationships
1999     foreach my $item (@$data) {
2000
2001       my $main_row;
2002
2003       foreach my $rel (@rels) {
2004         next unless ref $item->{$rel} eq "ARRAY" && @{ $item->{$rel} };
2005
2006         $main_row ||= $self->new_result({map { $_ => $item->{$_} } @pks});
2007
2008         my $child = $main_row->$rel;
2009
2010         my $related = $child->result_source->_resolve_condition(
2011           $rels->{$rel}{cond},
2012           $child,
2013           $main_row,
2014           $rel,
2015         );
2016
2017         my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
2018         my @populate = map { {%$_, %$related} } @rows_to_add;
2019
2020         $child->populate( \@populate );
2021       }
2022     }
2023   }
2024 }
2025
2026
2027 # populate() argumnets went over several incarnations
2028 # What we ultimately support is AoH
2029 sub _normalize_populate_args {
2030   my ($self, $arg) = @_;
2031
2032   if (ref $arg eq 'ARRAY') {
2033     if (ref $arg->[0] eq 'HASH') {
2034       return $arg;
2035     }
2036     elsif (ref $arg->[0] eq 'ARRAY') {
2037       my @ret;
2038       my @colnames = @{$arg->[0]};
2039       foreach my $values (@{$arg}[1 .. $#$arg]) {
2040         push @ret, { map { $colnames[$_] => $values->[$_] } (0 .. $#colnames) };
2041       }
2042       return \@ret;
2043     }
2044   }
2045
2046   $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs');
2047 }
2048
2049 =head2 pager
2050
2051 =over 4
2052
2053 =item Arguments: none
2054
2055 =item Return Value: $pager
2056
2057 =back
2058
2059 Return Value a L<Data::Page> object for the current resultset. Only makes
2060 sense for queries with a C<page> attribute.
2061
2062 To get the full count of entries for a paged resultset, call
2063 C<total_entries> on the L<Data::Page> object.
2064
2065 =cut
2066
2067 # make a wizard good for both a scalar and a hashref
2068 my $mk_lazy_count_wizard = sub {
2069   require Variable::Magic;
2070
2071   my $stash = { total_rs => shift };
2072   my $slot = shift; # only used by the hashref magic
2073
2074   my $magic = Variable::Magic::wizard (
2075     data => sub { $stash },
2076
2077     (!$slot)
2078     ? (
2079       # the scalar magic
2080       get => sub {
2081         # set value lazily, and dispell for good
2082         ${$_[0]} = $_[1]{total_rs}->count;
2083         Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref});
2084         return 1;
2085       },
2086       set => sub {
2087         # an explicit set implies dispell as well
2088         # the unless() is to work around "fun and giggles" below
2089         Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref})
2090           unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager';
2091         return 1;
2092       },
2093     )
2094     : (
2095       # the uvar magic
2096       fetch => sub {
2097         if ($_[2] eq $slot and !$_[1]{inactive}) {
2098           my $cnt = $_[1]{total_rs}->count;
2099           $_[0]->{$slot} = $cnt;
2100
2101           # attempting to dispell in a fetch handle (works in store), seems
2102           # to invariable segfault on 5.10, 5.12, 5.13 :(
2103           # so use an inactivator instead
2104           #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref});
2105           $_[1]{inactive}++;
2106         }
2107         return 1;
2108       },
2109       store => sub {
2110         if (! $_[1]{inactive} and $_[2] eq $slot) {
2111           #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref});
2112           $_[1]{inactive}++
2113             unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager';
2114         }
2115         return 1;
2116       },
2117     ),
2118   );
2119
2120   $stash->{magic_selfref} = $magic;
2121   weaken ($stash->{magic_selfref}); # this fails on 5.8.1
2122
2123   return $magic;
2124 };
2125
2126 # the tie class for 5.8.1
2127 {
2128   package # hide from pause
2129     DBIx::Class::__DBIC_LAZY_RS_COUNT__;
2130   use base qw/Tie::Hash/;
2131
2132   sub FIRSTKEY { my $dummy = scalar keys %{$_[0]{data}}; each %{$_[0]{data}} }
2133   sub NEXTKEY  { each %{$_[0]{data}} }
2134   sub EXISTS   { exists $_[0]{data}{$_[1]} }
2135   sub DELETE   { delete $_[0]{data}{$_[1]} }
2136   sub CLEAR    { %{$_[0]{data}} = () }
2137   sub SCALAR   { scalar %{$_[0]{data}} }
2138
2139   sub TIEHASH {
2140     $_[1]{data} = {%{$_[1]{selfref}}};
2141     %{$_[1]{selfref}} = ();
2142     Scalar::Util::weaken ($_[1]{selfref});
2143     return bless ($_[1], $_[0]);
2144   };
2145
2146   sub FETCH {
2147     if ($_[1] eq $_[0]{slot}) {
2148       my $cnt = $_[0]{data}{$_[1]} = $_[0]{total_rs}->count;
2149       untie %{$_[0]{selfref}};
2150       %{$_[0]{selfref}} = %{$_[0]{data}};
2151       return $cnt;
2152     }
2153     else {
2154       $_[0]{data}{$_[1]};
2155     }
2156   }
2157
2158   sub STORE {
2159     $_[0]{data}{$_[1]} = $_[2];
2160     if ($_[1] eq $_[0]{slot}) {
2161       untie %{$_[0]{selfref}};
2162       %{$_[0]{selfref}} = %{$_[0]{data}};
2163     }
2164     $_[2];
2165   }
2166 }
2167
2168 sub pager {
2169   my ($self) = @_;
2170
2171   return $self->{pager} if $self->{pager};
2172
2173   my $attrs = $self->{attrs};
2174   if (!defined $attrs->{page}) {
2175     $self->throw_exception("Can't create pager for non-paged rs");
2176   }
2177   elsif ($attrs->{page} <= 0) {
2178     $self->throw_exception('Invalid page number (page-numbers are 1-based)');
2179   }
2180   $attrs->{rows} ||= 10;
2181
2182   # throw away the paging flags and re-run the count (possibly
2183   # with a subselect) to get the real total count
2184   my $count_attrs = { %$attrs };
2185   delete $count_attrs->{$_} for qw/rows offset page pager/;
2186   my $total_rs = (ref $self)->new($self->result_source, $count_attrs);
2187
2188
2189 ### the following may seem awkward and dirty, but it's a thought-experiment
2190 ### necessary for future development of DBIx::DS. Do *NOT* change this code
2191 ### before talking to ribasushi/mst
2192
2193   require Data::Page;
2194   my $pager = Data::Page->new(
2195     0,  #start with an empty set
2196     $attrs->{rows},
2197     $self->{attrs}{page},
2198   );
2199
2200   my $data_slot = 'total_entries';
2201
2202   # Since we are interested in a cached value (once it's set - it's set), every
2203   # technique will detach from the magic-host once the time comes to fire the
2204   # ->count (or in the segfaulting case of >= 5.10 it will deactivate itself)
2205
2206   if ($] < 5.008003) {
2207     # 5.8.1 throws 'Modification of a read-only value attempted' when one tries
2208     # to weakref the magic container :(
2209     # tested on 5.8.1
2210     tie (%$pager, 'DBIx::Class::__DBIC_LAZY_RS_COUNT__',
2211       { slot => $data_slot, total_rs => $total_rs, selfref => $pager }
2212     );
2213   }
2214   elsif ($] < 5.010) {
2215     # We can use magic on the hash value slot. It's interesting that the magic is
2216     # attached to the hash-slot, and does *not* stop working once I do the dummy
2217     # assignments after the cast()
2218     # tested on 5.8.3 and 5.8.9
2219     my $magic = $mk_lazy_count_wizard->($total_rs);
2220     Variable::Magic::cast ( $pager->{$data_slot}, $magic );
2221
2222     # this is for fun and giggles
2223     $pager->{$data_slot} = -1;
2224     $pager->{$data_slot} = 0;
2225
2226     # this does not work for scalars, but works with
2227     # uvar magic below
2228     #my %vals = %$pager;
2229     #%$pager = ();
2230     #%{$pager} = %vals;
2231   }
2232   else {
2233     # And the uvar magic
2234     # works on 5.10.1, 5.12.1 and 5.13.4 in its current form,
2235     # however see the wizard maker for more notes
2236     my $magic = $mk_lazy_count_wizard->($total_rs, $data_slot);
2237     Variable::Magic::cast ( %$pager, $magic );
2238
2239     # still works
2240     $pager->{$data_slot} = -1;
2241     $pager->{$data_slot} = 0;
2242
2243     # this now works
2244     my %vals = %$pager;
2245     %$pager = ();
2246     %{$pager} = %vals;
2247   }
2248
2249   return $self->{pager} = $pager;
2250 }
2251
2252 =head2 page
2253
2254 =over 4
2255
2256 =item Arguments: $page_number
2257
2258 =item Return Value: $rs
2259
2260 =back
2261
2262 Returns a resultset for the $page_number page of the resultset on which page
2263 is called, where each page contains a number of rows equal to the 'rows'
2264 attribute set on the resultset (10 by default).
2265
2266 =cut
2267
2268 sub page {
2269   my ($self, $page) = @_;
2270   return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
2271 }
2272
2273 =head2 new_result
2274
2275 =over 4
2276
2277 =item Arguments: \%vals
2278
2279 =item Return Value: $rowobject
2280
2281 =back
2282
2283 Creates a new row object in the resultset's result class and returns
2284 it. The row is not inserted into the database at this point, call
2285 L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
2286 will tell you whether the row object has been inserted or not.
2287
2288 Passes the hashref of input on to L<DBIx::Class::Row/new>.
2289
2290 =cut
2291
2292 sub new_result {
2293   my ($self, $values) = @_;
2294   $self->throw_exception( "new_result needs a hash" )
2295     unless (ref $values eq 'HASH');
2296
2297   my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values);
2298
2299   my %new = (
2300     %$merged_cond,
2301     @$cols_from_relations
2302       ? (-cols_from_relations => $cols_from_relations)
2303       : (),
2304     -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
2305   );
2306
2307   return $self->result_class->new(\%new);
2308 }
2309
2310 # _merge_with_rscond
2311 #
2312 # Takes a simple hash of K/V data and returns its copy merged with the
2313 # condition already present on the resultset. Additionally returns an
2314 # arrayref of value/condition names, which were inferred from related
2315 # objects (this is needed for in-memory related objects)
2316 sub _merge_with_rscond {
2317   my ($self, $data) = @_;
2318
2319   my (%new_data, @cols_from_relations);
2320
2321   my $alias = $self->{attrs}{alias};
2322
2323   if (! defined $self->{cond}) {
2324     # just massage $data below
2325   }
2326   elsif ($self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
2327     %new_data = %{ $self->{attrs}{related_objects} || {} };  # nothing might have been inserted yet
2328     @cols_from_relations = keys %new_data;
2329   }
2330   elsif (ref $self->{cond} ne 'HASH') {
2331     $self->throw_exception(
2332       "Can't abstract implicit construct, resultset condition not a hash"
2333     );
2334   }
2335   else {
2336     # precendence must be given to passed values over values inherited from
2337     # the cond, so the order here is important.
2338     my $collapsed_cond = $self->_collapse_cond($self->{cond});
2339     my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
2340
2341     while ( my($col, $value) = each %implied ) {
2342       my $vref = ref $value;
2343       if (
2344         $vref eq 'HASH'
2345           and
2346         keys(%$value) == 1
2347           and
2348         (keys %$value)[0] eq '='
2349       ) {
2350         $new_data{$col} = $value->{'='};
2351       }
2352       elsif( !$vref or $vref eq 'SCALAR' or blessed($value) ) {
2353         $new_data{$col} = $value;
2354       }
2355     }
2356   }
2357
2358   %new_data = (
2359     %new_data,
2360     %{ $self->_remove_alias($data, $alias) },
2361   );
2362
2363   return (\%new_data, \@cols_from_relations);
2364 }
2365
2366 # _has_resolved_attr
2367 #
2368 # determines if the resultset defines at least one
2369 # of the attributes supplied
2370 #
2371 # used to determine if a subquery is neccessary
2372 #
2373 # supports some virtual attributes:
2374 #   -join
2375 #     This will scan for any joins being present on the resultset.
2376 #     It is not a mere key-search but a deep inspection of {from}
2377 #
2378
2379 sub _has_resolved_attr {
2380   my ($self, @attr_names) = @_;
2381
2382   my $attrs = $self->_resolved_attrs;
2383
2384   my %extra_checks;
2385
2386   for my $n (@attr_names) {
2387     if (grep { $n eq $_ } (qw/-join/) ) {
2388       $extra_checks{$n}++;
2389       next;
2390     }
2391
2392     my $attr =  $attrs->{$n};
2393
2394     next if not defined $attr;
2395
2396     if (ref $attr eq 'HASH') {
2397       return 1 if keys %$attr;
2398     }
2399     elsif (ref $attr eq 'ARRAY') {
2400       return 1 if @$attr;
2401     }
2402     else {
2403       return 1 if $attr;
2404     }
2405   }
2406
2407   # a resolved join is expressed as a multi-level from
2408   return 1 if (
2409     $extra_checks{-join}
2410       and
2411     ref $attrs->{from} eq 'ARRAY'
2412       and
2413     @{$attrs->{from}} > 1
2414   );
2415
2416   return 0;
2417 }
2418
2419 # _collapse_cond
2420 #
2421 # Recursively collapse the condition.
2422
2423 sub _collapse_cond {
2424   my ($self, $cond, $collapsed) = @_;
2425
2426   $collapsed ||= {};
2427
2428   if (ref $cond eq 'ARRAY') {
2429     foreach my $subcond (@$cond) {
2430       next unless ref $subcond;  # -or
2431       $collapsed = $self->_collapse_cond($subcond, $collapsed);
2432     }
2433   }
2434   elsif (ref $cond eq 'HASH') {
2435     if (keys %$cond and (keys %$cond)[0] eq '-and') {
2436       foreach my $subcond (@{$cond->{-and}}) {
2437         $collapsed = $self->_collapse_cond($subcond, $collapsed);
2438       }
2439     }
2440     else {
2441       foreach my $col (keys %$cond) {
2442         my $value = $cond->{$col};
2443         $collapsed->{$col} = $value;
2444       }
2445     }
2446   }
2447
2448   return $collapsed;
2449 }
2450
2451 # _remove_alias
2452 #
2453 # Remove the specified alias from the specified query hash. A copy is made so
2454 # the original query is not modified.
2455
2456 sub _remove_alias {
2457   my ($self, $query, $alias) = @_;
2458
2459   my %orig = %{ $query || {} };
2460   my %unaliased;
2461
2462   foreach my $key (keys %orig) {
2463     if ($key !~ /\./) {
2464       $unaliased{$key} = $orig{$key};
2465       next;
2466     }
2467     $unaliased{$1} = $orig{$key}
2468       if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
2469   }
2470
2471   return \%unaliased;
2472 }
2473
2474 =head2 as_query
2475
2476 =over 4
2477
2478 =item Arguments: none
2479
2480 =item Return Value: \[ $sql, @bind ]
2481
2482 =back
2483
2484 Returns the SQL query and bind vars associated with the invocant.
2485
2486 This is generally used as the RHS for a subquery.
2487
2488 =cut
2489
2490 sub as_query {
2491   my $self = shift;
2492
2493   my $attrs = $self->_resolved_attrs_copy;
2494
2495   # For future use:
2496   #
2497   # in list ctx:
2498   # my ($sql, \@bind, \%dbi_bind_attrs) = _select_args_to_query (...)
2499   # $sql also has no wrapping parenthesis in list ctx
2500   #
2501   my $sqlbind = $self->result_source->storage
2502     ->_select_args_to_query ($attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs);
2503
2504   return $sqlbind;
2505 }
2506
2507 =head2 find_or_new
2508
2509 =over 4
2510
2511 =item Arguments: \%vals, \%attrs?
2512
2513 =item Return Value: $rowobject
2514
2515 =back
2516
2517   my $artist = $schema->resultset('Artist')->find_or_new(
2518     { artist => 'fred' }, { key => 'artists' });
2519
2520   $cd->cd_to_producer->find_or_new({ producer => $producer },
2521                                    { key => 'primary });
2522
2523 Find an existing record from this resultset using L</find>. if none exists,
2524 instantiate a new result object and return it. The object will not be saved
2525 into your storage until you call L<DBIx::Class::Row/insert> on it.
2526
2527 You most likely want this method when looking for existing rows using a unique
2528 constraint that is not the primary key, or looking for related rows.
2529
2530 If you want objects to be saved immediately, use L</find_or_create> instead.
2531
2532 B<Note>: Make sure to read the documentation of L</find> and understand the
2533 significance of the C<key> attribute, as its lack may skew your search, and
2534 subsequently result in spurious new objects.
2535
2536 B<Note>: Take care when using C<find_or_new> with a table having
2537 columns with default values that you intend to be automatically
2538 supplied by the database (e.g. an auto_increment primary key column).
2539 In normal usage, the value of such columns should NOT be included at
2540 all in the call to C<find_or_new>, even when set to C<undef>.
2541
2542 =cut
2543
2544 sub find_or_new {
2545   my $self     = shift;
2546   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2547   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2548   if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2549     return $row;
2550   }
2551   return $self->new_result($hash);
2552 }
2553
2554 =head2 create
2555
2556 =over 4
2557
2558 =item Arguments: \%vals
2559
2560 =item Return Value: a L<DBIx::Class::Row> $object
2561
2562 =back
2563
2564 Attempt to create a single new row or a row with multiple related rows
2565 in the table represented by the resultset (and related tables). This
2566 will not check for duplicate rows before inserting, use
2567 L</find_or_create> to do that.
2568
2569 To create one row for this resultset, pass a hashref of key/value
2570 pairs representing the columns of the table and the values you wish to
2571 store. If the appropriate relationships are set up, foreign key fields
2572 can also be passed an object representing the foreign row, and the
2573 value will be set to its primary key.
2574
2575 To create related objects, pass a hashref of related-object column values
2576 B<keyed on the relationship name>. If the relationship is of type C<multi>
2577 (L<DBIx::Class::Relationship/has_many>) - pass an arrayref of hashrefs.
2578 The process will correctly identify columns holding foreign keys, and will
2579 transparently populate them from the keys of the corresponding relation.
2580 This can be applied recursively, and will work correctly for a structure
2581 with an arbitrary depth and width, as long as the relationships actually
2582 exists and the correct column data has been supplied.
2583
2584
2585 Instead of hashrefs of plain related data (key/value pairs), you may
2586 also pass new or inserted objects. New objects (not inserted yet, see
2587 L</new>), will be inserted into their appropriate tables.
2588
2589 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
2590
2591 Example of creating a new row.
2592
2593   $person_rs->create({
2594     name=>"Some Person",
2595     email=>"somebody@someplace.com"
2596   });
2597
2598 Example of creating a new row and also creating rows in a related C<has_many>
2599 or C<has_one> resultset.  Note Arrayref.
2600
2601   $artist_rs->create(
2602      { artistid => 4, name => 'Manufactured Crap', cds => [
2603         { title => 'My First CD', year => 2006 },
2604         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2605       ],
2606      },
2607   );
2608
2609 Example of creating a new row and also creating a row in a related
2610 C<belongs_to> resultset. Note Hashref.
2611
2612   $cd_rs->create({
2613     title=>"Music for Silly Walks",
2614     year=>2000,
2615     artist => {
2616       name=>"Silly Musician",
2617     }
2618   });
2619
2620 =over
2621
2622 =item WARNING
2623
2624 When subclassing ResultSet never attempt to override this method. Since
2625 it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a
2626 lot of the internals simply never call it, so your override will be
2627 bypassed more often than not. Override either L<new|DBIx::Class::Row/new>
2628 or L<insert|DBIx::Class::Row/insert> depending on how early in the
2629 L</create> process you need to intervene.
2630
2631 =back
2632
2633 =cut
2634
2635 sub create {
2636   my ($self, $attrs) = @_;
2637   $self->throw_exception( "create needs a hashref" )
2638     unless ref $attrs eq 'HASH';
2639   return $self->new_result($attrs)->insert;
2640 }
2641
2642 =head2 find_or_create
2643
2644 =over 4
2645
2646 =item Arguments: \%vals, \%attrs?
2647
2648 =item Return Value: $rowobject
2649
2650 =back
2651
2652   $cd->cd_to_producer->find_or_create({ producer => $producer },
2653                                       { key => 'primary' });
2654
2655 Tries to find a record based on its primary key or unique constraints; if none
2656 is found, creates one and returns that instead.
2657
2658   my $cd = $schema->resultset('CD')->find_or_create({
2659     cdid   => 5,
2660     artist => 'Massive Attack',
2661     title  => 'Mezzanine',
2662     year   => 2005,
2663   });
2664
2665 Also takes an optional C<key> attribute, to search by a specific key or unique
2666 constraint. For example:
2667
2668   my $cd = $schema->resultset('CD')->find_or_create(
2669     {
2670       artist => 'Massive Attack',
2671       title  => 'Mezzanine',
2672     },
2673     { key => 'cd_artist_title' }
2674   );
2675
2676 B<Note>: Make sure to read the documentation of L</find> and understand the
2677 significance of the C<key> attribute, as its lack may skew your search, and
2678 subsequently result in spurious row creation.
2679
2680 B<Note>: Because find_or_create() reads from the database and then
2681 possibly inserts based on the result, this method is subject to a race
2682 condition. Another process could create a record in the table after
2683 the find has completed and before the create has started. To avoid
2684 this problem, use find_or_create() inside a transaction.
2685
2686 B<Note>: Take care when using C<find_or_create> with a table having
2687 columns with default values that you intend to be automatically
2688 supplied by the database (e.g. an auto_increment primary key column).
2689 In normal usage, the value of such columns should NOT be included at
2690 all in the call to C<find_or_create>, even when set to C<undef>.
2691
2692 See also L</find> and L</update_or_create>. For information on how to declare
2693 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2694
2695 =cut
2696
2697 sub find_or_create {
2698   my $self     = shift;
2699   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2700   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2701   if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2702     return $row;
2703   }
2704   return $self->create($hash);
2705 }
2706
2707 =head2 update_or_create
2708
2709 =over 4
2710
2711 =item Arguments: \%col_values, { key => $unique_constraint }?
2712
2713 =item Return Value: $row_object
2714
2715 =back
2716
2717   $resultset->update_or_create({ col => $val, ... });
2718
2719 Like L</find_or_create>, but if a row is found it is immediately updated via
2720 C<< $found_row->update (\%col_values) >>.
2721
2722
2723 Takes an optional C<key> attribute to search on a specific unique constraint.
2724 For example:
2725
2726   # In your application
2727   my $cd = $schema->resultset('CD')->update_or_create(
2728     {
2729       artist => 'Massive Attack',
2730       title  => 'Mezzanine',
2731       year   => 1998,
2732     },
2733     { key => 'cd_artist_title' }
2734   );
2735
2736   $cd->cd_to_producer->update_or_create({
2737     producer => $producer,
2738     name => 'harry',
2739   }, {
2740     key => 'primary',
2741   });
2742
2743 B<Note>: Make sure to read the documentation of L</find> and understand the
2744 significance of the C<key> attribute, as its lack may skew your search, and
2745 subsequently result in spurious row creation.
2746
2747 B<Note>: Take care when using C<update_or_create> with a table having
2748 columns with default values that you intend to be automatically
2749 supplied by the database (e.g. an auto_increment primary key column).
2750 In normal usage, the value of such columns should NOT be included at
2751 all in the call to C<update_or_create>, even when set to C<undef>.
2752
2753 See also L</find> and L</find_or_create>. For information on how to declare
2754 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2755
2756 =cut
2757
2758 sub update_or_create {
2759   my $self = shift;
2760   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2761   my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
2762
2763   my $row = $self->find($cond, $attrs);
2764   if (defined $row) {
2765     $row->update($cond);
2766     return $row;
2767   }
2768
2769   return $self->create($cond);
2770 }
2771
2772 =head2 update_or_new
2773
2774 =over 4
2775
2776 =item Arguments: \%col_values, { key => $unique_constraint }?
2777
2778 =item Return Value: $rowobject
2779
2780 =back
2781
2782   $resultset->update_or_new({ col => $val, ... });
2783
2784 Like L</find_or_new> but if a row is found it is immediately updated via
2785 C<< $found_row->update (\%col_values) >>.
2786
2787 For example:
2788
2789   # In your application
2790   my $cd = $schema->resultset('CD')->update_or_new(
2791     {
2792       artist => 'Massive Attack',
2793       title  => 'Mezzanine',
2794       year   => 1998,
2795     },
2796     { key => 'cd_artist_title' }
2797   );
2798
2799   if ($cd->in_storage) {
2800       # the cd was updated
2801   }
2802   else {
2803       # the cd is not yet in the database, let's insert it
2804       $cd->insert;
2805   }
2806
2807 B<Note>: Make sure to read the documentation of L</find> and understand the
2808 significance of the C<key> attribute, as its lack may skew your search, and
2809 subsequently result in spurious new objects.
2810
2811 B<Note>: Take care when using C<update_or_new> with a table having
2812 columns with default values that you intend to be automatically
2813 supplied by the database (e.g. an auto_increment primary key column).
2814 In normal usage, the value of such columns should NOT be included at
2815 all in the call to C<update_or_new>, even when set to C<undef>.
2816
2817 See also L</find>, L</find_or_create> and L</find_or_new>.
2818
2819 =cut
2820
2821 sub update_or_new {
2822     my $self  = shift;
2823     my $attrs = ( @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {} );
2824     my $cond  = ref $_[0] eq 'HASH' ? shift : {@_};
2825
2826     my $row = $self->find( $cond, $attrs );
2827     if ( defined $row ) {
2828         $row->update($cond);
2829         return $row;
2830     }
2831
2832     return $self->new_result($cond);
2833 }
2834
2835 =head2 get_cache
2836
2837 =over 4
2838
2839 =item Arguments: none
2840
2841 =item Return Value: \@cache_objects | undef
2842
2843 =back
2844
2845 Gets the contents of the cache for the resultset, if the cache is set.
2846
2847 The cache is populated either by using the L</prefetch> attribute to
2848 L</search> or by calling L</set_cache>.
2849
2850 =cut
2851
2852 sub get_cache {
2853   shift->{all_cache};
2854 }
2855
2856 =head2 set_cache
2857
2858 =over 4
2859
2860 =item Arguments: \@cache_objects
2861
2862 =item Return Value: \@cache_objects
2863
2864 =back
2865
2866 Sets the contents of the cache for the resultset. Expects an arrayref
2867 of objects of the same class as those produced by the resultset. Note that
2868 if the cache is set the resultset will return the cached objects rather
2869 than re-querying the database even if the cache attr is not set.
2870
2871 The contents of the cache can also be populated by using the
2872 L</prefetch> attribute to L</search>.
2873
2874 =cut
2875
2876 sub set_cache {
2877   my ( $self, $data ) = @_;
2878   $self->throw_exception("set_cache requires an arrayref")
2879       if defined($data) && (ref $data ne 'ARRAY');
2880   $self->{all_cache} = $data;
2881 }
2882
2883 =head2 clear_cache
2884
2885 =over 4
2886
2887 =item Arguments: none
2888
2889 =item Return Value: undef
2890
2891 =back
2892
2893 Clears the cache for the resultset.
2894
2895 =cut
2896
2897 sub clear_cache {
2898   shift->set_cache(undef);
2899 }
2900
2901 =head2 is_paged
2902
2903 =over 4
2904
2905 =item Arguments: none
2906
2907 =item Return Value: true, if the resultset has been paginated
2908
2909 =back
2910
2911 =cut
2912
2913 sub is_paged {
2914   my ($self) = @_;
2915   return !!$self->{attrs}{page};
2916 }
2917
2918 =head2 is_ordered
2919
2920 =over 4
2921
2922 =item Arguments: none
2923
2924 =item Return Value: true, if the resultset has been ordered with C<order_by>.
2925
2926 =back
2927
2928 =cut
2929
2930 sub is_ordered {
2931   my ($self) = @_;
2932   return scalar $self->result_source->storage->_extract_order_criteria($self->{attrs}{order_by});
2933 }
2934
2935 =head2 related_resultset
2936
2937 =over 4
2938
2939 =item Arguments: $relationship_name
2940
2941 =item Return Value: $resultset
2942
2943 =back
2944
2945 Returns a related resultset for the supplied relationship name.
2946
2947   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
2948
2949 =cut
2950
2951 sub related_resultset {
2952   my ($self, $rel) = @_;
2953
2954   $self->{related_resultsets} ||= {};
2955   return $self->{related_resultsets}{$rel} ||= do {
2956     my $rsrc = $self->result_source;
2957     my $rel_info = $rsrc->relationship_info($rel);
2958
2959     $self->throw_exception(
2960       "search_related: result source '" . $rsrc->source_name .
2961         "' has no such relationship $rel")
2962       unless $rel_info;
2963
2964     my $attrs = $self->_chain_relationship($rel);
2965
2966     my $join_count = $attrs->{seen_join}{$rel};
2967
2968     my $alias = $self->result_source->storage
2969         ->relname_to_table_alias($rel, $join_count);
2970
2971     # since this is search_related, and we already slid the select window inwards
2972     # (the select/as attrs were deleted in the beginning), we need to flip all
2973     # left joins to inner, so we get the expected results
2974     # read the comment on top of the actual function to see what this does
2975     $attrs->{from} = $rsrc->schema->storage->_inner_join_to_node ($attrs->{from}, $alias);
2976
2977
2978     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
2979     delete @{$attrs}{qw(result_class alias)};
2980
2981     my $new_cache;
2982
2983     if (my $cache = $self->get_cache) {
2984       if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) {
2985         $new_cache = [ map { @{$_->related_resultset($rel)->get_cache} }
2986                         @$cache ];
2987       }
2988     }
2989
2990     my $rel_source = $rsrc->related_source($rel);
2991
2992     my $new = do {
2993
2994       # The reason we do this now instead of passing the alias to the
2995       # search_rs below is that if you wrap/overload resultset on the
2996       # source you need to know what alias it's -going- to have for things
2997       # to work sanely (e.g. RestrictWithObject wants to be able to add
2998       # extra query restrictions, and these may need to be $alias.)
2999
3000       my $rel_attrs = $rel_source->resultset_attributes;
3001       local $rel_attrs->{alias} = $alias;
3002
3003       $rel_source->resultset
3004                  ->search_rs(
3005                      undef, {
3006                        %$attrs,
3007                        where => $attrs->{where},
3008                    });
3009     };
3010     $new->set_cache($new_cache) if $new_cache;
3011     $new;
3012   };
3013 }
3014
3015 =head2 current_source_alias
3016
3017 =over 4
3018
3019 =item Arguments: none
3020
3021 =item Return Value: $source_alias
3022
3023 =back
3024
3025 Returns the current table alias for the result source this resultset is built
3026 on, that will be used in the SQL query. Usually it is C<me>.
3027
3028 Currently the source alias that refers to the result set returned by a
3029 L</search>/L</find> family method depends on how you got to the resultset: it's
3030 C<me> by default, but eg. L</search_related> aliases it to the related result
3031 source name (and keeps C<me> referring to the original result set). The long
3032 term goal is to make L<DBIx::Class> always alias the current resultset as C<me>
3033 (and make this method unnecessary).
3034
3035 Thus it's currently necessary to use this method in predefined queries (see
3036 L<DBIx::Class::Manual::Cookbook/Predefined searches>) when referring to the
3037 source alias of the current result set:
3038
3039   # in a result set class
3040   sub modified_by {
3041     my ($self, $user) = @_;
3042
3043     my $me = $self->current_source_alias;
3044
3045     return $self->search(
3046       "$me.modified" => $user->id,
3047     );
3048   }
3049
3050 =cut
3051
3052 sub current_source_alias {
3053   my ($self) = @_;
3054
3055   return ($self->{attrs} || {})->{alias} || 'me';
3056 }
3057
3058 =head2 as_subselect_rs
3059
3060 =over 4
3061
3062 =item Arguments: none
3063
3064 =item Return Value: $resultset
3065
3066 =back
3067
3068 Act as a barrier to SQL symbols.  The resultset provided will be made into a
3069 "virtual view" by including it as a subquery within the from clause.  From this
3070 point on, any joined tables are inaccessible to ->search on the resultset (as if
3071 it were simply where-filtered without joins).  For example:
3072
3073  my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' });
3074
3075  # 'x' now pollutes the query namespace
3076
3077  # So the following works as expected
3078  my $ok_rs = $rs->search({'x.other' => 1});
3079
3080  # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and
3081  # def) we look for one row with contradictory terms and join in another table
3082  # (aliased 'x_2') which we never use
3083  my $broken_rs = $rs->search({'x.name' => 'def'});
3084
3085  my $rs2 = $rs->as_subselect_rs;
3086
3087  # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away
3088  my $not_joined_rs = $rs2->search({'x.other' => 1});
3089
3090  # works as expected: finds a 'table' row related to two x rows (abc and def)
3091  my $correctly_joined_rs = $rs2->search({'x.name' => 'def'});
3092
3093 Another example of when one might use this would be to select a subset of
3094 columns in a group by clause:
3095
3096  my $rs = $schema->resultset('Bar')->search(undef, {
3097    group_by => [qw{ id foo_id baz_id }],
3098  })->as_subselect_rs->search(undef, {
3099    columns => [qw{ id foo_id }]
3100  });
3101
3102 In the above example normally columns would have to be equal to the group by,
3103 but because we isolated the group by into a subselect the above works.
3104
3105 =cut
3106
3107 sub as_subselect_rs {
3108   my $self = shift;
3109
3110   my $attrs = $self->_resolved_attrs;
3111
3112   my $fresh_rs = (ref $self)->new (
3113     $self->result_source
3114   );
3115
3116   # these pieces will be locked in the subquery
3117   delete $fresh_rs->{cond};
3118   delete @{$fresh_rs->{attrs}}{qw/where bind/};
3119
3120   return $fresh_rs->search( {}, {
3121     from => [{
3122       $attrs->{alias} => $self->as_query,
3123       -alias  => $attrs->{alias},
3124       -rsrc   => $self->result_source,
3125     }],
3126     alias => $attrs->{alias},
3127   });
3128 }
3129
3130 # This code is called by search_related, and makes sure there
3131 # is clear separation between the joins before, during, and
3132 # after the relationship. This information is needed later
3133 # in order to properly resolve prefetch aliases (any alias
3134 # with a relation_chain_depth less than the depth of the
3135 # current prefetch is not considered)
3136 #
3137 # The increments happen twice per join. An even number means a
3138 # relationship specified via a search_related, whereas an odd
3139 # number indicates a join/prefetch added via attributes
3140 #
3141 # Also this code will wrap the current resultset (the one we
3142 # chain to) in a subselect IFF it contains limiting attributes
3143 sub _chain_relationship {
3144   my ($self, $rel) = @_;
3145   my $source = $self->result_source;
3146   my $attrs = { %{$self->{attrs}||{}} };
3147
3148   # we need to take the prefetch the attrs into account before we
3149   # ->_resolve_join as otherwise they get lost - captainL
3150   my $join = $self->_merge_joinpref_attr( $attrs->{join}, $attrs->{prefetch} );
3151
3152   delete @{$attrs}{qw/join prefetch collapse group_by distinct select as columns +select +as +columns/};
3153
3154   my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
3155
3156   my $from;
3157   my @force_subq_attrs = qw/offset rows group_by having/;
3158
3159   if (
3160     ($attrs->{from} && ref $attrs->{from} ne 'ARRAY')
3161       ||
3162     $self->_has_resolved_attr (@force_subq_attrs)
3163   ) {
3164     # Nuke the prefetch (if any) before the new $rs attrs
3165     # are resolved (prefetch is useless - we are wrapping
3166     # a subquery anyway).
3167     my $rs_copy = $self->search;
3168     $rs_copy->{attrs}{join} = $self->_merge_joinpref_attr (
3169       $rs_copy->{attrs}{join},
3170       delete $rs_copy->{attrs}{prefetch},
3171     );
3172
3173     $from = [{
3174       -rsrc   => $source,
3175       -alias  => $attrs->{alias},
3176       $attrs->{alias} => $rs_copy->as_query,
3177     }];
3178     delete @{$attrs}{@force_subq_attrs, qw/where bind/};
3179     $seen->{-relation_chain_depth} = 0;
3180   }
3181   elsif ($attrs->{from}) {  #shallow copy suffices
3182     $from = [ @{$attrs->{from}} ];
3183   }
3184   else {
3185     $from = [{
3186       -rsrc  => $source,
3187       -alias => $attrs->{alias},
3188       $attrs->{alias} => $source->from,
3189     }];
3190   }
3191
3192   my $jpath = ($seen->{-relation_chain_depth})
3193     ? $from->[-1][0]{-join_path}
3194     : [];
3195
3196   my @requested_joins = $source->_resolve_join(
3197     $join,
3198     $attrs->{alias},
3199     $seen,
3200     $jpath,
3201   );
3202
3203   push @$from, @requested_joins;
3204
3205   $seen->{-relation_chain_depth}++;
3206
3207   # if $self already had a join/prefetch specified on it, the requested
3208   # $rel might very well be already included. What we do in this case
3209   # is effectively a no-op (except that we bump up the chain_depth on
3210   # the join in question so we could tell it *is* the search_related)
3211   my $already_joined;
3212
3213   # we consider the last one thus reverse
3214   for my $j (reverse @requested_joins) {
3215     my ($last_j) = keys %{$j->[0]{-join_path}[-1]};
3216     if ($rel eq $last_j) {
3217       $j->[0]{-relation_chain_depth}++;
3218       $already_joined++;
3219       last;
3220     }
3221   }
3222
3223   unless ($already_joined) {
3224     push @$from, $source->_resolve_join(
3225       $rel,
3226       $attrs->{alias},
3227       $seen,
3228       $jpath,
3229     );
3230   }
3231
3232   $seen->{-relation_chain_depth}++;
3233
3234   return {%$attrs, from => $from, seen_join => $seen};
3235 }
3236
3237 # too many times we have to do $attrs = { %{$self->_resolved_attrs} }
3238 sub _resolved_attrs_copy {
3239   my $self = shift;
3240   return { %{$self->_resolved_attrs (@_)} };
3241 }
3242
3243 sub _resolved_attrs {
3244   my $self = shift;
3245   return $self->{_attrs} if $self->{_attrs};
3246
3247   my $attrs  = { %{ $self->{attrs} || {} } };
3248   my $source = $self->result_source;
3249   my $alias  = $attrs->{alias};
3250
3251   # default selection list
3252   $attrs->{columns} = [ $source->columns ]
3253     unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/;
3254
3255   # merge selectors together
3256   for (qw/columns select as/) {
3257     $attrs->{$_} = $self->_merge_attr($attrs->{$_}, delete $attrs->{"+$_"})
3258       if $attrs->{$_} or $attrs->{"+$_"};
3259   }
3260
3261   # disassemble columns
3262   my (@sel, @as);
3263   if (my $cols = delete $attrs->{columns}) {
3264     for my $c (ref $cols eq 'ARRAY' ? @$cols : $cols) {
3265       if (ref $c eq 'HASH') {
3266         for my $as (keys %$c) {
3267           push @sel, $c->{$as};
3268           push @as, $as;
3269         }
3270       }
3271       else {
3272         push @sel, $c;
3273         push @as, $c;
3274       }
3275     }
3276   }
3277
3278   # when trying to weed off duplicates later do not go past this point -
3279   # everything added from here on is unbalanced "anyone's guess" stuff
3280   my $dedup_stop_idx = $#as;
3281
3282   push @as, @{ ref $attrs->{as} eq 'ARRAY' ? $attrs->{as} : [ $attrs->{as} ] }
3283     if $attrs->{as};
3284   push @sel, @{ ref $attrs->{select} eq 'ARRAY' ? $attrs->{select} : [ $attrs->{select} ] }
3285     if $attrs->{select};
3286
3287   # assume all unqualified selectors to apply to the current alias (legacy stuff)
3288   for (@sel) {
3289     $_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_";
3290   }
3291
3292   # disqualify all $alias.col as-bits (collapser mandated)
3293   for (@as) {
3294     $_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_;
3295   }
3296
3297   # de-duplicate the result (remove *identical* select/as pairs)
3298   # and also die on duplicate {as} pointing to different {select}s
3299   # not using a c-style for as the condition is prone to shrinkage
3300   my $seen;
3301   my $i = 0;
3302   while ($i <= $dedup_stop_idx) {
3303     if ($seen->{"$sel[$i] \x00\x00 $as[$i]"}++) {
3304       splice @sel, $i, 1;
3305       splice @as, $i, 1;
3306       $dedup_stop_idx--;
3307     }
3308     elsif ($seen->{$as[$i]}++) {
3309       $self->throw_exception(
3310         "inflate_result() alias '$as[$i]' specified twice with different SQL-side {select}-ors"
3311       );
3312     }
3313     else {
3314       $i++;
3315     }
3316   }
3317
3318   $attrs->{select} = \@sel;
3319   $attrs->{as} = \@as;
3320
3321   $attrs->{from} ||= [{
3322     -rsrc   => $source,
3323     -alias  => $self->{attrs}{alias},
3324     $self->{attrs}{alias} => $source->from,
3325   }];
3326
3327   if ( $attrs->{join} || $attrs->{prefetch} ) {
3328
3329     $self->throw_exception ('join/prefetch can not be used with a custom {from}')
3330       if ref $attrs->{from} ne 'ARRAY';
3331
3332     my $join = (delete $attrs->{join}) || {};
3333
3334     if ( defined $attrs->{prefetch} ) {
3335       $join = $self->_merge_joinpref_attr( $join, $attrs->{prefetch} );
3336     }
3337
3338     $attrs->{from} =    # have to copy here to avoid corrupting the original
3339       [
3340         @{ $attrs->{from} },
3341         $source->_resolve_join(
3342           $join,
3343           $alias,
3344           { %{ $attrs->{seen_join} || {} } },
3345           ( $attrs->{seen_join} && keys %{$attrs->{seen_join}})
3346             ? $attrs->{from}[-1][0]{-join_path}
3347             : []
3348           ,
3349         )
3350       ];
3351   }
3352
3353   if ( defined $attrs->{order_by} ) {
3354     $attrs->{order_by} = (
3355       ref( $attrs->{order_by} ) eq 'ARRAY'
3356       ? [ @{ $attrs->{order_by} } ]
3357       : [ $attrs->{order_by} || () ]
3358     );
3359   }
3360
3361   if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') {
3362     $attrs->{group_by} = [ $attrs->{group_by} ];
3363   }
3364
3365   # generate the distinct induced group_by early, as prefetch will be carried via a
3366   # subquery (since a group_by is present)
3367   if (delete $attrs->{distinct}) {
3368     if ($attrs->{group_by}) {
3369       carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
3370     }
3371     else {
3372       # distinct affects only the main selection part, not what prefetch may
3373       # add below.
3374       $attrs->{group_by} = $source->storage->_group_over_selection (
3375         $attrs->{from},
3376         $attrs->{select},
3377         $attrs->{order_by},
3378       );
3379     }
3380   }
3381
3382   $attrs->{collapse} ||= {};
3383   if ($attrs->{prefetch}) {
3384
3385     $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
3386       if $attrs->{_dark_selector};
3387
3388     my $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} );
3389
3390     my $prefetch_ordering = [];
3391
3392     # this is a separate structure (we don't look in {from} directly)
3393     # as the resolver needs to shift things off the lists to work
3394     # properly (identical-prefetches on different branches)
3395     my $join_map = {};
3396     if (ref $attrs->{from} eq 'ARRAY') {
3397
3398       my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0;
3399
3400       for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
3401         next unless $j->[0]{-alias};
3402         next unless $j->[0]{-join_path};
3403         next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth;
3404
3405         my @jpath = map { keys %$_ } @{$j->[0]{-join_path}};
3406
3407         my $p = $join_map;
3408         $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries
3409         push @{$p->{-join_aliases} }, $j->[0]{-alias};
3410       }
3411     }
3412
3413     my @prefetch =
3414       $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
3415
3416     # we need to somehow mark which columns came from prefetch
3417     if (@prefetch) {
3418       my $sel_end = $#{$attrs->{select}};
3419       $attrs->{_prefetch_selector_range} = [ $sel_end + 1, $sel_end + @prefetch ];
3420     }
3421
3422     push @{ $attrs->{select} }, (map { $_->[0] } @prefetch);
3423     push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
3424
3425     push( @{$attrs->{order_by}}, @$prefetch_ordering );
3426     $attrs->{_collapse_order_by} = \@$prefetch_ordering;
3427   }
3428
3429
3430   # if both page and offset are specified, produce a combined offset
3431   # even though it doesn't make much sense, this is what pre 081xx has
3432   # been doing
3433   if (my $page = delete $attrs->{page}) {
3434     $attrs->{offset} =
3435       ($attrs->{rows} * ($page - 1))
3436             +
3437       ($attrs->{offset} || 0)
3438     ;
3439   }
3440
3441   return $self->{_attrs} = $attrs;
3442 }
3443
3444 sub _rollout_attr {
3445   my ($self, $attr) = @_;
3446
3447   if (ref $attr eq 'HASH') {
3448     return $self->_rollout_hash($attr);
3449   } elsif (ref $attr eq 'ARRAY') {
3450     return $self->_rollout_array($attr);
3451   } else {
3452     return [$attr];
3453   }
3454 }
3455
3456 sub _rollout_array {
3457   my ($self, $attr) = @_;
3458
3459   my @rolled_array;
3460   foreach my $element (@{$attr}) {
3461     if (ref $element eq 'HASH') {
3462       push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
3463     } elsif (ref $element eq 'ARRAY') {
3464       #  XXX - should probably recurse here
3465       push( @rolled_array, @{$self->_rollout_array($element)} );
3466     } else {
3467       push( @rolled_array, $element );
3468     }
3469   }
3470   return \@rolled_array;
3471 }
3472
3473 sub _rollout_hash {
3474   my ($self, $attr) = @_;
3475
3476   my @rolled_array;
3477   foreach my $key (keys %{$attr}) {
3478     push( @rolled_array, { $key => $attr->{$key} } );
3479   }
3480   return \@rolled_array;
3481 }
3482
3483 sub _calculate_score {
3484   my ($self, $a, $b) = @_;
3485
3486   if (defined $a xor defined $b) {
3487     return 0;
3488   }
3489   elsif (not defined $a) {
3490     return 1;
3491   }
3492
3493   if (ref $b eq 'HASH') {
3494     my ($b_key) = keys %{$b};
3495     if (ref $a eq 'HASH') {
3496       my ($a_key) = keys %{$a};
3497       if ($a_key eq $b_key) {
3498         return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
3499       } else {
3500         return 0;
3501       }
3502     } else {
3503       return ($a eq $b_key) ? 1 : 0;
3504     }
3505   } else {
3506     if (ref $a eq 'HASH') {
3507       my ($a_key) = keys %{$a};
3508       return ($b eq $a_key) ? 1 : 0;
3509     } else {
3510       return ($b eq $a) ? 1 : 0;
3511     }
3512   }
3513 }
3514
3515 sub _merge_joinpref_attr {
3516   my ($self, $orig, $import) = @_;
3517
3518   return $import unless defined($orig);
3519   return $orig unless defined($import);
3520
3521   $orig = $self->_rollout_attr($orig);
3522   $import = $self->_rollout_attr($import);
3523
3524   my $seen_keys;
3525   foreach my $import_element ( @{$import} ) {
3526     # find best candidate from $orig to merge $b_element into
3527     my $best_candidate = { position => undef, score => 0 }; my $position = 0;
3528     foreach my $orig_element ( @{$orig} ) {
3529       my $score = $self->_calculate_score( $orig_element, $import_element );
3530       if ($score > $best_candidate->{score}) {
3531         $best_candidate->{position} = $position;
3532         $best_candidate->{score} = $score;
3533       }
3534       $position++;
3535     }
3536     my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
3537
3538     if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
3539       push( @{$orig}, $import_element );
3540     } else {
3541       my $orig_best = $orig->[$best_candidate->{position}];
3542       # merge orig_best and b_element together and replace original with merged
3543       if (ref $orig_best ne 'HASH') {
3544         $orig->[$best_candidate->{position}] = $import_element;
3545       } elsif (ref $import_element eq 'HASH') {
3546         my ($key) = keys %{$orig_best};
3547         $orig->[$best_candidate->{position}] = { $key => $self->_merge_joinpref_attr($orig_best->{$key}, $import_element->{$key}) };
3548       }
3549     }
3550     $seen_keys->{$import_key} = 1; # don't merge the same key twice
3551   }
3552
3553   return $orig;
3554 }
3555
3556 {
3557   my $hm;
3558
3559   sub _merge_attr {
3560     $hm ||= do {
3561       require Hash::Merge;
3562       my $hm = Hash::Merge->new;
3563
3564       $hm->specify_behavior({
3565         SCALAR => {
3566           SCALAR => sub {
3567             my ($defl, $defr) = map { defined $_ } (@_[0,1]);
3568
3569             if ($defl xor $defr) {
3570               return [ $defl ? $_[0] : $_[1] ];
3571             }
3572             elsif (! $defl) {
3573               return [];
3574             }
3575             elsif (__HM_DEDUP and $_[0] eq $_[1]) {
3576               return [ $_[0] ];
3577             }
3578             else {
3579               return [$_[0], $_[1]];
3580             }
3581           },
3582           ARRAY => sub {
3583             return $_[1] if !defined $_[0];
3584             return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
3585             return [$_[0], @{$_[1]}]
3586           },
3587           HASH  => sub {
3588             return [] if !defined $_[0] and !keys %{$_[1]};
3589             return [ $_[1] ] if !defined $_[0];
3590             return [ $_[0] ] if !keys %{$_[1]};
3591             return [$_[0], $_[1]]
3592           },
3593         },
3594         ARRAY => {
3595           SCALAR => sub {
3596             return $_[0] if !defined $_[1];
3597             return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
3598             return [@{$_[0]}, $_[1]]
3599           },
3600           ARRAY => sub {
3601             my @ret = @{$_[0]} or return $_[1];
3602             return [ @ret, @{$_[1]} ] unless __HM_DEDUP;
3603             my %idx = map { $_ => 1 } @ret;
3604             push @ret, grep { ! defined $idx{$_} } (@{$_[1]});
3605             \@ret;
3606           },
3607           HASH => sub {
3608             return [ $_[1] ] if ! @{$_[0]};
3609             return $_[0] if !keys %{$_[1]};
3610             return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
3611             return [ @{$_[0]}, $_[1] ];
3612           },
3613         },
3614         HASH => {
3615           SCALAR => sub {
3616             return [] if !keys %{$_[0]} and !defined $_[1];
3617             return [ $_[0] ] if !defined $_[1];
3618             return [ $_[1] ] if !keys %{$_[0]};
3619             return [$_[0], $_[1]]
3620           },
3621           ARRAY => sub {
3622             return [] if !keys %{$_[0]} and !@{$_[1]};
3623             return [ $_[0] ] if !@{$_[1]};
3624             return $_[1] if !keys %{$_[0]};
3625             return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
3626             return [ $_[0], @{$_[1]} ];
3627           },
3628           HASH => sub {
3629             return [] if !keys %{$_[0]} and !keys %{$_[1]};
3630             return [ $_[0] ] if !keys %{$_[1]};
3631             return [ $_[1] ] if !keys %{$_[0]};
3632             return [ $_[0] ] if $_[0] eq $_[1];
3633             return [ $_[0], $_[1] ];
3634           },
3635         }
3636       } => 'DBIC_RS_ATTR_MERGER');
3637       $hm;
3638     };
3639
3640     return $hm->merge ($_[1], $_[2]);
3641   }
3642 }
3643
3644 sub STORABLE_freeze {
3645   my ($self, $cloning) = @_;
3646   my $to_serialize = { %$self };
3647
3648   # A cursor in progress can't be serialized (and would make little sense anyway)
3649   delete $to_serialize->{cursor};
3650
3651   Storable::nfreeze($to_serialize);
3652 }
3653
3654 # need this hook for symmetry
3655 sub STORABLE_thaw {
3656   my ($self, $cloning, $serialized) = @_;
3657
3658   %$self = %{ Storable::thaw($serialized) };
3659
3660   $self;
3661 }
3662
3663
3664 =head2 throw_exception
3665
3666 See L<DBIx::Class::Schema/throw_exception> for details.
3667
3668 =cut
3669
3670 sub throw_exception {
3671   my $self=shift;
3672
3673   if (ref $self and my $rsrc = $self->result_source) {
3674     $rsrc->throw_exception(@_)
3675   }
3676   else {
3677     DBIx::Class::Exception->throw(@_);
3678   }
3679 }
3680
3681 # XXX: FIXME: Attributes docs need clearing up
3682
3683 =head1 ATTRIBUTES
3684
3685 Attributes are used to refine a ResultSet in various ways when
3686 searching for data. They can be passed to any method which takes an
3687 C<\%attrs> argument. See L</search>, L</search_rs>, L</find>,
3688 L</count>.
3689
3690 These are in no particular order:
3691
3692 =head2 order_by
3693
3694 =over 4
3695
3696 =item Value: ( $order_by | \@order_by | \%order_by )
3697
3698 =back
3699
3700 Which column(s) to order the results by.
3701
3702 [The full list of suitable values is documented in
3703 L<SQL::Abstract/"ORDER BY CLAUSES">; the following is a summary of
3704 common options.]
3705
3706 If a single column name, or an arrayref of names is supplied, the
3707 argument is passed through directly to SQL. The hashref syntax allows
3708 for connection-agnostic specification of ordering direction:
3709
3710  For descending order:
3711
3712   order_by => { -desc => [qw/col1 col2 col3/] }
3713
3714  For explicit ascending order:
3715
3716   order_by => { -asc => 'col' }
3717
3718 The old scalarref syntax (i.e. order_by => \'year DESC') is still
3719 supported, although you are strongly encouraged to use the hashref
3720 syntax as outlined above.
3721
3722 =head2 columns
3723
3724 =over 4
3725
3726 =item Value: \@columns
3727
3728 =back
3729
3730 Shortcut to request a particular set of columns to be retrieved. Each
3731 column spec may be a string (a table column name), or a hash (in which
3732 case the key is the C<as> value, and the value is used as the C<select>
3733 expression). Adds C<me.> onto the start of any column without a C<.> in
3734 it and sets C<select> from that, then auto-populates C<as> from
3735 C<select> as normal. (You may also use the C<cols> attribute, as in
3736 earlier versions of DBIC.)
3737
3738 Essentially C<columns> does the same as L</select> and L</as>.
3739
3740     columns => [ 'foo', { bar => 'baz' } ]
3741
3742 is the same as
3743
3744     select => [qw/foo baz/],
3745     as => [qw/foo bar/]
3746
3747 =head2 +columns
3748
3749 =over 4
3750
3751 =item Value: \@columns
3752
3753 =back
3754
3755 Indicates additional columns to be selected from storage. Works the same
3756 as L</columns> but adds columns to the selection. (You may also use the
3757 C<include_columns> attribute, as in earlier versions of DBIC). For
3758 example:-
3759
3760   $schema->resultset('CD')->search(undef, {
3761     '+columns' => ['artist.name'],
3762     join => ['artist']
3763   });
3764
3765 would return all CDs and include a 'name' column to the information
3766 passed to object inflation. Note that the 'artist' is the name of the
3767 column (or relationship) accessor, and 'name' is the name of the column
3768 accessor in the related table.
3769
3770 B<NOTE:> You need to explicitly quote '+columns' when defining the attribute.
3771 Not doing so causes Perl to incorrectly interpret +columns as a bareword with a
3772 unary plus operator before it.
3773
3774 =head2 include_columns
3775
3776 =over 4
3777
3778 =item Value: \@columns
3779
3780 =back
3781
3782 Deprecated.  Acts as a synonym for L</+columns> for backward compatibility.
3783
3784 =head2 select
3785
3786 =over 4
3787
3788 =item Value: \@select_columns
3789
3790 =back
3791
3792 Indicates which columns should be selected from the storage. You can use
3793 column names, or in the case of RDBMS back ends, function or stored procedure
3794 names:
3795
3796   $rs = $schema->resultset('Employee')->search(undef, {
3797     select => [
3798       'name',
3799       { count => 'employeeid' },
3800       { max => { length => 'name' }, -as => 'longest_name' }
3801     ]
3802   });
3803
3804   # Equivalent SQL
3805   SELECT name, COUNT( employeeid ), MAX( LENGTH( name ) ) AS longest_name FROM employee
3806
3807 B<NOTE:> You will almost always need a corresponding L</as> attribute when you
3808 use L</select>, to instruct DBIx::Class how to store the result of the column.
3809 Also note that the L</as> attribute has nothing to do with the SQL-side 'AS'
3810 identifier aliasing. You can however alias a function, so you can use it in
3811 e.g. an C<ORDER BY> clause. This is done via the C<-as> B<select function
3812 attribute> supplied as shown in the example above.
3813
3814 B<NOTE:> You need to explicitly quote '+select'/'+as' when defining the attributes.
3815 Not doing so causes Perl to incorrectly interpret them as a bareword with a
3816 unary plus operator before it.
3817
3818 =head2 +select
3819
3820 =over 4
3821
3822 Indicates additional columns to be selected from storage.  Works the same as
3823 L</select> but adds columns to the default selection, instead of specifying
3824 an explicit list.
3825
3826 =back
3827
3828 =head2 +as
3829
3830 =over 4
3831
3832 Indicates additional column names for those added via L</+select>. See L</as>.
3833
3834 =back
3835
3836 =head2 as
3837
3838 =over 4
3839
3840 =item Value: \@inflation_names
3841
3842 =back
3843
3844 Indicates column names for object inflation. That is L</as> indicates the
3845 slot name in which the column value will be stored within the
3846 L<Row|DBIx::Class::Row> object. The value will then be accessible via this
3847 identifier by the C<get_column> method (or via the object accessor B<if one
3848 with the same name already exists>) as shown below. The L</as> attribute has
3849 B<nothing to do> with the SQL-side C<AS>. See L</select> for details.
3850
3851   $rs = $schema->resultset('Employee')->search(undef, {
3852     select => [
3853       'name',
3854       { count => 'employeeid' },
3855       { max => { length => 'name' }, -as => 'longest_name' }
3856     ],
3857     as => [qw/
3858       name
3859       employee_count
3860       max_name_length
3861     /],
3862   });
3863
3864 If the object against which the search is performed already has an accessor
3865 matching a column name specified in C<as>, the value can be retrieved using
3866 the accessor as normal:
3867
3868   my $name = $employee->name();
3869
3870 If on the other hand an accessor does not exist in the object, you need to
3871 use C<get_column> instead:
3872
3873   my $employee_count = $employee->get_column('employee_count');
3874
3875 You can create your own accessors if required - see
3876 L<DBIx::Class::Manual::Cookbook> for details.
3877
3878 =head2 join
3879
3880 =over 4
3881
3882 =item Value: ($rel_name | \@rel_names | \%rel_names)
3883
3884 =back
3885
3886 Contains a list of relationships that should be joined for this query.  For
3887 example:
3888
3889   # Get CDs by Nine Inch Nails
3890   my $rs = $schema->resultset('CD')->search(
3891     { 'artist.name' => 'Nine Inch Nails' },
3892     { join => 'artist' }
3893   );
3894
3895 Can also contain a hash reference to refer to the other relation's relations.
3896 For example:
3897
3898   package MyApp::Schema::Track;
3899   use base qw/DBIx::Class/;
3900   __PACKAGE__->table('track');
3901   __PACKAGE__->add_columns(qw/trackid cd position title/);
3902   __PACKAGE__->set_primary_key('trackid');
3903   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
3904   1;
3905
3906   # In your application
3907   my $rs = $schema->resultset('Artist')->search(
3908     { 'track.title' => 'Teardrop' },
3909     {
3910       join     => { cd => 'track' },
3911       order_by => 'artist.name',
3912     }
3913   );
3914
3915 You need to use the relationship (not the table) name in  conditions,
3916 because they are aliased as such. The current table is aliased as "me", so
3917 you need to use me.column_name in order to avoid ambiguity. For example:
3918
3919   # Get CDs from 1984 with a 'Foo' track
3920   my $rs = $schema->resultset('CD')->search(
3921     {
3922       'me.year' => 1984,
3923       'tracks.name' => 'Foo'
3924     },
3925     { join => 'tracks' }
3926   );
3927
3928 If the same join is supplied twice, it will be aliased to <rel>_2 (and
3929 similarly for a third time). For e.g.
3930
3931   my $rs = $schema->resultset('Artist')->search({
3932     'cds.title'   => 'Down to Earth',
3933     'cds_2.title' => 'Popular',
3934   }, {
3935     join => [ qw/cds cds/ ],
3936   });
3937
3938 will return a set of all artists that have both a cd with title 'Down
3939 to Earth' and a cd with title 'Popular'.
3940
3941 If you want to fetch related objects from other tables as well, see C<prefetch>
3942 below.
3943
3944 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
3945
3946 =head2 prefetch
3947
3948 =over 4
3949
3950 =item Value: ($rel_name | \@rel_names | \%rel_names)
3951
3952 =back
3953
3954 Contains one or more relationships that should be fetched along with
3955 the main query (when they are accessed afterwards the data will
3956 already be available, without extra queries to the database).  This is
3957 useful for when you know you will need the related objects, because it
3958 saves at least one query:
3959
3960   my $rs = $schema->resultset('Tag')->search(
3961     undef,
3962     {
3963       prefetch => {
3964         cd => 'artist'
3965       }
3966     }
3967   );
3968
3969 The initial search results in SQL like the following:
3970
3971   SELECT tag.*, cd.*, artist.* FROM tag
3972   JOIN cd ON tag.cd = cd.cdid
3973   JOIN artist ON cd.artist = artist.artistid
3974
3975 L<DBIx::Class> has no need to go back to the database when we access the
3976 C<cd> or C<artist> relationships, which saves us two SQL statements in this
3977 case.
3978
3979 Simple prefetches will be joined automatically, so there is no need
3980 for a C<join> attribute in the above search.
3981
3982 L</prefetch> can be used with the any of the relationship types and
3983 multiple prefetches can be specified together. Below is a more complex
3984 example that prefetches a CD's artist, its liner notes (if present),
3985 the cover image, the tracks on that cd, and the guests on those
3986 tracks.
3987
3988  # Assuming:
3989  My::Schema::CD->belongs_to( artist      => 'My::Schema::Artist'     );
3990  My::Schema::CD->might_have( liner_note  => 'My::Schema::LinerNotes' );
3991  My::Schema::CD->has_one(    cover_image => 'My::Schema::Artwork'    );
3992  My::Schema::CD->has_many(   tracks      => 'My::Schema::Track'      );
3993
3994  My::Schema::Artist->belongs_to( record_label => 'My::Schema::RecordLabel' );
3995
3996  My::Schema::Track->has_many( guests => 'My::Schema::Guest' );
3997
3998
3999  my $rs = $schema->resultset('CD')->search(
4000    undef,
4001    {
4002      prefetch => [
4003        { artist => 'record_label'},  # belongs_to => belongs_to
4004        'liner_note',                 # might_have
4005        'cover_image',                # has_one
4006        { tracks => 'guests' },       # has_many => has_many
4007      ]
4008    }
4009  );
4010
4011 This will produce SQL like the following:
4012
4013  SELECT cd.*, artist.*, record_label.*, liner_note.*, cover_image.*,
4014         tracks.*, guests.*
4015    FROM cd me
4016    JOIN artist artist
4017      ON artist.artistid = me.artistid
4018    JOIN record_label record_label
4019      ON record_label.labelid = artist.labelid
4020    LEFT JOIN track tracks
4021      ON tracks.cdid = me.cdid
4022    LEFT JOIN guest guests
4023      ON guests.trackid = track.trackid
4024    LEFT JOIN liner_notes liner_note
4025      ON liner_note.cdid = me.cdid
4026    JOIN cd_artwork cover_image
4027      ON cover_image.cdid = me.cdid
4028  ORDER BY tracks.cd
4029
4030 Now the C<artist>, C<record_label>, C<liner_note>, C<cover_image>,
4031 C<tracks>, and C<guests> of the CD will all be available through the
4032 relationship accessors without the need for additional queries to the
4033 database.
4034
4035 However, there is one caveat to be observed: it can be dangerous to
4036 prefetch more than one L<has_many|DBIx::Class::Relationship/has_many>
4037 relationship on a given level. e.g.:
4038
4039  my $rs = $schema->resultset('CD')->search(
4040    undef,
4041    {
4042      prefetch => [
4043        'tracks',                         # has_many
4044        { cd_to_producer => 'producer' }, # has_many => belongs_to (i.e. m2m)
4045      ]
4046    }
4047  );
4048
4049 In fact, C<DBIx::Class> will emit the following warning:
4050
4051  Prefetching multiple has_many rels tracks and cd_to_producer at top
4052  level will explode the number of row objects retrievable via ->next
4053  or ->all. Use at your own risk.
4054
4055 The collapser currently can't identify duplicate tuples for multiple
4056 L<has_many|DBIx::Class::Relationship/has_many> relationships and as a
4057 result the second L<has_many|DBIx::Class::Relationship/has_many>
4058 relation could contain redundant objects.
4059
4060 =head3 Using L</prefetch> with L</join>
4061
4062 L</prefetch> implies a L</join> with the equivalent argument, and is
4063 properly merged with any existing L</join> specification. So the
4064 following:
4065
4066   my $rs = $schema->resultset('CD')->search(
4067    {'record_label.name' => 'Music Product Ltd.'},
4068    {
4069      join     => {artist => 'record_label'},
4070      prefetch => 'artist',
4071    }
4072  );
4073
4074 ... will work, searching on the record label's name, but only
4075 prefetching the C<artist>.
4076
4077 =head3 Using L</prefetch> with L</select> / L</+select> / L</as> / L</+as>
4078
4079 L</prefetch> implies a L</+select>/L</+as> with the fields of the
4080 prefetched relations.  So given:
4081
4082   my $rs = $schema->resultset('CD')->search(
4083    undef,
4084    {
4085      select   => ['cd.title'],
4086      as       => ['cd_title'],
4087      prefetch => 'artist',
4088    }
4089  );
4090
4091 The L</select> becomes: C<'cd.title', 'artist.*'> and the L</as>
4092 becomes: C<'cd_title', 'artist.*'>.
4093
4094 =head3 CAVEATS
4095
4096 Prefetch does a lot of deep magic. As such, it may not behave exactly
4097 as you might expect.
4098
4099 =over 4
4100
4101 =item *
4102
4103 Prefetch uses the L</cache> to populate the prefetched relationships. This
4104 may or may not be what you want.
4105
4106 =item *
4107
4108 If you specify a condition on a prefetched relationship, ONLY those
4109 rows that match the prefetched condition will be fetched into that relationship.
4110 This means that adding prefetch to a search() B<may alter> what is returned by
4111 traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
4112
4113   my $artist_rs = $schema->resultset('Artist')->search({
4114       'cds.year' => 2008,
4115   }, {
4116       join => 'cds',
4117   });
4118
4119   my $count = $artist_rs->first->cds->count;
4120
4121   my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
4122
4123   my $prefetch_count = $artist_rs_prefetch->first->cds->count;
4124
4125   cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
4126
4127 that cmp_ok() may or may not pass depending on the datasets involved. This
4128 behavior may or may not survive the 0.09 transition.
4129
4130 =back
4131
4132 =head2 page
4133
4134 =over 4
4135
4136 =item Value: $page
4137
4138 =back
4139
4140 Makes the resultset paged and specifies the page to retrieve. Effectively
4141 identical to creating a non-pages resultset and then calling ->page($page)
4142 on it.
4143
4144 If L</rows> attribute is not specified it defaults to 10 rows per page.
4145
4146 When you have a paged resultset, L</count> will only return the number
4147 of rows in the page. To get the total, use the L</pager> and call
4148 C<total_entries> on it.
4149
4150 =head2 rows
4151
4152 =over 4
4153
4154 =item Value: $rows
4155
4156 =back
4157
4158 Specifies the maximum number of rows for direct retrieval or the number of
4159 rows per page if the page attribute or method is used.
4160
4161 =head2 offset
4162
4163 =over 4
4164
4165 =item Value: $offset
4166
4167 =back
4168
4169 Specifies the (zero-based) row number for the  first row to be returned, or the
4170 of the first row of the first page if paging is used.
4171
4172 =head2 group_by
4173
4174 =over 4
4175
4176 =item Value: \@columns
4177
4178 =back
4179
4180 A arrayref of columns to group by. Can include columns of joined tables.
4181
4182   group_by => [qw/ column1 column2 ... /]
4183
4184 =head2 having
4185
4186 =over 4
4187
4188 =item Value: $condition
4189
4190 =back
4191
4192 HAVING is a select statement attribute that is applied between GROUP BY and
4193 ORDER BY. It is applied to the after the grouping calculations have been
4194 done.
4195
4196   having => { 'count_employee' => { '>=', 100 } }
4197
4198 or with an in-place function in which case literal SQL is required:
4199
4200   having => \[ 'count(employee) >= ?', [ count => 100 ] ]
4201
4202 =head2 distinct
4203
4204 =over 4
4205
4206 =item Value: (0 | 1)
4207
4208 =back
4209
4210 Set to 1 to group by all columns. If the resultset already has a group_by
4211 attribute, this setting is ignored and an appropriate warning is issued.
4212
4213 =head2 where
4214
4215 =over 4
4216
4217 Adds to the WHERE clause.
4218
4219   # only return rows WHERE deleted IS NULL for all searches
4220   __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
4221
4222 Can be overridden by passing C<< { where => undef } >> as an attribute
4223 to a resultset.
4224
4225 =back
4226
4227 =head2 cache
4228
4229 Set to 1 to cache search results. This prevents extra SQL queries if you
4230 revisit rows in your ResultSet:
4231
4232   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
4233
4234   while( my $artist = $resultset->next ) {
4235     ... do stuff ...
4236   }
4237
4238   $rs->first; # without cache, this would issue a query
4239
4240 By default, searches are not cached.
4241
4242 For more examples of using these attributes, see
4243 L<DBIx::Class::Manual::Cookbook>.
4244
4245 =head2 for
4246
4247 =over 4
4248
4249 =item Value: ( 'update' | 'shared' )
4250
4251 =back
4252
4253 Set to 'update' for a SELECT ... FOR UPDATE or 'shared' for a SELECT
4254 ... FOR SHARED.
4255
4256 =cut
4257
4258 1;