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