lib/DBIx/Class/ResultSet.pm

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