lib/DBIx/Class/ResultSet.pm

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