lib/DBIx/Class/ResultSet.pm

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