lib/DBIx/Class/ResultSet.pm

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