lib/DBIx/Class/ResultSet.pm

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