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