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 use base qw/DBIx::Class/;
  18
  19 __PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/);
  20
  21 =head1 NAME
  22
  23 DBIx::Class::ResultSet - Represents a query used for fetching a set of results.
  24
  25 =head1 SYNOPSIS
  26
  27   my $users_rs   = $schema->resultset('User');
  28   while( $user = $users_rs->next) {
  29     print $user->username;
  30   }
  31
  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, $attrs);
 543   if (keys %{$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 (keys %{$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 sub _collapse_result {
 984   my ($self, $as_proto, $row) = @_;
 985
 986   my @copy = @$row;
 987
 988   # 'foo'         => [ undef, 'foo' ]
 989   # 'foo.bar'     => [ 'foo', 'bar' ]
 990   # 'foo.bar.baz' => [ 'foo.bar', 'baz' ]
 991
 992   my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto;
 993
 994   my %collapse = %{$self->{_attrs}{collapse}||{}};
 995
 996   my @pri_index;
 997
 998   # if we're doing collapsing (has_many prefetch) we need to grab records
 999   # until the PK changes, so fill @pri_index. if not, we leave it empty so
1000   # we know we don't have to bother.
1001
1002   # the reason for not using the collapse stuff directly is because if you
1003   # had for e.g. two artists in a row with no cds, the collapse info for
1004   # both would be NULL (undef) so you'd lose the second artist
1005
1006   # store just the index so we can check the array positions from the row
1007   # without having to contruct the full hash
1008
1009   if (keys %collapse) {
1010     my %pri = map { ($_ => 1) } $self->result_source->_pri_cols;
1011     foreach my $i (0 .. $#construct_as) {
1012       next if defined($construct_as[$i][0]); # only self table
1013       if (delete $pri{$construct_as[$i][1]}) {
1014         push(@pri_index, $i);
1015       }
1016       last unless keys %pri; # short circuit (Johnny Five Is Alive!)
1017     }
1018   }
1019
1020   # no need to do an if, it'll be empty if @pri_index is empty anyway
1021
1022   my %pri_vals = map { ($_ => $copy[$_]) } @pri_index;
1023
1024   my @const_rows;
1025
1026   do { # no need to check anything at the front, we always want the first row
1027
1028     my %const;
1029
1030     foreach my $this_as (@construct_as) {
1031       $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy);
1032     }
1033
1034     push(@const_rows, \%const);
1035
1036   } until ( # no pri_index => no collapse => drop straight out
1037       !@pri_index
1038     or
1039       do { # get another row, stash it, drop out if different PK
1040
1041         @copy = $self->cursor->next;
1042         $self->{stashed_row} = \@copy;
1043
1044         # last thing in do block, counts as true if anything doesn't match
1045
1046         # check xor defined first for NULL vs. NOT NULL then if one is
1047         # defined the other must be so check string equality
1048
1049         grep {
1050           (defined $pri_vals{$_} ^ defined $copy[$_])
1051           || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_]))
1052         } @pri_index;
1053       }
1054   );
1055
1056   my $alias = $self->{attrs}{alias};
1057   my $info = [];
1058
1059   my %collapse_pos;
1060
1061   my @const_keys;
1062
1063   foreach my $const (@const_rows) {
1064     scalar @const_keys or do {
1065       @const_keys = sort { length($a) <=> length($b) } keys %$const;
1066     };
1067     foreach my $key (@const_keys) {
1068       if (length $key) {
1069         my $target = $info;
1070         my @parts = split(/\./, $key);
1071         my $cur = '';
1072         my $data = $const->{$key};
1073         foreach my $p (@parts) {
1074           $target = $target->[1]->{$p} ||= [];
1075           $cur .= ".${p}";
1076           if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) {
1077             # collapsing at this point and on final part
1078             my $pos = $collapse_pos{$cur};
1079             CK: foreach my $ck (@ckey) {
1080               if (!defined $pos->{$ck} || $pos->{$ck} ne $data->{$ck}) {
1081                 $collapse_pos{$cur} = $data;
1082                 delete @collapse_pos{ # clear all positioning for sub-entries
1083                   grep { m/^\Q${cur}.\E/ } keys %collapse_pos
1084                 };
1085                 push(@$target, []);
1086                 last CK;
1087               }
1088             }
1089           }
1090           if (exists $collapse{$cur}) {
1091             $target = $target->[-1];
1092           }
1093         }
1094         $target->[0] = $data;
1095       } else {
1096         $info->[0] = $const->{$key};
1097       }
1098     }
1099   }
1100
1101   return $info;
1102 }
1103
1104 =head2 result_source
1105
1106 =over 4
1107
1108 =item Arguments: $result_source?
1109
1110 =item Return Value: $result_source
1111
1112 =back
1113
1114 An accessor for the primary ResultSource object from which this ResultSet
1115 is derived.
1116
1117 =head2 result_class
1118
1119 =over 4
1120
1121 =item Arguments: $result_class?
1122
1123 =item Return Value: $result_class
1124
1125 =back
1126
1127 An accessor for the class to use when creating row objects. Defaults to
1128 C<< result_source->result_class >> - which in most cases is the name of the
1129 L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
1130
1131 Note that changing the result_class will also remove any components
1132 that were originally loaded in the source class via
1133 L<DBIx::Class::ResultSource/load_components>. Any overloaded methods
1134 in the original source class will not run.
1135
1136 =cut
1137
1138 sub result_class {
1139   my ($self, $result_class) = @_;
1140   if ($result_class) {
1141     $self->ensure_class_loaded($result_class);
1142     $self->_result_class($result_class);
1143     $self->{attrs}{result_class} = $result_class if ref $self;
1144   }
1145   $self->_result_class;
1146 }
1147
1148 =head2 count
1149
1150 =over 4
1151
1152 =item Arguments: $cond, \%attrs??
1153
1154 =item Return Value: $count
1155
1156 =back
1157
1158 Performs an SQL C<COUNT> with the same query as the resultset was built
1159 with to find the number of elements. Passing arguments is equivalent to
1160 C<< $rs->search ($cond, \%attrs)->count >>
1161
1162 =cut
1163
1164 sub count {
1165   my $self = shift;
1166   return $self->search(@_)->count if @_ and defined $_[0];
1167   return scalar @{ $self->get_cache } if $self->get_cache;
1168
1169   my $attrs = $self->_resolved_attrs_copy;
1170
1171   # this is a little optimization - it is faster to do the limit
1172   # adjustments in software, instead of a subquery
1173   my $rows = delete $attrs->{rows};
1174   my $offset = delete $attrs->{offset};
1175
1176   my $crs;
1177   if ($self->_has_resolved_attr (qw/collapse group_by/)) {
1178     $crs = $self->_count_subq_rs ($attrs);
1179   }
1180   else {
1181     $crs = $self->_count_rs ($attrs);
1182   }
1183   my $count = $crs->next;
1184
1185   $count -= $offset if $offset;
1186   $count = $rows if $rows and $rows < $count;
1187   $count = 0 if ($count < 0);
1188
1189   return $count;
1190 }
1191
1192 =head2 count_rs
1193
1194 =over 4
1195
1196 =item Arguments: $cond, \%attrs??
1197
1198 =item Return Value: $count_rs
1199
1200 =back
1201
1202 Same as L</count> but returns a L<DBIx::Class::ResultSetColumn> object.
1203 This can be very handy for subqueries:
1204
1205   ->search( { amount => $some_rs->count_rs->as_query } )
1206
1207 As with regular resultsets the SQL query will be executed only after
1208 the resultset is accessed via L</next> or L</all>. That would return
1209 the same single value obtainable via L</count>.
1210
1211 =cut
1212
1213 sub count_rs {
1214   my $self = shift;
1215   return $self->search(@_)->count_rs if @_;
1216
1217   # this may look like a lack of abstraction (count() does about the same)
1218   # but in fact an _rs *must* use a subquery for the limits, as the
1219   # software based limiting can not be ported if this $rs is to be used
1220   # in a subquery itself (i.e. ->as_query)
1221   if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) {
1222     return $self->_count_subq_rs;
1223   }
1224   else {
1225     return $self->_count_rs;
1226   }
1227 }
1228
1229 #
1230 # returns a ResultSetColumn object tied to the count query
1231 #
1232 sub _count_rs {
1233   my ($self, $attrs) = @_;
1234
1235   my $rsrc = $self->result_source;
1236   $attrs ||= $self->_resolved_attrs;
1237
1238   # only take pieces we need for a simple count
1239   my $tmp_attrs = { map
1240     { $_ => $attrs->{$_} }
1241     qw/ alias from where bind join /
1242   };
1243
1244   # overwrite the selector (supplied by the storage)
1245   $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs);
1246   $tmp_attrs->{as} = 'count';
1247
1248   my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
1249
1250   return $tmp_rs;
1251 }
1252
1253 #
1254 # same as above but uses a subquery
1255 #
1256 sub _count_subq_rs {
1257   my ($self, $attrs) = @_;
1258
1259   my $rsrc = $self->result_source;
1260   $attrs ||= $self->_resolved_attrs;
1261
1262   my $sub_attrs = { map
1263     { $_ => $attrs->{$_} }
1264     qw/ alias from where bind join group_by having rows offset /
1265   };
1266
1267   # if we multi-prefetch we group_by primary keys only as this is what we would
1268   # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
1269   if ( keys %{$attrs->{collapse}}  ) {
1270     $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->_pri_cols) ]
1271   }
1272
1273   # Calculate subquery selector
1274   if (my $g = $sub_attrs->{group_by}) {
1275
1276     # necessary as the group_by may refer to aliased functions
1277     my $sel_index;
1278     for my $sel (@{$attrs->{select}}) {
1279       $sel_index->{$sel->{-as}} = $sel
1280         if (ref $sel eq 'HASH' and $sel->{-as});
1281     }
1282
1283     for my $g_part (@$g) {
1284       push @{$sub_attrs->{select}}, $sel_index->{$g_part} || $g_part;
1285     }
1286   }
1287   else {
1288     my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns);
1289     $sub_attrs->{select} = @pcols ? \@pcols : [ 1 ];
1290   }
1291
1292   return $rsrc->resultset_class
1293                ->new ($rsrc, $sub_attrs)
1294                 ->as_subselect_rs
1295                  ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } })
1296                   -> get_column ('count');
1297 }
1298
1299 sub _bool {
1300   return 1;
1301 }
1302
1303 =head2 count_literal
1304
1305 =over 4
1306
1307 =item Arguments: $sql_fragment, @bind_values
1308
1309 =item Return Value: $count
1310
1311 =back
1312
1313 Counts the results in a literal query. Equivalent to calling L</search_literal>
1314 with the passed arguments, then L</count>.
1315
1316 =cut
1317
1318 sub count_literal { shift->search_literal(@_)->count; }
1319
1320 =head2 all
1321
1322 =over 4
1323
1324 =item Arguments: none
1325
1326 =item Return Value: @objects
1327
1328 =back
1329
1330 Returns all elements in the resultset. Called implicitly if the resultset
1331 is returned in list context.
1332
1333 =cut
1334
1335 sub all {
1336   my $self = shift;
1337   if(@_) {
1338       $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
1339   }
1340
1341   return @{ $self->get_cache } if $self->get_cache;
1342
1343   my @obj;
1344
1345   if (keys %{$self->_resolved_attrs->{collapse}}) {
1346     # Using $self->cursor->all is really just an optimisation.
1347     # If we're collapsing has_many prefetches it probably makes
1348     # very little difference, and this is cleaner than hacking
1349     # _construct_object to survive the approach
1350     $self->cursor->reset;
1351     my @row = $self->cursor->next;
1352     while (@row) {
1353       push(@obj, $self->_construct_object(@row));
1354       @row = (exists $self->{stashed_row}
1355                ? @{delete $self->{stashed_row}}
1356                : $self->cursor->next);
1357     }
1358   } else {
1359     @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
1360   }
1361
1362   $self->set_cache(\@obj) if $self->{attrs}{cache};
1363
1364   return @obj;
1365 }
1366
1367 =head2 reset
1368
1369 =over 4
1370
1371 =item Arguments: none
1372
1373 =item Return Value: $self
1374
1375 =back
1376
1377 Resets the resultset's cursor, so you can iterate through the elements again.
1378 Implicitly resets the storage cursor, so a subsequent L</next> will trigger
1379 another query.
1380
1381 =cut
1382
1383 sub reset {
1384   my ($self) = @_;
1385   delete $self->{_attrs} if exists $self->{_attrs};
1386   $self->{all_cache_position} = 0;
1387   $self->cursor->reset;
1388   return $self;
1389 }
1390
1391 =head2 first
1392
1393 =over 4
1394
1395 =item Arguments: none
1396
1397 =item Return Value: $object?
1398
1399 =back
1400
1401 Resets the resultset and returns an object for the first result (if the
1402 resultset returns anything).
1403
1404 =cut
1405
1406 sub first {
1407   return $_[0]->reset->next;
1408 }
1409
1410
1411 # _rs_update_delete
1412 #
1413 # Determines whether and what type of subquery is required for the $rs operation.
1414 # If grouping is necessary either supplies its own, or verifies the current one
1415 # After all is done delegates to the proper storage method.
1416
1417 sub _rs_update_delete {
1418   my ($self, $op, $values) = @_;
1419
1420   my $rsrc = $self->result_source;
1421
1422   # if a condition exists we need to strip all table qualifiers
1423   # if this is not possible we'll force a subquery below
1424   my $cond = $rsrc->schema->storage->_strip_cond_qualifiers ($self->{cond});
1425
1426   my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/);
1427   my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/rows offset/);
1428
1429   if ($needs_group_by_subq or $needs_subq) {
1430
1431     # make a new $rs selecting only the PKs (that's all we really need)
1432     my $attrs = $self->_resolved_attrs_copy;
1433
1434     delete $attrs->{$_} for qw/collapse select as/;
1435     $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ];
1436
1437     if ($needs_group_by_subq) {
1438       # make sure no group_by was supplied, or if there is one - make sure it matches
1439       # the columns compiled above perfectly. Anything else can not be sanely executed
1440       # on most databases so croak right then and there
1441
1442       if (my $g = $attrs->{group_by}) {
1443         my @current_group_by = map
1444           { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
1445           @$g
1446         ;
1447
1448         if (
1449           join ("\x00", sort @current_group_by)
1450             ne
1451           join ("\x00", sort @{$attrs->{columns}} )
1452         ) {
1453           $self->throw_exception (
1454             "You have just attempted a $op operation on a resultset which does group_by"
1455             . ' on columns other than the primary keys, while DBIC internally needs to retrieve'
1456             . ' the primary keys in a subselect. All sane RDBMS engines do not support this'
1457             . ' kind of queries. Please retry the operation with a modified group_by or'
1458             . ' without using one at all.'
1459           );
1460         }
1461       }
1462       else {
1463         $attrs->{group_by} = $attrs->{columns};
1464       }
1465     }
1466
1467     my $subrs = (ref $self)->new($rsrc, $attrs);
1468
1469     return $self->result_source->storage->_subq_update_delete($subrs, $op, $values);
1470   }
1471   else {
1472     return $rsrc->storage->$op(
1473       $rsrc,
1474       $op eq 'update' ? $values : (),
1475       $cond,
1476     );
1477   }
1478 }
1479
1480 =head2 update
1481
1482 =over 4
1483
1484 =item Arguments: \%values
1485
1486 =item Return Value: $storage_rv
1487
1488 =back
1489
1490 Sets the specified columns in the resultset to the supplied values in a
1491 single query. Return value will be true if the update succeeded or false
1492 if no records were updated; exact type of success value is storage-dependent.
1493
1494 =cut
1495
1496 sub update {
1497   my ($self, $values) = @_;
1498   $self->throw_exception('Values for update must be a hash')
1499     unless ref $values eq 'HASH';
1500
1501   return $self->_rs_update_delete ('update', $values);
1502 }
1503
1504 =head2 update_all
1505
1506 =over 4
1507
1508 =item Arguments: \%values
1509
1510 =item Return Value: 1
1511
1512 =back
1513
1514 Fetches all objects and updates them one at a time. Note that C<update_all>
1515 will run DBIC cascade triggers, while L</update> will not.
1516
1517 =cut
1518
1519 sub update_all {
1520   my ($self, $values) = @_;
1521   $self->throw_exception('Values for update_all must be a hash')
1522     unless ref $values eq 'HASH';
1523
1524   my $guard = $self->result_source->schema->txn_scope_guard;
1525   $_->update($values) for $self->all;
1526   $guard->commit;
1527   return 1;
1528 }
1529
1530 =head2 delete
1531
1532 =over 4
1533
1534 =item Arguments: none
1535
1536 =item Return Value: $storage_rv
1537
1538 =back
1539
1540 Deletes the contents of the resultset from its result source. Note that this
1541 will not run DBIC cascade triggers. See L</delete_all> if you need triggers
1542 to run. See also L<DBIx::Class::Row/delete>.
1543
1544 Return value will be the number of rows deleted; exact type of return value
1545 is storage-dependent.
1546
1547 =cut
1548
1549 sub delete {
1550   my $self = shift;
1551   $self->throw_exception('delete does not accept any arguments')
1552     if @_;
1553
1554   return $self->_rs_update_delete ('delete');
1555 }
1556
1557 =head2 delete_all
1558
1559 =over 4
1560
1561 =item Arguments: none
1562
1563 =item Return Value: 1
1564
1565 =back
1566
1567 Fetches all objects and deletes them one at a time. Note that C<delete_all>
1568 will run DBIC cascade triggers, while L</delete> will not.
1569
1570 =cut
1571
1572 sub delete_all {
1573   my $self = shift;
1574   $self->throw_exception('delete_all does not accept any arguments')
1575     if @_;
1576
1577   my $guard = $self->result_source->schema->txn_scope_guard;
1578   $_->delete for $self->all;
1579   $guard->commit;
1580   return 1;
1581 }
1582
1583 =head2 populate
1584
1585 =over 4
1586
1587 =item Arguments: \@data;
1588
1589 =back
1590
1591 Accepts either an arrayref of hashrefs or alternatively an arrayref of arrayrefs.
1592 For the arrayref of hashrefs style each hashref should be a structure suitable
1593 forsubmitting to a $resultset->create(...) method.
1594
1595 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
1596 to insert the data, as this is a faster method.
1597
1598 Otherwise, each set of data is inserted into the database using
1599 L<DBIx::Class::ResultSet/create>, and the resulting objects are
1600 accumulated into an array. The array itself, or an array reference
1601 is returned depending on scalar or list context.
1602
1603 Example:  Assuming an Artist Class that has many CDs Classes relating:
1604
1605   my $Artist_rs = $schema->resultset("Artist");
1606
1607   ## Void Context Example
1608   $Artist_rs->populate([
1609      { artistid => 4, name => 'Manufactured Crap', cds => [
1610         { title => 'My First CD', year => 2006 },
1611         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
1612       ],
1613      },
1614      { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
1615         { title => 'My parents sold me to a record company', year => 2005 },
1616         { title => 'Why Am I So Ugly?', year => 2006 },
1617         { title => 'I Got Surgery and am now Popular', year => 2007 }
1618       ],
1619      },
1620   ]);
1621
1622   ## Array Context Example
1623   my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([
1624     { name => "Artist One"},
1625     { name => "Artist Two"},
1626     { name => "Artist Three", cds=> [
1627     { title => "First CD", year => 2007},
1628     { title => "Second CD", year => 2008},
1629   ]}
1630   ]);
1631
1632   print $ArtistOne->name; ## response is 'Artist One'
1633   print $ArtistThree->cds->count ## reponse is '2'
1634
1635 For the arrayref of arrayrefs style,  the first element should be a list of the
1636 fieldsnames to which the remaining elements are rows being inserted.  For
1637 example:
1638
1639   $Arstist_rs->populate([
1640     [qw/artistid name/],
1641     [100, 'A Formally Unknown Singer'],
1642     [101, 'A singer that jumped the shark two albums ago'],
1643     [102, 'An actually cool singer'],
1644   ]);
1645
1646 Please note an important effect on your data when choosing between void and
1647 wantarray context. Since void context goes straight to C<insert_bulk> in
1648 L<DBIx::Class::Storage::DBI> this will skip any component that is overriding
1649 C<insert>.  So if you are using something like L<DBIx-Class-UUIDColumns> to
1650 create primary keys for you, you will find that your PKs are empty.  In this
1651 case you will have to use the wantarray context in order to create those
1652 values.
1653
1654 =cut
1655
1656 sub populate {
1657   my $self = shift;
1658
1659   # cruft placed in standalone method
1660   my $data = $self->_normalize_populate_args(@_);
1661
1662   if(defined wantarray) {
1663     my @created;
1664     foreach my $item (@$data) {
1665       push(@created, $self->create($item));
1666     }
1667     return wantarray ? @created : \@created;
1668   } else {
1669     my $first = $data->[0];
1670
1671     # if a column is a registered relationship, and is a non-blessed hash/array, consider
1672     # it relationship data
1673     my (@rels, @columns);
1674     for (keys %$first) {
1675       my $ref = ref $first->{$_};
1676       $self->result_source->has_relationship($_) && ($ref eq 'ARRAY' or $ref eq 'HASH')
1677         ? push @rels, $_
1678         : push @columns, $_
1679       ;
1680     }
1681
1682     my @pks = $self->result_source->primary_columns;
1683
1684     ## do the belongs_to relationships
1685     foreach my $index (0..$#$data) {
1686
1687       # delegate to create() for any dataset without primary keys with specified relationships
1688       if (grep { !defined $data->[$index]->{$_} } @pks ) {
1689         for my $r (@rels) {
1690           if (grep { ref $data->[$index]{$r} eq $_ } qw/HASH ARRAY/) {  # a related set must be a HASH or AoH
1691             my @ret = $self->populate($data);
1692             return;
1693           }
1694         }
1695       }
1696
1697       foreach my $rel (@rels) {
1698         next unless ref $data->[$index]->{$rel} eq "HASH";
1699         my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
1700         my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)};
1701         my $related = $result->result_source->_resolve_condition(
1702           $result->result_source->relationship_info($reverse)->{cond},
1703           $self,
1704           $result,
1705         );
1706
1707         delete $data->[$index]->{$rel};
1708         $data->[$index] = {%{$data->[$index]}, %$related};
1709
1710         push @columns, keys %$related if $index == 0;
1711       }
1712     }
1713
1714     ## inherit the data locked in the conditions of the resultset
1715     my ($rs_data) = $self->_merge_cond_with_data({});
1716     delete @{$rs_data}{@columns};
1717     my @inherit_cols = keys %$rs_data;
1718     my @inherit_data = values %$rs_data;
1719
1720     ## do bulk insert on current row
1721     $self->result_source->storage->insert_bulk(
1722       $self->result_source,
1723       [@columns, @inherit_cols],
1724       [ map { [ @$_{@columns}, @inherit_data ] } @$data ],
1725     );
1726
1727     ## do the has_many relationships
1728     foreach my $item (@$data) {
1729
1730       foreach my $rel (@rels) {
1731         next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY";
1732
1733         my $parent = $self->find({map { $_ => $item->{$_} } @pks})
1734      || $self->throw_exception('Cannot find the relating object.');
1735
1736         my $child = $parent->$rel;
1737
1738         my $related = $child->result_source->_resolve_condition(
1739           $parent->result_source->relationship_info($rel)->{cond},
1740           $child,
1741           $parent,
1742         );
1743
1744         my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
1745         my @populate = map { {%$_, %$related} } @rows_to_add;
1746
1747         $child->populate( \@populate );
1748       }
1749     }
1750   }
1751 }
1752
1753
1754 # populate() argumnets went over several incarnations
1755 # What we ultimately support is AoH
1756 sub _normalize_populate_args {
1757   my ($self, $arg) = @_;
1758
1759   if (ref $arg eq 'ARRAY') {
1760     if (ref $arg->[0] eq 'HASH') {
1761       return $arg;
1762     }
1763     elsif (ref $arg->[0] eq 'ARRAY') {
1764       my @ret;
1765       my @colnames = @{$arg->[0]};
1766       foreach my $values (@{$arg}[1 .. $#$arg]) {
1767         push @ret, { map { $colnames[$_] => $values->[$_] } (0 .. $#colnames) };
1768       }
1769       return \@ret;
1770     }
1771   }
1772
1773   $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs');
1774 }
1775
1776 =head2 pager
1777
1778 =over 4
1779
1780 =item Arguments: none
1781
1782 =item Return Value: $pager
1783
1784 =back
1785
1786 Return Value a L<Data::Page> object for the current resultset. Only makes
1787 sense for queries with a C<page> attribute.
1788
1789 To get the full count of entries for a paged resultset, call
1790 C<total_entries> on the L<Data::Page> object.
1791
1792 =cut
1793
1794 sub pager {
1795   my ($self) = @_;
1796
1797   return $self->{pager} if $self->{pager};
1798
1799   my $attrs = $self->{attrs};
1800   $self->throw_exception("Can't create pager for non-paged rs")
1801     unless $self->{attrs}{page};
1802   $attrs->{rows} ||= 10;
1803
1804   # throw away the paging flags and re-run the count (possibly
1805   # with a subselect) to get the real total count
1806   my $count_attrs = { %$attrs };
1807   delete $count_attrs->{$_} for qw/rows offset page pager/;
1808   my $total_count = (ref $self)->new($self->result_source, $count_attrs)->count;
1809
1810   return $self->{pager} = Data::Page->new(
1811     $total_count,
1812     $attrs->{rows},
1813     $self->{attrs}{page}
1814   );
1815 }
1816
1817 =head2 page
1818
1819 =over 4
1820
1821 =item Arguments: $page_number
1822
1823 =item Return Value: $rs
1824
1825 =back
1826
1827 Returns a resultset for the $page_number page of the resultset on which page
1828 is called, where each page contains a number of rows equal to the 'rows'
1829 attribute set on the resultset (10 by default).
1830
1831 =cut
1832
1833 sub page {
1834   my ($self, $page) = @_;
1835   return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
1836 }
1837
1838 =head2 new_result
1839
1840 =over 4
1841
1842 =item Arguments: \%vals
1843
1844 =item Return Value: $rowobject
1845
1846 =back
1847
1848 Creates a new row object in the resultset's result class and returns
1849 it. The row is not inserted into the database at this point, call
1850 L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
1851 will tell you whether the row object has been inserted or not.
1852
1853 Passes the hashref of input on to L<DBIx::Class::Row/new>.
1854
1855 =cut
1856
1857 sub new_result {
1858   my ($self, $values) = @_;
1859   $self->throw_exception( "new_result needs a hash" )
1860     unless (ref $values eq 'HASH');
1861
1862   my ($merged_cond, $cols_from_relations) = $self->_merge_cond_with_data($values);
1863
1864   my %new = (
1865     %$merged_cond,
1866     @$cols_from_relations
1867       ? (-cols_from_relations => $cols_from_relations)
1868       : (),
1869     -source_handle => $self->_source_handle,
1870     -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
1871   );
1872
1873   return $self->result_class->new(\%new);
1874 }
1875
1876 # _merge_cond_with_data
1877 #
1878 # Takes a simple hash of K/V data and returns its copy merged with the
1879 # condition already present on the resultset. Additionally returns an
1880 # arrayref of value/condition names, which were inferred from related
1881 # objects (this is needed for in-memory related objects)
1882 sub _merge_cond_with_data {
1883   my ($self, $data) = @_;
1884
1885   my (%new_data, @cols_from_relations);
1886
1887   my $alias = $self->{attrs}{alias};
1888
1889   if (! defined $self->{cond}) {
1890     # just massage $data below
1891   }
1892   elsif ($self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
1893     %new_data = %{ $self->{attrs}{related_objects} || {} };  # nothing might have been inserted yet
1894     @cols_from_relations = keys %new_data;
1895   }
1896   elsif (ref $self->{cond} ne 'HASH') {
1897     $self->throw_exception(
1898       "Can't abstract implicit construct, resultset condition not a hash"
1899     );
1900   }
1901   else {
1902     # precendence must be given to passed values over values inherited from
1903     # the cond, so the order here is important.
1904     my $collapsed_cond = $self->_collapse_cond($self->{cond});
1905     my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
1906
1907     while ( my($col, $value) = each %implied ) {
1908       if (ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') {
1909         $new_data{$col} = $value->{'='};
1910         next;
1911       }
1912       $new_data{$col} = $value if $self->_is_deterministic_value($value);
1913     }
1914   }
1915
1916   %new_data = (
1917     %new_data,
1918     %{ $self->_remove_alias($data, $alias) },
1919   );
1920
1921   return (\%new_data, \@cols_from_relations);
1922 }
1923
1924 # _is_deterministic_value
1925 #
1926 # Make an effor to strip non-deterministic values from the condition,
1927 # to make sure new_result chokes less
1928
1929 sub _is_deterministic_value {
1930   my $self = shift;
1931   my $value = shift;
1932   my $ref_type = ref $value;
1933   return 1 if $ref_type eq '' || $ref_type eq 'SCALAR';
1934   return 1 if Scalar::Util::blessed($value);
1935   return 0;
1936 }
1937
1938 # _has_resolved_attr
1939 #
1940 # determines if the resultset defines at least one
1941 # of the attributes supplied
1942 #
1943 # used to determine if a subquery is neccessary
1944 #
1945 # supports some virtual attributes:
1946 #   -join
1947 #     This will scan for any joins being present on the resultset.
1948 #     It is not a mere key-search but a deep inspection of {from}
1949 #
1950
1951 sub _has_resolved_attr {
1952   my ($self, @attr_names) = @_;
1953
1954   my $attrs = $self->_resolved_attrs;
1955
1956   my %extra_checks;
1957
1958   for my $n (@attr_names) {
1959     if (grep { $n eq $_ } (qw/-join/) ) {
1960       $extra_checks{$n}++;
1961       next;
1962     }
1963
1964     my $attr =  $attrs->{$n};
1965
1966     next if not defined $attr;
1967
1968     if (ref $attr eq 'HASH') {
1969       return 1 if keys %$attr;
1970     }
1971     elsif (ref $attr eq 'ARRAY') {
1972       return 1 if @$attr;
1973     }
1974     else {
1975       return 1 if $attr;
1976     }
1977   }
1978
1979   # a resolved join is expressed as a multi-level from
1980   return 1 if (
1981     $extra_checks{-join}
1982       and
1983     ref $attrs->{from} eq 'ARRAY'
1984       and
1985     @{$attrs->{from}} > 1
1986   );
1987
1988   return 0;
1989 }
1990
1991 # _collapse_cond
1992 #
1993 # Recursively collapse the condition.
1994
1995 sub _collapse_cond {
1996   my ($self, $cond, $collapsed) = @_;
1997
1998   $collapsed ||= {};
1999
2000   if (ref $cond eq 'ARRAY') {
2001     foreach my $subcond (@$cond) {
2002       next unless ref $subcond;  # -or
2003       $collapsed = $self->_collapse_cond($subcond, $collapsed);
2004     }
2005   }
2006   elsif (ref $cond eq 'HASH') {
2007     if (keys %$cond and (keys %$cond)[0] eq '-and') {
2008       foreach my $subcond (@{$cond->{-and}}) {
2009         $collapsed = $self->_collapse_cond($subcond, $collapsed);
2010       }
2011     }
2012     else {
2013       foreach my $col (keys %$cond) {
2014         my $value = $cond->{$col};
2015         $collapsed->{$col} = $value;
2016       }
2017     }
2018   }
2019
2020   return $collapsed;
2021 }
2022
2023 # _remove_alias
2024 #
2025 # Remove the specified alias from the specified query hash. A copy is made so
2026 # the original query is not modified.
2027
2028 sub _remove_alias {
2029   my ($self, $query, $alias) = @_;
2030
2031   my %orig = %{ $query || {} };
2032   my %unaliased;
2033
2034   foreach my $key (keys %orig) {
2035     if ($key !~ /\./) {
2036       $unaliased{$key} = $orig{$key};
2037       next;
2038     }
2039     $unaliased{$1} = $orig{$key}
2040       if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
2041   }
2042
2043   return \%unaliased;
2044 }
2045
2046 =head2 as_query
2047
2048 =over 4
2049
2050 =item Arguments: none
2051
2052 =item Return Value: \[ $sql, @bind ]
2053
2054 =back
2055
2056 Returns the SQL query and bind vars associated with the invocant.
2057
2058 This is generally used as the RHS for a subquery.
2059
2060 =cut
2061
2062 sub as_query {
2063   my $self = shift;
2064
2065   my $attrs = $self->_resolved_attrs_copy;
2066
2067   # For future use:
2068   #
2069   # in list ctx:
2070   # my ($sql, \@bind, \%dbi_bind_attrs) = _select_args_to_query (...)
2071   # $sql also has no wrapping parenthesis in list ctx
2072   #
2073   my $sqlbind = $self->result_source->storage
2074     ->_select_args_to_query ($attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs);
2075
2076   return $sqlbind;
2077 }
2078
2079 =head2 find_or_new
2080
2081 =over 4
2082
2083 =item Arguments: \%vals, \%attrs?
2084
2085 =item Return Value: $rowobject
2086
2087 =back
2088
2089   my $artist = $schema->resultset('Artist')->find_or_new(
2090     { artist => 'fred' }, { key => 'artists' });
2091
2092   $cd->cd_to_producer->find_or_new({ producer => $producer },
2093                                    { key => 'primary });
2094
2095 Find an existing record from this resultset, based on its primary
2096 key, or a unique constraint. If none exists, instantiate a new result
2097 object and return it. The object will not be saved into your storage
2098 until you call L<DBIx::Class::Row/insert> on it.
2099
2100 You most likely want this method when looking for existing rows using
2101 a unique constraint that is not the primary key, or looking for
2102 related rows.
2103
2104 If you want objects to be saved immediately, use L</find_or_create>
2105 instead.
2106
2107 B<Note>: Take care when using C<find_or_new> with a table having
2108 columns with default values that you intend to be automatically
2109 supplied by the database (e.g. an auto_increment primary key column).
2110 In normal usage, the value of such columns should NOT be included at
2111 all in the call to C<find_or_new>, even when set to C<undef>.
2112
2113 =cut
2114
2115 sub find_or_new {
2116   my $self     = shift;
2117   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2118   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2119   if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2120     return $row;
2121   }
2122   return $self->new_result($hash);
2123 }
2124
2125 =head2 create
2126
2127 =over 4
2128
2129 =item Arguments: \%vals
2130
2131 =item Return Value: a L<DBIx::Class::Row> $object
2132
2133 =back
2134
2135 Attempt to create a single new row or a row with multiple related rows
2136 in the table represented by the resultset (and related tables). This
2137 will not check for duplicate rows before inserting, use
2138 L</find_or_create> to do that.
2139
2140 To create one row for this resultset, pass a hashref of key/value
2141 pairs representing the columns of the table and the values you wish to
2142 store. If the appropriate relationships are set up, foreign key fields
2143 can also be passed an object representing the foreign row, and the
2144 value will be set to its primary key.
2145
2146 To create related objects, pass a hashref of related-object column values
2147 B<keyed on the relationship name>. If the relationship is of type C<multi>
2148 (L<DBIx::Class::Relationship/has_many>) - pass an arrayref of hashrefs.
2149 The process will correctly identify columns holding foreign keys, and will
2150 transparently populate them from the keys of the corresponding relation.
2151 This can be applied recursively, and will work correctly for a structure
2152 with an arbitrary depth and width, as long as the relationships actually
2153 exists and the correct column data has been supplied.
2154
2155
2156 Instead of hashrefs of plain related data (key/value pairs), you may
2157 also pass new or inserted objects. New objects (not inserted yet, see
2158 L</new>), will be inserted into their appropriate tables.
2159
2160 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
2161
2162 Example of creating a new row.
2163
2164   $person_rs->create({
2165     name=>"Some Person",
2166     email=>"somebody@someplace.com"
2167   });
2168
2169 Example of creating a new row and also creating rows in a related C<has_many>
2170 or C<has_one> resultset.  Note Arrayref.
2171
2172   $artist_rs->create(
2173      { artistid => 4, name => 'Manufactured Crap', cds => [
2174         { title => 'My First CD', year => 2006 },
2175         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2176       ],
2177      },
2178   );
2179
2180 Example of creating a new row and also creating a row in a related
2181 C<belongs_to>resultset. Note Hashref.
2182
2183   $cd_rs->create({
2184     title=>"Music for Silly Walks",
2185     year=>2000,
2186     artist => {
2187       name=>"Silly Musician",
2188     }
2189   });
2190
2191 =over
2192
2193 =item WARNING
2194
2195 When subclassing ResultSet never attempt to override this method. Since
2196 it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a
2197 lot of the internals simply never call it, so your override will be
2198 bypassed more often than not. Override either L<new|DBIx::Class::Row/new>
2199 or L<insert|DBIx::Class::Row/insert> depending on how early in the
2200 L</create> process you need to intervene.
2201
2202 =back
2203
2204 =cut
2205
2206 sub create {
2207   my ($self, $attrs) = @_;
2208   $self->throw_exception( "create needs a hashref" )
2209     unless ref $attrs eq 'HASH';
2210   return $self->new_result($attrs)->insert;
2211 }
2212
2213 =head2 find_or_create
2214
2215 =over 4
2216
2217 =item Arguments: \%vals, \%attrs?
2218
2219 =item Return Value: $rowobject
2220
2221 =back
2222
2223   $cd->cd_to_producer->find_or_create({ producer => $producer },
2224                                       { key => 'primary' });
2225
2226 Tries to find a record based on its primary key or unique constraints; if none
2227 is found, creates one and returns that instead.
2228
2229   my $cd = $schema->resultset('CD')->find_or_create({
2230     cdid   => 5,
2231     artist => 'Massive Attack',
2232     title  => 'Mezzanine',
2233     year   => 2005,
2234   });
2235
2236 Also takes an optional C<key> attribute, to search by a specific key or unique
2237 constraint. For example:
2238
2239   my $cd = $schema->resultset('CD')->find_or_create(
2240     {
2241       artist => 'Massive Attack',
2242       title  => 'Mezzanine',
2243     },
2244     { key => 'cd_artist_title' }
2245   );
2246
2247 B<Note>: Because find_or_create() reads from the database and then
2248 possibly inserts based on the result, this method is subject to a race
2249 condition. Another process could create a record in the table after
2250 the find has completed and before the create has started. To avoid
2251 this problem, use find_or_create() inside a transaction.
2252
2253 B<Note>: Take care when using C<find_or_create> with a table having
2254 columns with default values that you intend to be automatically
2255 supplied by the database (e.g. an auto_increment primary key column).
2256 In normal usage, the value of such columns should NOT be included at
2257 all in the call to C<find_or_create>, even when set to C<undef>.
2258
2259 See also L</find> and L</update_or_create>. For information on how to declare
2260 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2261
2262 =cut
2263
2264 sub find_or_create {
2265   my $self     = shift;
2266   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2267   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2268   if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2269     return $row;
2270   }
2271   return $self->create($hash);
2272 }
2273
2274 =head2 update_or_create
2275
2276 =over 4
2277
2278 =item Arguments: \%col_values, { key => $unique_constraint }?
2279
2280 =item Return Value: $rowobject
2281
2282 =back
2283
2284   $resultset->update_or_create({ col => $val, ... });
2285
2286 First, searches for an existing row matching one of the unique constraints
2287 (including the primary key) on the source of this resultset. If a row is
2288 found, updates it with the other given column values. Otherwise, creates a new
2289 row.
2290
2291 Takes an optional C<key> attribute to search on a specific unique constraint.
2292 For example:
2293
2294   # In your application
2295   my $cd = $schema->resultset('CD')->update_or_create(
2296     {
2297       artist => 'Massive Attack',
2298       title  => 'Mezzanine',
2299       year   => 1998,
2300     },
2301     { key => 'cd_artist_title' }
2302   );
2303
2304   $cd->cd_to_producer->update_or_create({
2305     producer => $producer,
2306     name => 'harry',
2307   }, {
2308     key => 'primary',
2309   });
2310
2311
2312 If no C<key> is specified, it searches on all unique constraints defined on the
2313 source, including the primary key.
2314
2315 If the C<key> is specified as C<primary>, it searches only on the primary key.
2316
2317 See also L</find> and L</find_or_create>. For information on how to declare
2318 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2319
2320 B<Note>: Take care when using C<update_or_create> with a table having
2321 columns with default values that you intend to be automatically
2322 supplied by the database (e.g. an auto_increment primary key column).
2323 In normal usage, the value of such columns should NOT be included at
2324 all in the call to C<update_or_create>, even when set to C<undef>.
2325
2326 =cut
2327
2328 sub update_or_create {
2329   my $self = shift;
2330   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2331   my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
2332
2333   my $row = $self->find($cond, $attrs);
2334   if (defined $row) {
2335     $row->update($cond);
2336     return $row;
2337   }
2338
2339   return $self->create($cond);
2340 }
2341
2342 =head2 update_or_new
2343
2344 =over 4
2345
2346 =item Arguments: \%col_values, { key => $unique_constraint }?
2347
2348 =item Return Value: $rowobject
2349
2350 =back
2351
2352   $resultset->update_or_new({ col => $val, ... });
2353
2354 First, searches for an existing row matching one of the unique constraints
2355 (including the primary key) on the source of this resultset. If a row is
2356 found, updates it with the other given column values. Otherwise, instantiate
2357 a new result object and return it. The object will not be saved into your storage
2358 until you call L<DBIx::Class::Row/insert> on it.
2359
2360 Takes an optional C<key> attribute to search on a specific unique constraint.
2361 For example:
2362
2363   # In your application
2364   my $cd = $schema->resultset('CD')->update_or_new(
2365     {
2366       artist => 'Massive Attack',
2367       title  => 'Mezzanine',
2368       year   => 1998,
2369     },
2370     { key => 'cd_artist_title' }
2371   );
2372
2373   if ($cd->in_storage) {
2374       # the cd was updated
2375   }
2376   else {
2377       # the cd is not yet in the database, let's insert it
2378       $cd->insert;
2379   }
2380
2381 B<Note>: Take care when using C<update_or_new> with a table having
2382 columns with default values that you intend to be automatically
2383 supplied by the database (e.g. an auto_increment primary key column).
2384 In normal usage, the value of such columns should NOT be included at
2385 all in the call to C<update_or_new>, even when set to C<undef>.
2386
2387 See also L</find>, L</find_or_create> and L</find_or_new>.
2388
2389 =cut
2390
2391 sub update_or_new {
2392     my $self  = shift;
2393     my $attrs = ( @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {} );
2394     my $cond  = ref $_[0] eq 'HASH' ? shift : {@_};
2395
2396     my $row = $self->find( $cond, $attrs );
2397     if ( defined $row ) {
2398         $row->update($cond);
2399         return $row;
2400     }
2401
2402     return $self->new_result($cond);
2403 }
2404
2405 =head2 get_cache
2406
2407 =over 4
2408
2409 =item Arguments: none
2410
2411 =item Return Value: \@cache_objects?
2412
2413 =back
2414
2415 Gets the contents of the cache for the resultset, if the cache is set.
2416
2417 The cache is populated either by using the L</prefetch> attribute to
2418 L</search> or by calling L</set_cache>.
2419
2420 =cut
2421
2422 sub get_cache {
2423   shift->{all_cache};
2424 }
2425
2426 =head2 set_cache
2427
2428 =over 4
2429
2430 =item Arguments: \@cache_objects
2431
2432 =item Return Value: \@cache_objects
2433
2434 =back
2435
2436 Sets the contents of the cache for the resultset. Expects an arrayref
2437 of objects of the same class as those produced by the resultset. Note that
2438 if the cache is set the resultset will return the cached objects rather
2439 than re-querying the database even if the cache attr is not set.
2440
2441 The contents of the cache can also be populated by using the
2442 L</prefetch> attribute to L</search>.
2443
2444 =cut
2445
2446 sub set_cache {
2447   my ( $self, $data ) = @_;
2448   $self->throw_exception("set_cache requires an arrayref")
2449       if defined($data) && (ref $data ne 'ARRAY');
2450   $self->{all_cache} = $data;
2451 }
2452
2453 =head2 clear_cache
2454
2455 =over 4
2456
2457 =item Arguments: none
2458
2459 =item Return Value: []
2460
2461 =back
2462
2463 Clears the cache for the resultset.
2464
2465 =cut
2466
2467 sub clear_cache {
2468   shift->set_cache(undef);
2469 }
2470
2471 =head2 is_paged
2472
2473 =over 4
2474
2475 =item Arguments: none
2476
2477 =item Return Value: true, if the resultset has been paginated
2478
2479 =back
2480
2481 =cut
2482
2483 sub is_paged {
2484   my ($self) = @_;
2485   return !!$self->{attrs}{page};
2486 }
2487
2488 =head2 is_ordered
2489
2490 =over 4
2491
2492 =item Arguments: none
2493
2494 =item Return Value: true, if the resultset has been ordered with C<order_by>.
2495
2496 =back
2497
2498 =cut
2499
2500 sub is_ordered {
2501   my ($self) = @_;
2502   return scalar $self->result_source->storage->_parse_order_by($self->{attrs}{order_by});
2503 }
2504
2505 =head2 related_resultset
2506
2507 =over 4
2508
2509 =item Arguments: $relationship_name
2510
2511 =item Return Value: $resultset
2512
2513 =back
2514
2515 Returns a related resultset for the supplied relationship name.
2516
2517   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
2518
2519 =cut
2520
2521 sub related_resultset {
2522   my ($self, $rel) = @_;
2523
2524   $self->{related_resultsets} ||= {};
2525   return $self->{related_resultsets}{$rel} ||= do {
2526     my $rsrc = $self->result_source;
2527     my $rel_info = $rsrc->relationship_info($rel);
2528
2529     $self->throw_exception(
2530       "search_related: result source '" . $rsrc->source_name .
2531         "' has no such relationship $rel")
2532       unless $rel_info;
2533
2534     my $attrs = $self->_chain_relationship($rel);
2535
2536     my $join_count = $attrs->{seen_join}{$rel};
2537
2538     my $alias = $self->result_source->storage
2539         ->relname_to_table_alias($rel, $join_count);
2540
2541     # since this is search_related, and we already slid the select window inwards
2542     # (the select/as attrs were deleted in the beginning), we need to flip all
2543     # left joins to inner, so we get the expected results
2544     # read the comment on top of the actual function to see what this does
2545     $attrs->{from} = $rsrc->schema->storage->_straight_join_to_node ($attrs->{from}, $alias);
2546
2547
2548     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
2549     delete @{$attrs}{qw(result_class alias)};
2550
2551     my $new_cache;
2552
2553     if (my $cache = $self->get_cache) {
2554       if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) {
2555         $new_cache = [ map { @{$_->related_resultset($rel)->get_cache} }
2556                         @$cache ];
2557       }
2558     }
2559
2560     my $rel_source = $rsrc->related_source($rel);
2561
2562     my $new = do {
2563
2564       # The reason we do this now instead of passing the alias to the
2565       # search_rs below is that if you wrap/overload resultset on the
2566       # source you need to know what alias it's -going- to have for things
2567       # to work sanely (e.g. RestrictWithObject wants to be able to add
2568       # extra query restrictions, and these may need to be $alias.)
2569
2570       my $rel_attrs = $rel_source->resultset_attributes;
2571       local $rel_attrs->{alias} = $alias;
2572
2573       $rel_source->resultset
2574                  ->search_rs(
2575                      undef, {
2576                        %$attrs,
2577                        where => $attrs->{where},
2578                    });
2579     };
2580     $new->set_cache($new_cache) if $new_cache;
2581     $new;
2582   };
2583 }
2584
2585 =head2 current_source_alias
2586
2587 =over 4
2588
2589 =item Arguments: none
2590
2591 =item Return Value: $source_alias
2592
2593 =back
2594
2595 Returns the current table alias for the result source this resultset is built
2596 on, that will be used in the SQL query. Usually it is C<me>.
2597
2598 Currently the source alias that refers to the result set returned by a
2599 L</search>/L</find> family method depends on how you got to the resultset: it's
2600 C<me> by default, but eg. L</search_related> aliases it to the related result
2601 source name (and keeps C<me> referring to the original result set). The long
2602 term goal is to make L<DBIx::Class> always alias the current resultset as C<me>
2603 (and make this method unnecessary).
2604
2605 Thus it's currently necessary to use this method in predefined queries (see
2606 L<DBIx::Class::Manual::Cookbook/Predefined searches>) when referring to the
2607 source alias of the current result set:
2608
2609   # in a result set class
2610   sub modified_by {
2611     my ($self, $user) = @_;
2612
2613     my $me = $self->current_source_alias;
2614
2615     return $self->search(
2616       "$me.modified" => $user->id,
2617     );
2618   }
2619
2620 =cut
2621
2622 sub current_source_alias {
2623   my ($self) = @_;
2624
2625   return ($self->{attrs} || {})->{alias} || 'me';
2626 }
2627
2628 =head2 as_subselect_rs
2629
2630 =over 4
2631
2632 =item Arguments: none
2633
2634 =item Return Value: $resultset
2635
2636 =back
2637
2638 Act as a barrier to SQL symbols.  The resultset provided will be made into a
2639 "virtual view" by including it as a subquery within the from clause.  From this
2640 point on, any joined tables are inaccessible to ->search on the resultset (as if
2641 it were simply where-filtered without joins).  For example:
2642
2643  my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' });
2644
2645  # 'x' now pollutes the query namespace
2646
2647  # So the following works as expected
2648  my $ok_rs = $rs->search({'x.other' => 1});
2649
2650  # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and
2651  # def) we look for one row with contradictory terms and join in another table
2652  # (aliased 'x_2') which we never use
2653  my $broken_rs = $rs->search({'x.name' => 'def'});
2654
2655  my $rs2 = $rs->as_subselect_rs;
2656
2657  # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away
2658  my $not_joined_rs = $rs2->search({'x.other' => 1});
2659
2660  # works as expected: finds a 'table' row related to two x rows (abc and def)
2661  my $correctly_joined_rs = $rs2->search({'x.name' => 'def'});
2662
2663 Another example of when one might use this would be to select a subset of
2664 columns in a group by clause:
2665
2666  my $rs = $schema->resultset('Bar')->search(undef, {
2667    group_by => [qw{ id foo_id baz_id }],
2668  })->as_subselect_rs->search(undef, {
2669    columns => [qw{ id foo_id }]
2670  });
2671
2672 In the above example normally columns would have to be equal to the group by,
2673 but because we isolated the group by into a subselect the above works.
2674
2675 =cut
2676
2677 sub as_subselect_rs {
2678   my $self = shift;
2679
2680   my $attrs = $self->_resolved_attrs;
2681
2682   my $fresh_rs = (ref $self)->new (
2683     $self->result_source
2684   );
2685
2686   # these pieces will be locked in the subquery
2687   delete $fresh_rs->{cond};
2688   delete @{$fresh_rs->{attrs}}{qw/where bind/};
2689
2690   return $fresh_rs->search( {}, {
2691     from => [{
2692       $attrs->{alias} => $self->as_query,
2693       -alias         => $attrs->{alias},
2694       -source_handle => $self->result_source->handle,
2695     }],
2696     alias => $attrs->{alias},
2697   });
2698 }
2699
2700 # This code is called by search_related, and makes sure there
2701 # is clear separation between the joins before, during, and
2702 # after the relationship. This information is needed later
2703 # in order to properly resolve prefetch aliases (any alias
2704 # with a relation_chain_depth less than the depth of the
2705 # current prefetch is not considered)
2706 #
2707 # The increments happen twice per join. An even number means a
2708 # relationship specified via a search_related, whereas an odd
2709 # number indicates a join/prefetch added via attributes
2710 #
2711 # Also this code will wrap the current resultset (the one we
2712 # chain to) in a subselect IFF it contains limiting attributes
2713 sub _chain_relationship {
2714   my ($self, $rel) = @_;
2715   my $source = $self->result_source;
2716   my $attrs = { %{$self->{attrs}||{}} };
2717
2718   # we need to take the prefetch the attrs into account before we
2719   # ->_resolve_join as otherwise they get lost - captainL
2720   my $join = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} );
2721
2722   delete @{$attrs}{qw/join prefetch collapse group_by distinct select as columns +select +as +columns/};
2723
2724   my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
2725
2726   my $from;
2727   my @force_subq_attrs = qw/offset rows group_by having/;
2728
2729   if (
2730     ($attrs->{from} && ref $attrs->{from} ne 'ARRAY')
2731       ||
2732     $self->_has_resolved_attr (@force_subq_attrs)
2733   ) {
2734     # Nuke the prefetch (if any) before the new $rs attrs
2735     # are resolved (prefetch is useless - we are wrapping
2736     # a subquery anyway).
2737     my $rs_copy = $self->search;
2738     $rs_copy->{attrs}{join} = $self->_merge_attr (
2739       $rs_copy->{attrs}{join},
2740       delete $rs_copy->{attrs}{prefetch},
2741     );
2742
2743     $from = [{
2744       -source_handle => $source->handle,
2745       -alias => $attrs->{alias},
2746       $attrs->{alias} => $rs_copy->as_query,
2747     }];
2748     delete @{$attrs}{@force_subq_attrs, qw/where bind/};
2749     $seen->{-relation_chain_depth} = 0;
2750   }
2751   elsif ($attrs->{from}) {  #shallow copy suffices
2752     $from = [ @{$attrs->{from}} ];
2753   }
2754   else {
2755     $from = [{
2756       -source_handle => $source->handle,
2757       -alias => $attrs->{alias},
2758       $attrs->{alias} => $source->from,
2759     }];
2760   }
2761
2762   my $jpath = ($seen->{-relation_chain_depth})
2763     ? $from->[-1][0]{-join_path}
2764     : [];
2765
2766   my @requested_joins = $source->_resolve_join(
2767     $join,
2768     $attrs->{alias},
2769     $seen,
2770     $jpath,
2771   );
2772
2773   push @$from, @requested_joins;
2774
2775   $seen->{-relation_chain_depth}++;
2776
2777   # if $self already had a join/prefetch specified on it, the requested
2778   # $rel might very well be already included. What we do in this case
2779   # is effectively a no-op (except that we bump up the chain_depth on
2780   # the join in question so we could tell it *is* the search_related)
2781   my $already_joined;
2782
2783   # we consider the last one thus reverse
2784   for my $j (reverse @requested_joins) {
2785     my ($last_j) = keys %{$j->[0]{-join_path}[-1]};
2786     if ($rel eq $last_j) {
2787       $j->[0]{-relation_chain_depth}++;
2788       $already_joined++;
2789       last;
2790     }
2791   }
2792
2793   unless ($already_joined) {
2794     push @$from, $source->_resolve_join(
2795       $rel,
2796       $attrs->{alias},
2797       $seen,
2798       $jpath,
2799     );
2800   }
2801
2802   $seen->{-relation_chain_depth}++;
2803
2804   return {%$attrs, from => $from, seen_join => $seen};
2805 }
2806
2807 # too many times we have to do $attrs = { %{$self->_resolved_attrs} }
2808 sub _resolved_attrs_copy {
2809   my $self = shift;
2810   return { %{$self->_resolved_attrs (@_)} };
2811 }
2812
2813 sub _resolved_attrs {
2814   my $self = shift;
2815   return $self->{_attrs} if $self->{_attrs};
2816
2817   my $attrs  = { %{ $self->{attrs} || {} } };
2818   my $source = $self->result_source;
2819   my $alias  = $attrs->{alias};
2820
2821   $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols};
2822   my @colbits;
2823
2824   # build columns (as long as select isn't set) into a set of as/select hashes
2825   unless ( $attrs->{select} ) {
2826
2827     my @cols;
2828     if ( ref $attrs->{columns} eq 'ARRAY' ) {
2829       @cols = @{ delete $attrs->{columns}}
2830     } elsif ( defined $attrs->{columns} ) {
2831       @cols = delete $attrs->{columns}
2832     } else {
2833       @cols = $source->columns
2834     }
2835
2836     for (@cols) {
2837       if ( ref $_ eq 'HASH' ) {
2838         push @colbits, $_
2839       } else {
2840         my $key = /^\Q${alias}.\E(.+)$/
2841           ? "$1"
2842           : "$_";
2843         my $value = /\./
2844           ? "$_"
2845           : "${alias}.$_";
2846         push @colbits, { $key => $value };
2847       }
2848     }
2849   }
2850
2851   # add the additional columns on
2852   foreach (qw{include_columns +columns}) {
2853     if ( $attrs->{$_} ) {
2854       my @list = ( ref($attrs->{$_}) eq 'ARRAY' )
2855         ? @{ delete $attrs->{$_} }
2856         : delete $attrs->{$_};
2857       for (@list) {
2858         if ( ref($_) eq 'HASH' ) {
2859           push @colbits, $_
2860         } else {
2861           my $key = ( split /\./, $_ )[-1];
2862           my $value = ( /\./ ? $_ : "$alias.$_" );
2863           push @colbits, { $key => $value };
2864         }
2865       }
2866     }
2867   }
2868
2869   # start with initial select items
2870   if ( $attrs->{select} ) {
2871     $attrs->{select} =
2872         ( ref $attrs->{select} eq 'ARRAY' )
2873       ? [ @{ $attrs->{select} } ]
2874       : [ $attrs->{select} ];
2875
2876     if ( $attrs->{as} ) {
2877       $attrs->{as} =
2878         (
2879           ref $attrs->{as} eq 'ARRAY'
2880             ? [ @{ $attrs->{as} } ]
2881             : [ $attrs->{as} ]
2882         )
2883     } else {
2884       $attrs->{as} = [ map {
2885          m/^\Q${alias}.\E(.+)$/
2886            ? $1
2887            : $_
2888          } @{ $attrs->{select} }
2889       ]
2890     }
2891   }
2892   else {
2893
2894     # otherwise we intialise select & as to empty
2895     $attrs->{select} = [];
2896     $attrs->{as}     = [];
2897   }
2898
2899   # now add colbits to select/as
2900   push @{ $attrs->{select} }, map values %{$_}, @colbits;
2901   push @{ $attrs->{as}     }, map keys   %{$_}, @colbits;
2902
2903   if ( my $adds = delete $attrs->{'+select'} ) {
2904     $adds = [$adds] unless ref $adds eq 'ARRAY';
2905     push @{ $attrs->{select} },
2906       map { /\./ || ref $_ ? $_ : "$alias.$_" } @$adds;
2907   }
2908   if ( my $adds = delete $attrs->{'+as'} ) {
2909     $adds = [$adds] unless ref $adds eq 'ARRAY';
2910     push @{ $attrs->{as} }, @$adds;
2911   }
2912
2913   $attrs->{from} ||= [{
2914     -source_handle => $source->handle,
2915     -alias => $self->{attrs}{alias},
2916     $self->{attrs}{alias} => $source->from,
2917   }];
2918
2919   if ( $attrs->{join} || $attrs->{prefetch} ) {
2920
2921     $self->throw_exception ('join/prefetch can not be used with a custom {from}')
2922       if ref $attrs->{from} ne 'ARRAY';
2923
2924     my $join = delete $attrs->{join} || {};
2925
2926     if ( defined $attrs->{prefetch} ) {
2927       $join = $self->_merge_attr( $join, $attrs->{prefetch} );
2928     }
2929
2930     $attrs->{from} =    # have to copy here to avoid corrupting the original
2931       [
2932         @{ $attrs->{from} },
2933         $source->_resolve_join(
2934           $join,
2935           $alias,
2936           { %{ $attrs->{seen_join} || {} } },
2937           ( $attrs->{seen_join} && keys %{$attrs->{seen_join}})
2938             ? $attrs->{from}[-1][0]{-join_path}
2939             : []
2940           ,
2941         )
2942       ];
2943   }
2944
2945   if ( defined $attrs->{order_by} ) {
2946     $attrs->{order_by} = (
2947       ref( $attrs->{order_by} ) eq 'ARRAY'
2948       ? [ @{ $attrs->{order_by} } ]
2949       : [ $attrs->{order_by} || () ]
2950     );
2951   }
2952
2953   if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') {
2954     $attrs->{group_by} = [ $attrs->{group_by} ];
2955   }
2956
2957   # generate the distinct induced group_by early, as prefetch will be carried via a
2958   # subquery (since a group_by is present)
2959   if (delete $attrs->{distinct}) {
2960     if ($attrs->{group_by}) {
2961       carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
2962     }
2963     else {
2964       $attrs->{group_by} = [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ];
2965
2966       # add any order_by parts that are not already present in the group_by
2967       # we need to be careful not to add any named functions/aggregates
2968       # i.e. select => [ ... { count => 'foo', -as 'foocount' } ... ]
2969       my %already_grouped = map { $_ => 1 } (@{$attrs->{group_by}});
2970
2971       my $storage = $self->result_source->schema->storage;
2972
2973       my $rs_column_list = $storage->_resolve_column_info ($attrs->{from});
2974
2975       for my $chunk ($storage->_parse_order_by($attrs->{order_by})) {
2976         if ($rs_column_list->{$chunk} && not $already_grouped{$chunk}++) {
2977           push @{$attrs->{group_by}}, $chunk;
2978         }
2979       }
2980     }
2981   }
2982
2983   $attrs->{collapse} ||= {};
2984   if ( my $prefetch = delete $attrs->{prefetch} ) {
2985     $prefetch = $self->_merge_attr( {}, $prefetch );
2986
2987     my $prefetch_ordering = [];
2988
2989     # this is a separate structure (we don't look in {from} directly)
2990     # as the resolver needs to shift things off the lists to work
2991     # properly (identical-prefetches on different branches)
2992     my $join_map = {};
2993     if (ref $attrs->{from} eq 'ARRAY') {
2994
2995       my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0;
2996
2997       for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
2998         next unless $j->[0]{-alias};
2999         next unless $j->[0]{-join_path};
3000         next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth;
3001
3002         my @jpath = map { keys %$_ } @{$j->[0]{-join_path}};
3003
3004         my $p = $join_map;
3005         $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries
3006         push @{$p->{-join_aliases} }, $j->[0]{-alias};
3007       }
3008     }
3009
3010     my @prefetch =
3011       $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
3012
3013     # we need to somehow mark which columns came from prefetch
3014     $attrs->{_prefetch_select} = [ map { $_->[0] } @prefetch ];
3015
3016     push @{ $attrs->{select} }, @{$attrs->{_prefetch_select}};
3017     push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
3018
3019     push( @{$attrs->{order_by}}, @$prefetch_ordering );
3020     $attrs->{_collapse_order_by} = \@$prefetch_ordering;
3021   }
3022
3023   # if both page and offset are specified, produce a combined offset
3024   # even though it doesn't make much sense, this is what pre 081xx has
3025   # been doing
3026   if (my $page = delete $attrs->{page}) {
3027     $attrs->{offset} =
3028       ($attrs->{rows} * ($page - 1))
3029             +
3030       ($attrs->{offset} || 0)
3031     ;
3032   }
3033
3034   return $self->{_attrs} = $attrs;
3035 }
3036
3037 sub _rollout_attr {
3038   my ($self, $attr) = @_;
3039
3040   if (ref $attr eq 'HASH') {
3041     return $self->_rollout_hash($attr);
3042   } elsif (ref $attr eq 'ARRAY') {
3043     return $self->_rollout_array($attr);
3044   } else {
3045     return [$attr];
3046   }
3047 }
3048
3049 sub _rollout_array {
3050   my ($self, $attr) = @_;
3051
3052   my @rolled_array;
3053   foreach my $element (@{$attr}) {
3054     if (ref $element eq 'HASH') {
3055       push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
3056     } elsif (ref $element eq 'ARRAY') {
3057       #  XXX - should probably recurse here
3058       push( @rolled_array, @{$self->_rollout_array($element)} );
3059     } else {
3060       push( @rolled_array, $element );
3061     }
3062   }
3063   return \@rolled_array;
3064 }
3065
3066 sub _rollout_hash {
3067   my ($self, $attr) = @_;
3068
3069   my @rolled_array;
3070   foreach my $key (keys %{$attr}) {
3071     push( @rolled_array, { $key => $attr->{$key} } );
3072   }
3073   return \@rolled_array;
3074 }
3075
3076 sub _calculate_score {
3077   my ($self, $a, $b) = @_;
3078
3079   if (defined $a xor defined $b) {
3080     return 0;
3081   }
3082   elsif (not defined $a) {
3083     return 1;
3084   }
3085
3086   if (ref $b eq 'HASH') {
3087     my ($b_key) = keys %{$b};
3088     if (ref $a eq 'HASH') {
3089       my ($a_key) = keys %{$a};
3090       if ($a_key eq $b_key) {
3091         return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
3092       } else {
3093         return 0;
3094       }
3095     } else {
3096       return ($a eq $b_key) ? 1 : 0;
3097     }
3098   } else {
3099     if (ref $a eq 'HASH') {
3100       my ($a_key) = keys %{$a};
3101       return ($b eq $a_key) ? 1 : 0;
3102     } else {
3103       return ($b eq $a) ? 1 : 0;
3104     }
3105   }
3106 }
3107
3108 sub _merge_attr {
3109   my ($self, $orig, $import) = @_;
3110
3111   return $import unless defined($orig);
3112   return $orig unless defined($import);
3113
3114   $orig = $self->_rollout_attr($orig);
3115   $import = $self->_rollout_attr($import);
3116
3117   my $seen_keys;
3118   foreach my $import_element ( @{$import} ) {
3119     # find best candidate from $orig to merge $b_element into
3120     my $best_candidate = { position => undef, score => 0 }; my $position = 0;
3121     foreach my $orig_element ( @{$orig} ) {
3122       my $score = $self->_calculate_score( $orig_element, $import_element );
3123       if ($score > $best_candidate->{score}) {
3124         $best_candidate->{position} = $position;
3125         $best_candidate->{score} = $score;
3126       }
3127       $position++;
3128     }
3129     my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
3130
3131     if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
3132       push( @{$orig}, $import_element );
3133     } else {
3134       my $orig_best = $orig->[$best_candidate->{position}];
3135       # merge orig_best and b_element together and replace original with merged
3136       if (ref $orig_best ne 'HASH') {
3137         $orig->[$best_candidate->{position}] = $import_element;
3138       } elsif (ref $import_element eq 'HASH') {
3139         my ($key) = keys %{$orig_best};
3140         $orig->[$best_candidate->{position}] = { $key => $self->_merge_attr($orig_best->{$key}, $import_element->{$key}) };
3141       }
3142     }
3143     $seen_keys->{$import_key} = 1; # don't merge the same key twice
3144   }
3145
3146   return $orig;
3147 }
3148
3149 sub result_source {
3150     my $self = shift;
3151
3152     if (@_) {
3153         $self->_source_handle($_[0]->handle);
3154     } else {
3155         $self->_source_handle->resolve;
3156     }
3157 }
3158
3159 =head2 throw_exception
3160
3161 See L<DBIx::Class::Schema/throw_exception> for details.
3162
3163 =cut
3164
3165 sub throw_exception {
3166   my $self=shift;
3167
3168   if (ref $self && $self->_source_handle->schema) {
3169     $self->_source_handle->schema->throw_exception(@_)
3170   }
3171   else {
3172     DBIx::Class::Exception->throw(@_);
3173   }
3174 }
3175
3176 # XXX: FIXME: Attributes docs need clearing up
3177
3178 =head1 ATTRIBUTES
3179
3180 Attributes are used to refine a ResultSet in various ways when
3181 searching for data. They can be passed to any method which takes an
3182 C<\%attrs> argument. See L</search>, L</search_rs>, L</find>,
3183 L</count>.
3184
3185 These are in no particular order:
3186
3187 =head2 order_by
3188
3189 =over 4
3190
3191 =item Value: ( $order_by | \@order_by | \%order_by )
3192
3193 =back
3194
3195 Which column(s) to order the results by.
3196
3197 [The full list of suitable values is documented in
3198 L<SQL::Abstract/"ORDER BY CLAUSES">; the following is a summary of
3199 common options.]
3200
3201 If a single column name, or an arrayref of names is supplied, the
3202 argument is passed through directly to SQL. The hashref syntax allows
3203 for connection-agnostic specification of ordering direction:
3204
3205  For descending order:
3206
3207   order_by => { -desc => [qw/col1 col2 col3/] }
3208
3209  For explicit ascending order:
3210
3211   order_by => { -asc => 'col' }
3212
3213 The old scalarref syntax (i.e. order_by => \'year DESC') is still
3214 supported, although you are strongly encouraged to use the hashref
3215 syntax as outlined above.
3216
3217 =head2 columns
3218
3219 =over 4
3220
3221 =item Value: \@columns
3222
3223 =back
3224
3225 Shortcut to request a particular set of columns to be retrieved. Each
3226 column spec may be a string (a table column name), or a hash (in which
3227 case the key is the C<as> value, and the value is used as the C<select>
3228 expression). Adds C<me.> onto the start of any column without a C<.> in
3229 it and sets C<select> from that, then auto-populates C<as> from
3230 C<select> as normal. (You may also use the C<cols> attribute, as in
3231 earlier versions of DBIC.)
3232
3233 =head2 +columns
3234
3235 =over 4
3236
3237 =item Value: \@columns
3238
3239 =back
3240
3241 Indicates additional columns to be selected from storage. Works the same
3242 as L</columns> but adds columns to the selection. (You may also use the
3243 C<include_columns> attribute, as in earlier versions of DBIC). For
3244 example:-
3245
3246   $schema->resultset('CD')->search(undef, {
3247     '+columns' => ['artist.name'],
3248     join => ['artist']
3249   });
3250
3251 would return all CDs and include a 'name' column to the information
3252 passed to object inflation. Note that the 'artist' is the name of the
3253 column (or relationship) accessor, and 'name' is the name of the column
3254 accessor in the related table.
3255
3256 =head2 include_columns
3257
3258 =over 4
3259
3260 =item Value: \@columns
3261
3262 =back
3263
3264 Deprecated.  Acts as a synonym for L</+columns> for backward compatibility.
3265
3266 =head2 select
3267
3268 =over 4
3269
3270 =item Value: \@select_columns
3271
3272 =back
3273
3274 Indicates which columns should be selected from the storage. You can use
3275 column names, or in the case of RDBMS back ends, function or stored procedure
3276 names:
3277
3278   $rs = $schema->resultset('Employee')->search(undef, {
3279     select => [
3280       'name',
3281       { count => 'employeeid' },
3282       { max => { length => 'name' }, -as => 'longest_name' }
3283     ]
3284   });
3285
3286   # Equivalent SQL
3287   SELECT name, COUNT( employeeid ), MAX( LENGTH( name ) ) AS longest_name FROM employee
3288
3289 B<NOTE:> You will almost always need a corresponding L</as> attribute when you
3290 use L</select>, to instruct DBIx::Class how to store the result of the column.
3291 Also note that the L</as> attribute has nothing to do with the SQL-side 'AS'
3292 identifier aliasing. You can however alias a function, so you can use it in
3293 e.g. an C<ORDER BY> clause. This is done via the C<-as> B<select function
3294 attribute> supplied as shown in the example above.
3295
3296 =head2 +select
3297
3298 =over 4
3299
3300 Indicates additional columns to be selected from storage.  Works the same as
3301 L</select> but adds columns to the default selection, instead of specifying
3302 an explicit list.
3303
3304 =back
3305
3306 =head2 +as
3307
3308 =over 4
3309
3310 Indicates additional column names for those added via L</+select>. See L</as>.
3311
3312 =back
3313
3314 =head2 as
3315
3316 =over 4
3317
3318 =item Value: \@inflation_names
3319
3320 =back
3321
3322 Indicates column names for object inflation. That is L</as> indicates the
3323 slot name in which the column value will be stored within the
3324 L<Row|DBIx::Class::Row> object. The value will then be accessible via this
3325 identifier by the C<get_column> method (or via the object accessor B<if one
3326 with the same name already exists>) as shown below. The L</as> attribute has
3327 B<nothing to do> with the SQL-side C<AS>. See L</select> for details.
3328
3329   $rs = $schema->resultset('Employee')->search(undef, {
3330     select => [
3331       'name',
3332       { count => 'employeeid' },
3333       { max => { length => 'name' }, -as => 'longest_name' }
3334     ],
3335     as => [qw/
3336       name
3337       employee_count
3338       max_name_length
3339     /],
3340   });
3341
3342 If the object against which the search is performed already has an accessor
3343 matching a column name specified in C<as>, the value can be retrieved using
3344 the accessor as normal:
3345
3346   my $name = $employee->name();
3347
3348 If on the other hand an accessor does not exist in the object, you need to
3349 use C<get_column> instead:
3350
3351   my $employee_count = $employee->get_column('employee_count');
3352
3353 You can create your own accessors if required - see
3354 L<DBIx::Class::Manual::Cookbook> for details.
3355
3356 =head2 join
3357
3358 =over 4
3359
3360 =item Value: ($rel_name | \@rel_names | \%rel_names)
3361
3362 =back
3363
3364 Contains a list of relationships that should be joined for this query.  For
3365 example:
3366
3367   # Get CDs by Nine Inch Nails
3368   my $rs = $schema->resultset('CD')->search(
3369     { 'artist.name' => 'Nine Inch Nails' },
3370     { join => 'artist' }
3371   );
3372
3373 Can also contain a hash reference to refer to the other relation's relations.
3374 For example:
3375
3376   package MyApp::Schema::Track;
3377   use base qw/DBIx::Class/;
3378   __PACKAGE__->table('track');
3379   __PACKAGE__->add_columns(qw/trackid cd position title/);
3380   __PACKAGE__->set_primary_key('trackid');
3381   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
3382   1;
3383
3384   # In your application
3385   my $rs = $schema->resultset('Artist')->search(
3386     { 'track.title' => 'Teardrop' },
3387     {
3388       join     => { cd => 'track' },
3389       order_by => 'artist.name',
3390     }
3391   );
3392
3393 You need to use the relationship (not the table) name in  conditions,
3394 because they are aliased as such. The current table is aliased as "me", so
3395 you need to use me.column_name in order to avoid ambiguity. For example:
3396
3397   # Get CDs from 1984 with a 'Foo' track
3398   my $rs = $schema->resultset('CD')->search(
3399     {
3400       'me.year' => 1984,
3401       'tracks.name' => 'Foo'
3402     },
3403     { join => 'tracks' }
3404   );
3405
3406 If the same join is supplied twice, it will be aliased to <rel>_2 (and
3407 similarly for a third time). For e.g.
3408
3409   my $rs = $schema->resultset('Artist')->search({
3410     'cds.title'   => 'Down to Earth',
3411     'cds_2.title' => 'Popular',
3412   }, {
3413     join => [ qw/cds cds/ ],
3414   });
3415
3416 will return a set of all artists that have both a cd with title 'Down
3417 to Earth' and a cd with title 'Popular'.
3418
3419 If you want to fetch related objects from other tables as well, see C<prefetch>
3420 below.
3421
3422 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
3423
3424 =head2 prefetch
3425
3426 =over 4
3427
3428 =item Value: ($rel_name | \@rel_names | \%rel_names)
3429
3430 =back
3431
3432 Contains one or more relationships that should be fetched along with
3433 the main query (when they are accessed afterwards the data will
3434 already be available, without extra queries to the database).  This is
3435 useful for when you know you will need the related objects, because it
3436 saves at least one query:
3437
3438   my $rs = $schema->resultset('Tag')->search(
3439     undef,
3440     {
3441       prefetch => {
3442         cd => 'artist'
3443       }
3444     }
3445   );
3446
3447 The initial search results in SQL like the following:
3448
3449   SELECT tag.*, cd.*, artist.* FROM tag
3450   JOIN cd ON tag.cd = cd.cdid
3451   JOIN artist ON cd.artist = artist.artistid
3452
3453 L<DBIx::Class> has no need to go back to the database when we access the
3454 C<cd> or C<artist> relationships, which saves us two SQL statements in this
3455 case.
3456
3457 Simple prefetches will be joined automatically, so there is no need
3458 for a C<join> attribute in the above search.
3459
3460 C<prefetch> can be used with the following relationship types: C<belongs_to>,
3461 C<has_one> (or if you're using C<add_relationship>, any relationship declared
3462 with an accessor type of 'single' or 'filter'). A more complex example that
3463 prefetches an artists cds, the tracks on those cds, and the tags associated
3464 with that artist is given below (assuming many-to-many from artists to tags):
3465
3466  my $rs = $schema->resultset('Artist')->search(
3467    undef,
3468    {
3469      prefetch => [
3470        { cds => 'tracks' },
3471        { artist_tags => 'tags' }
3472      ]
3473    }
3474  );
3475
3476
3477 B<NOTE:> If you specify a C<prefetch> attribute, the C<join> and C<select>
3478 attributes will be ignored.
3479
3480 B<CAVEATs>: Prefetch does a lot of deep magic. As such, it may not behave
3481 exactly as you might expect.
3482
3483 =over 4
3484
3485 =item *
3486
3487 Prefetch uses the L</cache> to populate the prefetched relationships. This
3488 may or may not be what you want.
3489
3490 =item *
3491
3492 If you specify a condition on a prefetched relationship, ONLY those
3493 rows that match the prefetched condition will be fetched into that relationship.
3494 This means that adding prefetch to a search() B<may alter> what is returned by
3495 traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
3496
3497   my $artist_rs = $schema->resultset('Artist')->search({
3498       'cds.year' => 2008,
3499   }, {
3500       join => 'cds',
3501   });
3502
3503   my $count = $artist_rs->first->cds->count;
3504
3505   my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
3506
3507   my $prefetch_count = $artist_rs_prefetch->first->cds->count;
3508
3509   cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
3510
3511 that cmp_ok() may or may not pass depending on the datasets involved. This
3512 behavior may or may not survive the 0.09 transition.
3513
3514 =back
3515
3516 =head2 page
3517
3518 =over 4
3519
3520 =item Value: $page
3521
3522 =back
3523
3524 Makes the resultset paged and specifies the page to retrieve. Effectively
3525 identical to creating a non-pages resultset and then calling ->page($page)
3526 on it.
3527
3528 If L<rows> attribute is not specified it defaults to 10 rows per page.
3529
3530 When you have a paged resultset, L</count> will only return the number
3531 of rows in the page. To get the total, use the L</pager> and call
3532 C<total_entries> on it.
3533
3534 =head2 rows
3535
3536 =over 4
3537
3538 =item Value: $rows
3539
3540 =back
3541
3542 Specifies the maximum number of rows for direct retrieval or the number of
3543 rows per page if the page attribute or method is used.
3544
3545 =head2 offset
3546
3547 =over 4
3548
3549 =item Value: $offset
3550
3551 =back
3552
3553 Specifies the (zero-based) row number for the  first row to be returned, or the
3554 of the first row of the first page if paging is used.
3555
3556 =head2 group_by
3557
3558 =over 4
3559
3560 =item Value: \@columns
3561
3562 =back
3563
3564 A arrayref of columns to group by. Can include columns of joined tables.
3565
3566   group_by => [qw/ column1 column2 ... /]
3567
3568 =head2 having
3569
3570 =over 4
3571
3572 =item Value: $condition
3573
3574 =back
3575
3576 HAVING is a select statement attribute that is applied between GROUP BY and
3577 ORDER BY. It is applied to the after the grouping calculations have been
3578 done.
3579
3580   having => { 'count(employee)' => { '>=', 100 } }
3581
3582 =head2 distinct
3583
3584 =over 4
3585
3586 =item Value: (0 | 1)
3587
3588 =back
3589
3590 Set to 1 to group by all columns. If the resultset already has a group_by
3591 attribute, this setting is ignored and an appropriate warning is issued.
3592
3593 =head2 where
3594
3595 =over 4
3596
3597 Adds to the WHERE clause.
3598
3599   # only return rows WHERE deleted IS NULL for all searches
3600   __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
3601
3602 Can be overridden by passing C<< { where => undef } >> as an attribute
3603 to a resultset.
3604
3605 =back
3606
3607 =head2 cache
3608
3609 Set to 1 to cache search results. This prevents extra SQL queries if you
3610 revisit rows in your ResultSet:
3611
3612   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
3613
3614   while( my $artist = $resultset->next ) {
3615     ... do stuff ...
3616   }
3617
3618   $rs->first; # without cache, this would issue a query
3619
3620 By default, searches are not cached.
3621
3622 For more examples of using these attributes, see
3623 L<DBIx::Class::Manual::Cookbook>.
3624
3625 =head2 for
3626
3627 =over 4
3628
3629 =item Value: ( 'update' | 'shared' )
3630
3631 =back
3632
3633 Set to 'update' for a SELECT ... FOR UPDATE or 'shared' for a SELECT
3634 ... FOR SHARED.
3635
3636 =cut
3637
3638 1;