lib/DBIx/Class/ResultSet.pm

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