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