lib/DBIx/Class/ResultSet.pm

   1 package DBIx::Class::ResultSet;
   2
   3 use strict;
   4 use warnings;
   5 use overload
   6         '0+'     => "count",
   7         'bool'   => "_bool",
   8         fallback => 1;
   9 use Carp::Clan qw/^DBIx::Class/;
  10 use DBIx::Class::Exception;
  11 use Data::Page;
  12 use Storable;
  13 use DBIx::Class::ResultSetColumn;
  14 use DBIx::Class::ResultSourceHandle;
  15 use List::Util ();
  16 use Scalar::Util ();
  17 use base qw/DBIx::Class/;
  18
  19 __PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/);
  20
  21 =head1 NAME
  22
  23 DBIx::Class::ResultSet - Represents a query used for fetching a set of results.
  24
  25 =head1 SYNOPSIS
  26
  27   my $users_rs   = $schema->resultset('User');
  28   my $registered_users_rs   = $schema->resultset('User')->search({ registered => 1 });
  29   my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all();
  30
  31 =head1 DESCRIPTION
  32
  33 A ResultSet is an object which stores a set of conditions representing
  34 a query. It is the backbone of DBIx::Class (i.e. the really
  35 important/useful bit).
  36
  37 No SQL is executed on the database when a ResultSet is created, it
  38 just stores all the conditions needed to create the query.
  39
  40 A basic ResultSet representing the data of an entire table is returned
  41 by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
  42 L<Source|DBIx::Class::Manual::Glossary/Source> name.
  43
  44   my $users_rs = $schema->resultset('User');
  45
  46 A new ResultSet is returned from calling L</search> on an existing
  47 ResultSet. The new one will contain all the conditions of the
  48 original, plus any new conditions added in the C<search> call.
  49
  50 A ResultSet also incorporates an implicit iterator. L</next> and L</reset>
  51 can be used to walk through all the L<DBIx::Class::Row>s the ResultSet
  52 represents.
  53
  54 The query that the ResultSet represents is B<only> executed against
  55 the database when these methods are called:
  56 L</find> L</next> L</all> L</first> L</single> L</count>
  57
  58 =head1 EXAMPLES
  59
  60 =head2 Chaining resultsets
  61
  62 Let's say you've got a query that needs to be run to return some data
  63 to the user. But, you have an authorization system in place that
  64 prevents certain users from seeing certain information. So, you want
  65 to construct the basic query in one method, but add constraints to it in
  66 another.
  67
  68   sub get_data {
  69     my $self = shift;
  70     my $request = $self->get_request; # Get a request object somehow.
  71     my $schema = $self->get_schema;   # Get the DBIC schema object somehow.
  72
  73     my $cd_rs = $schema->resultset('CD')->search({
  74       title => $request->param('title'),
  75       year => $request->param('year'),
  76     });
  77
  78     $self->apply_security_policy( $cd_rs );
  79
  80     return $cd_rs->all();
  81   }
  82
  83   sub apply_security_policy {
  84     my $self = shift;
  85     my ($rs) = @_;
  86
  87     return $rs->search({
  88       subversive => 0,
  89     });
  90   }
  91
  92 =head3 Resolving conditions and attributes
  93
  94 When a resultset is chained from another resultset, conditions and
  95 attributes with the same keys need resolving.
  96
  97 L</join>, L</prefetch>, L</+select>, L</+as> attributes are merged
  98 into the existing ones from the original resultset.
  99
 100 The L</where>, L</having> attribute, and any search conditions are
 101 merged with an SQL C<AND> to the existing condition from the original
 102 resultset.
 103
 104 All other attributes are overridden by any new ones supplied in the
 105 search attributes.
 106
 107 =head2 Multiple queries
 108
 109 Since a resultset just defines a query, you can do all sorts of
 110 things with it with the same object.
 111
 112   # Don't hit the DB yet.
 113   my $cd_rs = $schema->resultset('CD')->search({
 114     title => 'something',
 115     year => 2009,
 116   });
 117
 118   # Each of these hits the DB individually.
 119   my $count = $cd_rs->count;
 120   my $most_recent = $cd_rs->get_column('date_released')->max();
 121   my @records = $cd_rs->all;
 122
 123 And it's not just limited to SELECT statements.
 124
 125   $cd_rs->delete();
 126
 127 This is even cooler:
 128
 129   $cd_rs->create({ artist => 'Fred' });
 130
 131 Which is the same as:
 132
 133   $schema->resultset('CD')->create({
 134     title => 'something',
 135     year => 2009,
 136     artist => 'Fred'
 137   });
 138
 139 See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
 140
 141 =head1 OVERLOADING
 142
 143 If a resultset is used in a numeric context it returns the L</count>.
 144 However, if it is used in a booleand context it is always true.  So if
 145 you want to check if a resultset has any results use C<if $rs != 0>.
 146 C<if $rs> will always be true.
 147
 148 =head1 METHODS
 149
 150 =head2 new
 151
 152 =over 4
 153
 154 =item Arguments: $source, \%$attrs
 155
 156 =item Return Value: $rs
 157
 158 =back
 159
 160 The resultset constructor. Takes a source object (usually a
 161 L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
 162 L</ATTRIBUTES> below).  Does not perform any queries -- these are
 163 executed as needed by the other methods.
 164
 165 Generally you won't need to construct a resultset manually.  You'll
 166 automatically get one from e.g. a L</search> called in scalar context:
 167
 168   my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
 169
 170 IMPORTANT: If called on an object, proxies to new_result instead so
 171
 172   my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
 173
 174 will return a CD object, not a ResultSet.
 175
 176 =cut
 177
 178 sub new {
 179   my $class = shift;
 180   return $class->new_result(@_) if ref $class;
 181
 182   my ($source, $attrs) = @_;
 183   $source = $source->handle
 184     unless $source->isa('DBIx::Class::ResultSourceHandle');
 185   $attrs = { %{$attrs||{}} };
 186
 187   if ($attrs->{page}) {
 188     $attrs->{rows} ||= 10;
 189   }
 190
 191   $attrs->{alias} ||= 'me';
 192
 193   # Creation of {} and bless separated to mitigate RH perl bug
 194   # see https://bugzilla.redhat.com/show_bug.cgi?id=196836
 195   my $self = {
 196     _source_handle => $source,
 197     cond => $attrs->{where},
 198     count => undef,
 199     pager => undef,
 200     attrs => $attrs
 201   };
 202
 203   bless $self, $class;
 204
 205   $self->result_class(
 206     $attrs->{result_class} || $source->resolve->result_class
 207   );
 208
 209   return $self;
 210 }
 211
 212 =head2 search
 213
 214 =over 4
 215
 216 =item Arguments: $cond, \%attrs?
 217
 218 =item Return Value: $resultset (scalar context), @row_objs (list context)
 219
 220 =back
 221
 222   my @cds    = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
 223   my $new_rs = $cd_rs->search({ year => 2005 });
 224
 225   my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
 226                  # year = 2005 OR year = 2004
 227
 228 If you need to pass in additional attributes but no additional condition,
 229 call it as C<search(undef, \%attrs)>.
 230
 231   # "SELECT name, artistid FROM $artist_table"
 232   my @all_artists = $schema->resultset('Artist')->search(undef, {
 233     columns => [qw/name artistid/],
 234   });
 235
 236 For a list of attributes that can be passed to C<search>, see
 237 L</ATTRIBUTES>. For more examples of using this function, see
 238 L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
 239 documentation for the first argument, see L<SQL::Abstract>.
 240
 241 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
 242
 243 =cut
 244
 245 sub search {
 246   my $self = shift;
 247   my $rs = $self->search_rs( @_ );
 248   return (wantarray ? $rs->all : $rs);
 249 }
 250
 251 =head2 search_rs
 252
 253 =over 4
 254
 255 =item Arguments: $cond, \%attrs?
 256
 257 =item Return Value: $resultset
 258
 259 =back
 260
 261 This method does the same exact thing as search() except it will
 262 always return a resultset, even in list context.
 263
 264 =cut
 265
 266 sub search_rs {
 267   my $self = shift;
 268
 269   # Special-case handling for (undef, undef).
 270   if ( @_ == 2 && !defined $_[1] && !defined $_[0] ) {
 271     pop(@_); pop(@_);
 272   }
 273
 274   my $attrs = {};
 275   $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
 276   my $our_attrs = { %{$self->{attrs}} };
 277   my $having = delete $our_attrs->{having};
 278   my $where = delete $our_attrs->{where};
 279
 280   my $rows;
 281
 282   my %safe = (alias => 1, cache => 1);
 283
 284   unless (
 285     (@_ && defined($_[0])) # @_ == () or (undef)
 286     ||
 287     (keys %$attrs # empty attrs or only 'safe' attrs
 288     && List::Util::first { !$safe{$_} } keys %$attrs)
 289   ) {
 290     # no search, effectively just a clone
 291     $rows = $self->get_cache;
 292   }
 293
 294   my $new_attrs = { %{$our_attrs}, %{$attrs} };
 295
 296   # merge new attrs into inherited
 297   foreach my $key (qw/join prefetch +select +as bind/) {
 298     next unless exists $attrs->{$key};
 299     $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
 300   }
 301
 302   if (List::Util::first { exists $new_attrs->{$_} } qw{select as}) {
 303      delete $new_attrs->{$_} for (qw{+select +as});
 304   }
 305
 306   if (exists $new_attrs->{columns}) {
 307      delete $new_attrs->{'+columns'};
 308   }
 309
 310   my $cond = (@_
 311     ? (
 312         (@_ == 1 || ref $_[0] eq "HASH")
 313           ? (
 314               (ref $_[0] eq 'HASH')
 315                 ? (
 316                     (keys %{ $_[0] }  > 0)
 317                       ? shift
 318                       : undef
 319                    )
 320                 :  shift
 321              )
 322           : (
 323               (@_ % 2)
 324                 ? $self->throw_exception("Odd number of arguments to search")
 325                 : {@_}
 326              )
 327       )
 328     : undef
 329   );
 330
 331   if (defined $where) {
 332     $new_attrs->{where} = (
 333       defined $new_attrs->{where}
 334         ? { '-and' => [
 335               map {
 336                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
 337               } $where, $new_attrs->{where}
 338             ]
 339           }
 340         : $where);
 341   }
 342
 343   if (defined $cond) {
 344     $new_attrs->{where} = (
 345       defined $new_attrs->{where}
 346         ? { '-and' => [
 347               map {
 348                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
 349               } $cond, $new_attrs->{where}
 350             ]
 351           }
 352         : $cond);
 353   }
 354
 355   if (defined $having) {
 356     $new_attrs->{having} = (
 357       defined $new_attrs->{having}
 358         ? { '-and' => [
 359               map {
 360                 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
 361               } $having, $new_attrs->{having}
 362             ]
 363           }
 364         : $having);
 365   }
 366
 367   my $rs = (ref $self)->new($self->result_source, $new_attrs);
 368
 369   $rs->set_cache($rows) if ($rows);
 370
 371   return $rs;
 372 }
 373
 374 =head2 search_literal
 375
 376 =over 4
 377
 378 =item Arguments: $sql_fragment, @bind_values
 379
 380 =item Return Value: $resultset (scalar context), @row_objs (list context)
 381
 382 =back
 383
 384   my @cds   = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
 385   my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
 386
 387 Pass a literal chunk of SQL to be added to the conditional part of the
 388 resultset query.
 389
 390 CAVEAT: C<search_literal> is provided for Class::DBI compatibility and should
 391 only be used in that context. C<search_literal> is a convenience method.
 392 It is equivalent to calling $schema->search(\[]), but if you want to ensure
 393 columns are bound correctly, use C<search>.
 394
 395 Example of how to use C<search> instead of C<search_literal>
 396
 397   my @cds = $cd_rs->search_literal('cdid = ? AND (artist = ? OR artist = ?)', (2, 1, 2));
 398   my @cds = $cd_rs->search(\[ 'cdid = ? AND (artist = ? OR artist = ?)', [ 'cdid', 2 ], [ 'artist', 1 ], [ 'artist', 2 ] ]);
 399
 400
 401 See L<DBIx::Class::Manual::Cookbook/Searching> and
 402 L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
 403 require C<search_literal>.
 404
 405 =cut
 406
 407 sub search_literal {
 408   my ($self, $sql, @bind) = @_;
 409   my $attr;
 410   if ( @bind && ref($bind[-1]) eq 'HASH' ) {
 411     $attr = pop @bind;
 412   }
 413   return $self->search(\[ $sql, map [ __DUMMY__ => $_ ], @bind ], ($attr || () ));
 414 }
 415
 416 =head2 find
 417
 418 =over 4
 419
 420 =item Arguments: @values | \%cols, \%attrs?
 421
 422 =item Return Value: $row_object | undef
 423
 424 =back
 425
 426 Finds a row based on its primary key or unique constraint. For example, to find
 427 a row by its primary key:
 428
 429   my $cd = $schema->resultset('CD')->find(5);
 430
 431 You can also find a row by a specific unique constraint using the C<key>
 432 attribute. For example:
 433
 434   my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', {
 435     key => 'cd_artist_title'
 436   });
 437
 438 Additionally, you can specify the columns explicitly by name:
 439
 440   my $cd = $schema->resultset('CD')->find(
 441     {
 442       artist => 'Massive Attack',
 443       title  => 'Mezzanine',
 444     },
 445     { key => 'cd_artist_title' }
 446   );
 447
 448 If the C<key> is specified as C<primary>, it searches only on the primary key.
 449
 450 If no C<key> is specified, it searches on all unique constraints defined on the
 451 source for which column data is provided, including the primary key.
 452
 453 If your table does not have a primary key, you B<must> provide a value for the
 454 C<key> attribute matching one of the unique constraints on the source.
 455
 456 In addition to C<key>, L</find> recognizes and applies standard
 457 L<resultset attributes|/ATTRIBUTES> in the same way as L</search> does.
 458
 459 Note: If your query does not return only one row, a warning is generated:
 460
 461   Query returned more than one row
 462
 463 See also L</find_or_create> and L</update_or_create>. For information on how to
 464 declare unique constraints, see
 465 L<DBIx::Class::ResultSource/add_unique_constraint>.
 466
 467 =cut
 468
 469 sub find {
 470   my $self = shift;
 471   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 472
 473   # Default to the primary key, but allow a specific key
 474   my @cols = exists $attrs->{key}
 475     ? $self->result_source->unique_constraint_columns($attrs->{key})
 476     : $self->result_source->primary_columns;
 477   $self->throw_exception(
 478     "Can't find unless a primary key is defined or unique constraint is specified"
 479   ) unless @cols;
 480
 481   # Parse out a hashref from input
 482   my $input_query;
 483   if (ref $_[0] eq 'HASH') {
 484     $input_query = { %{$_[0]} };
 485   }
 486   elsif (@_ == @cols) {
 487     $input_query = {};
 488     @{$input_query}{@cols} = @_;
 489   }
 490   else {
 491     # Compatibility: Allow e.g. find(id => $value)
 492     carp "Find by key => value deprecated; please use a hashref instead";
 493     $input_query = {@_};
 494   }
 495
 496   my (%related, $info);
 497
 498   KEY: foreach my $key (keys %$input_query) {
 499     if (ref($input_query->{$key})
 500         && ($info = $self->result_source->relationship_info($key))) {
 501       my $val = delete $input_query->{$key};
 502       next KEY if (ref($val) eq 'ARRAY'); # has_many for multi_create
 503       my $rel_q = $self->result_source->_resolve_condition(
 504                     $info->{cond}, $val, $key
 505                   );
 506       die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY';
 507       @related{keys %$rel_q} = values %$rel_q;
 508     }
 509   }
 510   if (my @keys = keys %related) {
 511     @{$input_query}{@keys} = values %related;
 512   }
 513
 514
 515   # Build the final query: Default to the disjunction of the unique queries,
 516   # but allow the input query in case the ResultSet defines the query or the
 517   # user is abusing find
 518   my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
 519   my $query;
 520   if (exists $attrs->{key}) {
 521     my @unique_cols = $self->result_source->unique_constraint_columns($attrs->{key});
 522     my $unique_query = $self->_build_unique_query($input_query, \@unique_cols);
 523     $query = $self->_add_alias($unique_query, $alias);
 524   }
 525   elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') {
 526     # This means that we got here after a merger of relationship conditions
 527     # in ::Relationship::Base::search_related (the row method), and furthermore
 528     # the relationship is of the 'single' type. This means that the condition
 529     # provided by the relationship (already attached to $self) is sufficient,
 530     # as there can be only one row in the databse that would satisfy the
 531     # relationship
 532   }
 533   else {
 534     my @unique_queries = $self->_unique_queries($input_query, $attrs);
 535     $query = @unique_queries
 536       ? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
 537       : $self->_add_alias($input_query, $alias);
 538   }
 539
 540   # Run the query
 541   my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs});
 542   if (keys %{$rs->_resolved_attrs->{collapse}}) {
 543     my $row = $rs->next;
 544     carp "Query returned more than one row" if $rs->next;
 545     return $row;
 546   }
 547   else {
 548     return $rs->single;
 549   }
 550 }
 551
 552 # _add_alias
 553 #
 554 # Add the specified alias to the specified query hash. A copy is made so the
 555 # original query is not modified.
 556
 557 sub _add_alias {
 558   my ($self, $query, $alias) = @_;
 559
 560   my %aliased = %$query;
 561   foreach my $col (grep { ! m/\./ } keys %aliased) {
 562     $aliased{"$alias.$col"} = delete $aliased{$col};
 563   }
 564
 565   return \%aliased;
 566 }
 567
 568 # _unique_queries
 569 #
 570 # Build a list of queries which satisfy unique constraints.
 571
 572 sub _unique_queries {
 573   my ($self, $query, $attrs) = @_;
 574
 575   my @constraint_names = exists $attrs->{key}
 576     ? ($attrs->{key})
 577     : $self->result_source->unique_constraint_names;
 578
 579   my $where = $self->_collapse_cond($self->{attrs}{where} || {});
 580   my $num_where = scalar keys %$where;
 581
 582   my (@unique_queries, %seen_column_combinations);
 583   foreach my $name (@constraint_names) {
 584     my @constraint_cols = $self->result_source->unique_constraint_columns($name);
 585
 586     my $constraint_sig = join "\x00", sort @constraint_cols;
 587     next if $seen_column_combinations{$constraint_sig}++;
 588
 589     my $unique_query = $self->_build_unique_query($query, \@constraint_cols);
 590
 591     my $num_cols = scalar @constraint_cols;
 592     my $num_query = scalar keys %$unique_query;
 593
 594     my $total = $num_query + $num_where;
 595     if ($num_query && ($num_query == $num_cols || $total == $num_cols)) {
 596       # The query is either unique on its own or is unique in combination with
 597       # the existing where clause
 598       push @unique_queries, $unique_query;
 599     }
 600   }
 601
 602   return @unique_queries;
 603 }
 604
 605 # _build_unique_query
 606 #
 607 # Constrain the specified query hash based on the specified column names.
 608
 609 sub _build_unique_query {
 610   my ($self, $query, $unique_cols) = @_;
 611
 612   return {
 613     map  { $_ => $query->{$_} }
 614     grep { exists $query->{$_} }
 615       @$unique_cols
 616   };
 617 }
 618
 619 =head2 search_related
 620
 621 =over 4
 622
 623 =item Arguments: $rel, $cond, \%attrs?
 624
 625 =item Return Value: $new_resultset
 626
 627 =back
 628
 629   $new_rs = $cd_rs->search_related('artist', {
 630     name => 'Emo-R-Us',
 631   });
 632
 633 Searches the specified relationship, optionally specifying a condition and
 634 attributes for matching records. See L</ATTRIBUTES> for more information.
 635
 636 =cut
 637
 638 sub search_related {
 639   return shift->related_resultset(shift)->search(@_);
 640 }
 641
 642 =head2 search_related_rs
 643
 644 This method works exactly the same as search_related, except that
 645 it guarantees a restultset, even in list context.
 646
 647 =cut
 648
 649 sub search_related_rs {
 650   return shift->related_resultset(shift)->search_rs(@_);
 651 }
 652
 653 =head2 cursor
 654
 655 =over 4
 656
 657 =item Arguments: none
 658
 659 =item Return Value: $cursor
 660
 661 =back
 662
 663 Returns a storage-driven cursor to the given resultset. See
 664 L<DBIx::Class::Cursor> for more information.
 665
 666 =cut
 667
 668 sub cursor {
 669   my ($self) = @_;
 670
 671   my $attrs = $self->_resolved_attrs_copy;
 672
 673   return $self->{cursor}
 674     ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
 675           $attrs->{where},$attrs);
 676 }
 677
 678 =head2 single
 679
 680 =over 4
 681
 682 =item Arguments: $cond?
 683
 684 =item Return Value: $row_object?
 685
 686 =back
 687
 688   my $cd = $schema->resultset('CD')->single({ year => 2001 });
 689
 690 Inflates the first result without creating a cursor if the resultset has
 691 any records in it; if not returns nothing. Used by L</find> as a lean version of
 692 L</search>.
 693
 694 While this method can take an optional search condition (just like L</search>)
 695 being a fast-code-path it does not recognize search attributes. If you need to
 696 add extra joins or similar, call L</search> and then chain-call L</single> on the
 697 L<DBIx::Class::ResultSet> returned.
 698
 699 =over
 700
 701 =item B<Note>
 702
 703 As of 0.08100, this method enforces the assumption that the preceeding
 704 query returns only one row. If more than one row is returned, you will receive
 705 a warning:
 706
 707   Query returned more than one row
 708
 709 In this case, you should be using L</next> or L</find> instead, or if you really
 710 know what you are doing, use the L</rows> attribute to explicitly limit the size
 711 of the resultset.
 712
 713 This method will also throw an exception if it is called on a resultset prefetching
 714 has_many, as such a prefetch implies fetching multiple rows from the database in
 715 order to assemble the resulting object.
 716
 717 =back
 718
 719 =cut
 720
 721 sub single {
 722   my ($self, $where) = @_;
 723   if(@_ > 2) {
 724       $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()');
 725   }
 726
 727   my $attrs = $self->_resolved_attrs_copy;
 728
 729   if (keys %{$attrs->{collapse}}) {
 730     $self->throw_exception(
 731       'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead'
 732     );
 733   }
 734
 735   if ($where) {
 736     if (defined $attrs->{where}) {
 737       $attrs->{where} = {
 738         '-and' =>
 739             [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
 740                $where, delete $attrs->{where} ]
 741       };
 742     } else {
 743       $attrs->{where} = $where;
 744     }
 745   }
 746
 747 #  XXX: Disabled since it doesn't infer uniqueness in all cases
 748 #  unless ($self->_is_unique_query($attrs->{where})) {
 749 #    carp "Query not guaranteed to return a single row"
 750 #      . "; please declare your unique constraints or use search instead";
 751 #  }
 752
 753   my @data = $self->result_source->storage->select_single(
 754     $attrs->{from}, $attrs->{select},
 755     $attrs->{where}, $attrs
 756   );
 757
 758   return (@data ? ($self->_construct_object(@data))[0] : undef);
 759 }
 760
 761
 762 # _is_unique_query
 763 #
 764 # Try to determine if the specified query is guaranteed to be unique, based on
 765 # the declared unique constraints.
 766
 767 sub _is_unique_query {
 768   my ($self, $query) = @_;
 769
 770   my $collapsed = $self->_collapse_query($query);
 771   my $alias = $self->{attrs}{alias};
 772
 773   foreach my $name ($self->result_source->unique_constraint_names) {
 774     my @unique_cols = map {
 775       "$alias.$_"
 776     } $self->result_source->unique_constraint_columns($name);
 777
 778     # Count the values for each unique column
 779     my %seen = map { $_ => 0 } @unique_cols;
 780
 781     foreach my $key (keys %$collapsed) {
 782       my $aliased = $key =~ /\./ ? $key : "$alias.$key";
 783       next unless exists $seen{$aliased};  # Additional constraints are okay
 784       $seen{$aliased} = scalar keys %{ $collapsed->{$key} };
 785     }
 786
 787     # If we get 0 or more than 1 value for a column, it's not necessarily unique
 788     return 1 unless grep { $_ != 1 } values %seen;
 789   }
 790
 791   return 0;
 792 }
 793
 794 # _collapse_query
 795 #
 796 # Recursively collapse the query, accumulating values for each column.
 797
 798 sub _collapse_query {
 799   my ($self, $query, $collapsed) = @_;
 800
 801   $collapsed ||= {};
 802
 803   if (ref $query eq 'ARRAY') {
 804     foreach my $subquery (@$query) {
 805       next unless ref $subquery;  # -or
 806       $collapsed = $self->_collapse_query($subquery, $collapsed);
 807     }
 808   }
 809   elsif (ref $query eq 'HASH') {
 810     if (keys %$query and (keys %$query)[0] eq '-and') {
 811       foreach my $subquery (@{$query->{-and}}) {
 812         $collapsed = $self->_collapse_query($subquery, $collapsed);
 813       }
 814     }
 815     else {
 816       foreach my $col (keys %$query) {
 817         my $value = $query->{$col};
 818         $collapsed->{$col}{$value}++;
 819       }
 820     }
 821   }
 822
 823   return $collapsed;
 824 }
 825
 826 =head2 get_column
 827
 828 =over 4
 829
 830 =item Arguments: $cond?
 831
 832 =item Return Value: $resultsetcolumn
 833
 834 =back
 835
 836   my $max_length = $rs->get_column('length')->max;
 837
 838 Returns a L<DBIx::Class::ResultSetColumn> instance for a column of the ResultSet.
 839
 840 =cut
 841
 842 sub get_column {
 843   my ($self, $column) = @_;
 844   my $new = DBIx::Class::ResultSetColumn->new($self, $column);
 845   return $new;
 846 }
 847
 848 =head2 search_like
 849
 850 =over 4
 851
 852 =item Arguments: $cond, \%attrs?
 853
 854 =item Return Value: $resultset (scalar context), @row_objs (list context)
 855
 856 =back
 857
 858   # WHERE title LIKE '%blue%'
 859   $cd_rs = $rs->search_like({ title => '%blue%'});
 860
 861 Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
 862 that this is simply a convenience method retained for ex Class::DBI users.
 863 You most likely want to use L</search> with specific operators.
 864
 865 For more information, see L<DBIx::Class::Manual::Cookbook>.
 866
 867 This method is deprecated and will be removed in 0.09. Use L</search()>
 868 instead. An example conversion is:
 869
 870   ->search_like({ foo => 'bar' });
 871
 872   # Becomes
 873
 874   ->search({ foo => { like => 'bar' } });
 875
 876 =cut
 877
 878 sub search_like {
 879   my $class = shift;
 880   carp (
 881     'search_like() is deprecated and will be removed in DBIC version 0.09.'
 882    .' Instead use ->search({ x => { -like => "y%" } })'
 883    .' (note the outer pair of {}s - they are important!)'
 884   );
 885   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 886   my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
 887   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
 888   return $class->search($query, { %$attrs });
 889 }
 890
 891 =head2 slice
 892
 893 =over 4
 894
 895 =item Arguments: $first, $last
 896
 897 =item Return Value: $resultset (scalar context), @row_objs (list context)
 898
 899 =back
 900
 901 Returns a resultset or object list representing a subset of elements from the
 902 resultset slice is called on. Indexes are from 0, i.e., to get the first
 903 three records, call:
 904
 905   my ($one, $two, $three) = $rs->slice(0, 2);
 906
 907 =cut
 908
 909 sub slice {
 910   my ($self, $min, $max) = @_;
 911   my $attrs = {}; # = { %{ $self->{attrs} || {} } };
 912   $attrs->{offset} = $self->{attrs}{offset} || 0;
 913   $attrs->{offset} += $min;
 914   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
 915   return $self->search(undef(), $attrs);
 916   #my $slice = (ref $self)->new($self->result_source, $attrs);
 917   #return (wantarray ? $slice->all : $slice);
 918 }
 919
 920 =head2 next
 921
 922 =over 4
 923
 924 =item Arguments: none
 925
 926 =item Return Value: $result?
 927
 928 =back
 929
 930 Returns the next element in the resultset (C<undef> is there is none).
 931
 932 Can be used to efficiently iterate over records in the resultset:
 933
 934   my $rs = $schema->resultset('CD')->search;
 935   while (my $cd = $rs->next) {
 936     print $cd->title;
 937   }
 938
 939 Note that you need to store the resultset object, and call C<next> on it.
 940 Calling C<< resultset('Table')->next >> repeatedly will always return the
 941 first record from the resultset.
 942
 943 =cut
 944
 945 sub next {
 946   my ($self) = @_;
 947   if (my $cache = $self->get_cache) {
 948     $self->{all_cache_position} ||= 0;
 949     return $cache->[$self->{all_cache_position}++];
 950   }
 951   if ($self->{attrs}{cache}) {
 952     $self->{all_cache_position} = 1;
 953     return ($self->all)[0];
 954   }
 955   if ($self->{stashed_objects}) {
 956     my $obj = shift(@{$self->{stashed_objects}});
 957     delete $self->{stashed_objects} unless @{$self->{stashed_objects}};
 958     return $obj;
 959   }
 960   my @row = (
 961     exists $self->{stashed_row}
 962       ? @{delete $self->{stashed_row}}
 963       : $self->cursor->next
 964   );
 965   return undef unless (@row);
 966   my ($row, @more) = $self->_construct_object(@row);
 967   $self->{stashed_objects} = \@more if @more;
 968   return $row;
 969 }
 970
 971 sub _construct_object {
 972   my ($self, @row) = @_;
 973
 974   my $info = $self->_collapse_result($self->{_attrs}{as}, \@row)
 975     or return ();
 976   my @new = $self->result_class->inflate_result($self->result_source, @$info);
 977   @new = $self->{_attrs}{record_filter}->(@new)
 978     if exists $self->{_attrs}{record_filter};
 979   return @new;
 980 }
 981
 982 sub _collapse_result {
 983   my ($self, $as_proto, $row) = @_;
 984
 985   my @copy = @$row;
 986
 987   # 'foo'         => [ undef, 'foo' ]
 988   # 'foo.bar'     => [ 'foo', 'bar' ]
 989   # 'foo.bar.baz' => [ 'foo.bar', 'baz' ]
 990
 991   my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto;
 992
 993   my %collapse = %{$self->{_attrs}{collapse}||{}};
 994
 995   my @pri_index;
 996
 997   # if we're doing collapsing (has_many prefetch) we need to grab records
 998   # until the PK changes, so fill @pri_index. if not, we leave it empty so
 999   # we know we don't have to bother.
1000
1001   # the reason for not using the collapse stuff directly is because if you
1002   # had for e.g. two artists in a row with no cds, the collapse info for
1003   # both would be NULL (undef) so you'd lose the second artist
1004
1005   # store just the index so we can check the array positions from the row
1006   # without having to contruct the full hash
1007
1008   if (keys %collapse) {
1009     my %pri = map { ($_ => 1) } $self->result_source->primary_columns;
1010     foreach my $i (0 .. $#construct_as) {
1011       next if defined($construct_as[$i][0]); # only self table
1012       if (delete $pri{$construct_as[$i][1]}) {
1013         push(@pri_index, $i);
1014       }
1015       last unless keys %pri; # short circuit (Johnny Five Is Alive!)
1016     }
1017   }
1018
1019   # no need to do an if, it'll be empty if @pri_index is empty anyway
1020
1021   my %pri_vals = map { ($_ => $copy[$_]) } @pri_index;
1022
1023   my @const_rows;
1024
1025   do { # no need to check anything at the front, we always want the first row
1026
1027     my %const;
1028
1029     foreach my $this_as (@construct_as) {
1030       $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy);
1031     }
1032
1033     push(@const_rows, \%const);
1034
1035   } until ( # no pri_index => no collapse => drop straight out
1036       !@pri_index
1037     or
1038       do { # get another row, stash it, drop out if different PK
1039
1040         @copy = $self->cursor->next;
1041         $self->{stashed_row} = \@copy;
1042
1043         # last thing in do block, counts as true if anything doesn't match
1044
1045         # check xor defined first for NULL vs. NOT NULL then if one is
1046         # defined the other must be so check string equality
1047
1048         grep {
1049           (defined $pri_vals{$_} ^ defined $copy[$_])
1050           || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_]))
1051         } @pri_index;
1052       }
1053   );
1054
1055   my $alias = $self->{attrs}{alias};
1056   my $info = [];
1057
1058   my %collapse_pos;
1059
1060   my @const_keys;
1061
1062   foreach my $const (@const_rows) {
1063     scalar @const_keys or do {
1064       @const_keys = sort { length($a) <=> length($b) } keys %$const;
1065     };
1066     foreach my $key (@const_keys) {
1067       if (length $key) {
1068         my $target = $info;
1069         my @parts = split(/\./, $key);
1070         my $cur = '';
1071         my $data = $const->{$key};
1072         foreach my $p (@parts) {
1073           $target = $target->[1]->{$p} ||= [];
1074           $cur .= ".${p}";
1075           if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) {
1076             # collapsing at this point and on final part
1077             my $pos = $collapse_pos{$cur};
1078             CK: foreach my $ck (@ckey) {
1079               if (!defined $pos->{$ck} || $pos->{$ck} ne $data->{$ck}) {
1080                 $collapse_pos{$cur} = $data;
1081                 delete @collapse_pos{ # clear all positioning for sub-entries
1082                   grep { m/^\Q${cur}.\E/ } keys %collapse_pos
1083                 };
1084                 push(@$target, []);
1085                 last CK;
1086               }
1087             }
1088           }
1089           if (exists $collapse{$cur}) {
1090             $target = $target->[-1];
1091           }
1092         }
1093         $target->[0] = $data;
1094       } else {
1095         $info->[0] = $const->{$key};
1096       }
1097     }
1098   }
1099
1100   return $info;
1101 }
1102
1103 =head2 result_source
1104
1105 =over 4
1106
1107 =item Arguments: $result_source?
1108
1109 =item Return Value: $result_source
1110
1111 =back
1112
1113 An accessor for the primary ResultSource object from which this ResultSet
1114 is derived.
1115
1116 =head2 result_class
1117
1118 =over 4
1119
1120 =item Arguments: $result_class?
1121
1122 =item Return Value: $result_class
1123
1124 =back
1125
1126 An accessor for the class to use when creating row objects. Defaults to
1127 C<< result_source->result_class >> - which in most cases is the name of the
1128 L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
1129
1130 Note that changing the result_class will also remove any components
1131 that were originally loaded in the source class via
1132 L<DBIx::Class::ResultSource/load_components>. Any overloaded methods
1133 in the original source class will not run.
1134
1135 =cut
1136
1137 sub result_class {
1138   my ($self, $result_class) = @_;
1139   if ($result_class) {
1140     $self->ensure_class_loaded($result_class);
1141     $self->_result_class($result_class);
1142   }
1143   $self->_result_class;
1144 }
1145
1146 =head2 count
1147
1148 =over 4
1149
1150 =item Arguments: $cond, \%attrs??
1151
1152 =item Return Value: $count
1153
1154 =back
1155
1156 Performs an SQL C<COUNT> with the same query as the resultset was built
1157 with to find the number of elements. Passing arguments is equivalent to
1158 C<< $rs->search ($cond, \%attrs)->count >>
1159
1160 =cut
1161
1162 sub count {
1163   my $self = shift;
1164   return $self->search(@_)->count if @_ and defined $_[0];
1165   return scalar @{ $self->get_cache } if $self->get_cache;
1166
1167   my $attrs = $self->_resolved_attrs_copy;
1168
1169   # this is a little optimization - it is faster to do the limit
1170   # adjustments in software, instead of a subquery
1171   my $rows = delete $attrs->{rows};
1172   my $offset = delete $attrs->{offset};
1173
1174   my $crs;
1175   if ($self->_has_resolved_attr (qw/collapse group_by/)) {
1176     $crs = $self->_count_subq_rs ($attrs);
1177   }
1178   else {
1179     $crs = $self->_count_rs ($attrs);
1180   }
1181   my $count = $crs->next;
1182
1183   $count -= $offset if $offset;
1184   $count = $rows if $rows and $rows < $count;
1185   $count = 0 if ($count < 0);
1186
1187   return $count;
1188 }
1189
1190 =head2 count_rs
1191
1192 =over 4
1193
1194 =item Arguments: $cond, \%attrs??
1195
1196 =item Return Value: $count_rs
1197
1198 =back
1199
1200 Same as L</count> but returns a L<DBIx::Class::ResultSetColumn> object.
1201 This can be very handy for subqueries:
1202
1203   ->search( { amount => $some_rs->count_rs->as_query } )
1204
1205 As with regular resultsets the SQL query will be executed only after
1206 the resultset is accessed via L</next> or L</all>. That would return
1207 the same single value obtainable via L</count>.
1208
1209 =cut
1210
1211 sub count_rs {
1212   my $self = shift;
1213   return $self->search(@_)->count_rs if @_;
1214
1215   # this may look like a lack of abstraction (count() does about the same)
1216   # but in fact an _rs *must* use a subquery for the limits, as the
1217   # software based limiting can not be ported if this $rs is to be used
1218   # in a subquery itself (i.e. ->as_query)
1219   if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) {
1220     return $self->_count_subq_rs;
1221   }
1222   else {
1223     return $self->_count_rs;
1224   }
1225 }
1226
1227 #
1228 # returns a ResultSetColumn object tied to the count query
1229 #
1230 sub _count_rs {
1231   my ($self, $attrs) = @_;
1232
1233   my $rsrc = $self->result_source;
1234   $attrs ||= $self->_resolved_attrs;
1235
1236   my $tmp_attrs = { %$attrs };
1237
1238   # take off any limits, record_filter is cdbi, and no point of ordering a count
1239   delete $tmp_attrs->{$_} for (qw/select as rows offset order_by record_filter/);
1240
1241   # overwrite the selector (supplied by the storage)
1242   $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs);
1243   $tmp_attrs->{as} = 'count';
1244
1245   my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
1246
1247   return $tmp_rs;
1248 }
1249
1250 #
1251 # same as above but uses a subquery
1252 #
1253 sub _count_subq_rs {
1254   my ($self, $attrs) = @_;
1255
1256   my $rsrc = $self->result_source;
1257   $attrs ||= $self->_resolved_attrs_copy;
1258
1259   my $sub_attrs = { %$attrs };
1260
1261   # extra selectors do not go in the subquery and there is no point of ordering it
1262   delete $sub_attrs->{$_} for qw/collapse select _prefetch_select as order_by/;
1263
1264   # if we prefetch, we group_by primary keys only as this is what we would get out
1265   # of the rs via ->next/->all. We DO WANT to clobber old group_by regardless
1266   if ( keys %{$attrs->{collapse}} ) {
1267     $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->primary_columns) ]
1268   }
1269
1270   $sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $sub_attrs);
1271
1272   # this is so that the query can be simplified e.g.
1273   # * non-limiting joins can be pruned
1274   # * ordering can be thrown away in things like Top limit
1275   $sub_attrs->{-for_count_only} = 1;
1276
1277   my $sub_rs = $rsrc->resultset_class->new ($rsrc, $sub_attrs);
1278
1279   $attrs->{from} = [{
1280     -alias => 'count_subq',
1281     -source_handle => $rsrc->handle,
1282     count_subq => $sub_rs->as_query,
1283   }];
1284
1285   # the subquery replaces this
1286   delete $attrs->{$_} for qw/where bind collapse group_by having having_bind rows offset/;
1287
1288   return $self->_count_rs ($attrs);
1289 }
1290
1291 sub _bool {
1292   return 1;
1293 }
1294
1295 =head2 count_literal
1296
1297 =over 4
1298
1299 =item Arguments: $sql_fragment, @bind_values
1300
1301 =item Return Value: $count
1302
1303 =back
1304
1305 Counts the results in a literal query. Equivalent to calling L</search_literal>
1306 with the passed arguments, then L</count>.
1307
1308 =cut
1309
1310 sub count_literal { shift->search_literal(@_)->count; }
1311
1312 =head2 all
1313
1314 =over 4
1315
1316 =item Arguments: none
1317
1318 =item Return Value: @objects
1319
1320 =back
1321
1322 Returns all elements in the resultset. Called implicitly if the resultset
1323 is returned in list context.
1324
1325 =cut
1326
1327 sub all {
1328   my $self = shift;
1329   if(@_) {
1330       $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
1331   }
1332
1333   return @{ $self->get_cache } if $self->get_cache;
1334
1335   my @obj;
1336
1337   if (keys %{$self->_resolved_attrs->{collapse}}) {
1338     # Using $self->cursor->all is really just an optimisation.
1339     # If we're collapsing has_many prefetches it probably makes
1340     # very little difference, and this is cleaner than hacking
1341     # _construct_object to survive the approach
1342     $self->cursor->reset;
1343     my @row = $self->cursor->next;
1344     while (@row) {
1345       push(@obj, $self->_construct_object(@row));
1346       @row = (exists $self->{stashed_row}
1347                ? @{delete $self->{stashed_row}}
1348                : $self->cursor->next);
1349     }
1350   } else {
1351     @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
1352   }
1353
1354   $self->set_cache(\@obj) if $self->{attrs}{cache};
1355
1356   return @obj;
1357 }
1358
1359 =head2 reset
1360
1361 =over 4
1362
1363 =item Arguments: none
1364
1365 =item Return Value: $self
1366
1367 =back
1368
1369 Resets the resultset's cursor, so you can iterate through the elements again.
1370 Implicitly resets the storage cursor, so a subsequent L</next> will trigger
1371 another query.
1372
1373 =cut
1374
1375 sub reset {
1376   my ($self) = @_;
1377   delete $self->{_attrs} if exists $self->{_attrs};
1378   $self->{all_cache_position} = 0;
1379   $self->cursor->reset;
1380   return $self;
1381 }
1382
1383 =head2 first
1384
1385 =over 4
1386
1387 =item Arguments: none
1388
1389 =item Return Value: $object?
1390
1391 =back
1392
1393 Resets the resultset and returns an object for the first result (if the
1394 resultset returns anything).
1395
1396 =cut
1397
1398 sub first {
1399   return $_[0]->reset->next;
1400 }
1401
1402
1403 # _rs_update_delete
1404 #
1405 # Determines whether and what type of subquery is required for the $rs operation.
1406 # If grouping is necessary either supplies its own, or verifies the current one
1407 # After all is done delegates to the proper storage method.
1408
1409 sub _rs_update_delete {
1410   my ($self, $op, $values) = @_;
1411
1412   my $rsrc = $self->result_source;
1413
1414   # if a condition exists we need to strip all table qualifiers
1415   # if this is not possible we'll force a subquery below
1416   my $cond = $rsrc->schema->storage->_strip_cond_qualifiers ($self->{cond});
1417
1418   my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/);
1419   my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/row offset/);
1420
1421   if ($needs_group_by_subq or $needs_subq) {
1422
1423     # make a new $rs selecting only the PKs (that's all we really need)
1424     my $attrs = $self->_resolved_attrs_copy;
1425
1426     delete $attrs->{$_} for qw/collapse select as/;
1427     $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ];
1428
1429     if ($needs_group_by_subq) {
1430       # make sure no group_by was supplied, or if there is one - make sure it matches
1431       # the columns compiled above perfectly. Anything else can not be sanely executed
1432       # on most databases so croak right then and there
1433
1434       if (my $g = $attrs->{group_by}) {
1435         my @current_group_by = map
1436           { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
1437           @$g
1438         ;
1439
1440         if (
1441           join ("\x00", sort @current_group_by)
1442             ne
1443           join ("\x00", sort @{$attrs->{columns}} )
1444         ) {
1445           $self->throw_exception (
1446             "You have just attempted a $op operation on a resultset which does group_by"
1447             . ' on columns other than the primary keys, while DBIC internally needs to retrieve'
1448             . ' the primary keys in a subselect. All sane RDBMS engines do not support this'
1449             . ' kind of queries. Please retry the operation with a modified group_by or'
1450             . ' without using one at all.'
1451           );
1452         }
1453       }
1454       else {
1455         $attrs->{group_by} = $attrs->{columns};
1456       }
1457     }
1458
1459     my $subrs = (ref $self)->new($rsrc, $attrs);
1460
1461     return $self->result_source->storage->_subq_update_delete($subrs, $op, $values);
1462   }
1463   else {
1464     return $rsrc->storage->$op(
1465       $rsrc,
1466       $op eq 'update' ? $values : (),
1467       $cond,
1468     );
1469   }
1470 }
1471
1472 =head2 update
1473
1474 =over 4
1475
1476 =item Arguments: \%values
1477
1478 =item Return Value: $storage_rv
1479
1480 =back
1481
1482 Sets the specified columns in the resultset to the supplied values in a
1483 single query. Return value will be true if the update succeeded or false
1484 if no records were updated; exact type of success value is storage-dependent.
1485
1486 =cut
1487
1488 sub update {
1489   my ($self, $values) = @_;
1490   $self->throw_exception('Values for update must be a hash')
1491     unless ref $values eq 'HASH';
1492
1493   return $self->_rs_update_delete ('update', $values);
1494 }
1495
1496 =head2 update_all
1497
1498 =over 4
1499
1500 =item Arguments: \%values
1501
1502 =item Return Value: 1
1503
1504 =back
1505
1506 Fetches all objects and updates them one at a time. Note that C<update_all>
1507 will run DBIC cascade triggers, while L</update> will not.
1508
1509 =cut
1510
1511 sub update_all {
1512   my ($self, $values) = @_;
1513   $self->throw_exception('Values for update_all must be a hash')
1514     unless ref $values eq 'HASH';
1515   foreach my $obj ($self->all) {
1516     $obj->set_columns($values)->update;
1517   }
1518   return 1;
1519 }
1520
1521 =head2 delete
1522
1523 =over 4
1524
1525 =item Arguments: none
1526
1527 =item Return Value: $storage_rv
1528
1529 =back
1530
1531 Deletes the contents of the resultset from its result source. Note that this
1532 will not run DBIC cascade triggers. See L</delete_all> if you need triggers
1533 to run. See also L<DBIx::Class::Row/delete>.
1534
1535 Return value will be the amount of rows deleted; exact type of return value
1536 is storage-dependent.
1537
1538 =cut
1539
1540 sub delete {
1541   my $self = shift;
1542   $self->throw_exception('delete does not accept any arguments')
1543     if @_;
1544
1545   return $self->_rs_update_delete ('delete');
1546 }
1547
1548 =head2 delete_all
1549
1550 =over 4
1551
1552 =item Arguments: none
1553
1554 =item Return Value: 1
1555
1556 =back
1557
1558 Fetches all objects and deletes them one at a time. Note that C<delete_all>
1559 will run DBIC cascade triggers, while L</delete> will not.
1560
1561 =cut
1562
1563 sub delete_all {
1564   my $self = shift;
1565   $self->throw_exception('delete_all does not accept any arguments')
1566     if @_;
1567
1568   $_->delete for $self->all;
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 transparrently 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 related_resultset
2478
2479 =over 4
2480
2481 =item Arguments: $relationship_name
2482
2483 =item Return Value: $resultset
2484
2485 =back
2486
2487 Returns a related resultset for the supplied relationship name.
2488
2489   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
2490
2491 =cut
2492
2493 sub related_resultset {
2494   my ($self, $rel) = @_;
2495
2496   $self->{related_resultsets} ||= {};
2497   return $self->{related_resultsets}{$rel} ||= do {
2498     my $rsrc = $self->result_source;
2499     my $rel_info = $rsrc->relationship_info($rel);
2500
2501     $self->throw_exception(
2502       "search_related: result source '" . $rsrc->source_name .
2503         "' has no such relationship $rel")
2504       unless $rel_info;
2505
2506     my $attrs = $self->_chain_relationship($rel);
2507
2508     my $join_count = $attrs->{seen_join}{$rel};
2509
2510     my $alias = $self->result_source->storage
2511         ->relname_to_table_alias($rel, $join_count);
2512
2513     # since this is search_related, and we already slid the select window inwards
2514     # (the select/as attrs were deleted in the beginning), we need to flip all
2515     # left joins to inner, so we get the expected results
2516     # read the comment on top of the actual function to see what this does
2517     $attrs->{from} = $rsrc->schema->storage->_straight_join_to_node ($attrs->{from}, $alias);
2518
2519
2520     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
2521     delete @{$attrs}{qw(result_class alias)};
2522
2523     my $new_cache;
2524
2525     if (my $cache = $self->get_cache) {
2526       if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) {
2527         $new_cache = [ map { @{$_->related_resultset($rel)->get_cache} }
2528                         @$cache ];
2529       }
2530     }
2531
2532     my $rel_source = $rsrc->related_source($rel);
2533
2534     my $new = do {
2535
2536       # The reason we do this now instead of passing the alias to the
2537       # search_rs below is that if you wrap/overload resultset on the
2538       # source you need to know what alias it's -going- to have for things
2539       # to work sanely (e.g. RestrictWithObject wants to be able to add
2540       # extra query restrictions, and these may need to be $alias.)
2541
2542       my $rel_attrs = $rel_source->resultset_attributes;
2543       local $rel_attrs->{alias} = $alias;
2544
2545       $rel_source->resultset
2546                  ->search_rs(
2547                      undef, {
2548                        %$attrs,
2549                        where => $attrs->{where},
2550                    });
2551     };
2552     $new->set_cache($new_cache) if $new_cache;
2553     $new;
2554   };
2555 }
2556
2557 =head2 current_source_alias
2558
2559 =over 4
2560
2561 =item Arguments: none
2562
2563 =item Return Value: $source_alias
2564
2565 =back
2566
2567 Returns the current table alias for the result source this resultset is built
2568 on, that will be used in the SQL query. Usually it is C<me>.
2569
2570 Currently the source alias that refers to the result set returned by a
2571 L</search>/L</find> family method depends on how you got to the resultset: it's
2572 C<me> by default, but eg. L</search_related> aliases it to the related result
2573 source name (and keeps C<me> referring to the original result set). The long
2574 term goal is to make L<DBIx::Class> always alias the current resultset as C<me>
2575 (and make this method unnecessary).
2576
2577 Thus it's currently necessary to use this method in predefined queries (see
2578 L<DBIx::Class::Manual::Cookbook/Predefined searches>) when referring to the
2579 source alias of the current result set:
2580
2581   # in a result set class
2582   sub modified_by {
2583     my ($self, $user) = @_;
2584
2585     my $me = $self->current_source_alias;
2586
2587     return $self->search(
2588       "$me.modified" => $user->id,
2589     );
2590   }
2591
2592 =cut
2593
2594 sub current_source_alias {
2595   my ($self) = @_;
2596
2597   return ($self->{attrs} || {})->{alias} || 'me';
2598 }
2599
2600 # This code is called by search_related, and makes sure there
2601 # is clear separation between the joins before, during, and
2602 # after the relationship. This information is needed later
2603 # in order to properly resolve prefetch aliases (any alias
2604 # with a relation_chain_depth less than the depth of the
2605 # current prefetch is not considered)
2606 #
2607 # The increments happen twice per join. An even number means a
2608 # relationship specified via a search_related, whereas an odd
2609 # number indicates a join/prefetch added via attributes
2610 #
2611 # Also this code will wrap the current resultset (the one we
2612 # chain to) in a subselect IFF it contains limiting attributes
2613 sub _chain_relationship {
2614   my ($self, $rel) = @_;
2615   my $source = $self->result_source;
2616   my $attrs = { %{$self->{attrs}||{}} };
2617
2618   # we need to take the prefetch the attrs into account before we
2619   # ->_resolve_join as otherwise they get lost - captainL
2620   my $join = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} );
2621
2622   delete @{$attrs}{qw/join prefetch collapse distinct select as columns +select +as +columns/};
2623
2624   my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
2625
2626   my $from;
2627   my @force_subq_attrs = qw/offset rows group_by having/;
2628
2629   if (
2630     ($attrs->{from} && ref $attrs->{from} ne 'ARRAY')
2631       ||
2632     $self->_has_resolved_attr (@force_subq_attrs)
2633   ) {
2634     # Nuke the prefetch (if any) before the new $rs attrs
2635     # are resolved (prefetch is useless - we are wrapping
2636     # a subquery anyway).
2637     my $rs_copy = $self->search;
2638     $rs_copy->{attrs}{join} = $self->_merge_attr (
2639       $rs_copy->{attrs}{join},
2640       delete $rs_copy->{attrs}{prefetch},
2641     );
2642
2643     $from = [{
2644       -source_handle => $source->handle,
2645       -alias => $attrs->{alias},
2646       $attrs->{alias} => $rs_copy->as_query,
2647     }];
2648     delete @{$attrs}{@force_subq_attrs, 'where'};
2649     $seen->{-relation_chain_depth} = 0;
2650   }
2651   elsif ($attrs->{from}) {  #shallow copy suffices
2652     $from = [ @{$attrs->{from}} ];
2653   }
2654   else {
2655     $from = [{
2656       -source_handle => $source->handle,
2657       -alias => $attrs->{alias},
2658       $attrs->{alias} => $source->from,
2659     }];
2660   }
2661
2662   my $jpath = ($seen->{-relation_chain_depth})
2663     ? $from->[-1][0]{-join_path}
2664     : [];
2665
2666   my @requested_joins = $source->_resolve_join(
2667     $join,
2668     $attrs->{alias},
2669     $seen,
2670     $jpath,
2671   );
2672
2673   push @$from, @requested_joins;
2674
2675   $seen->{-relation_chain_depth}++;
2676
2677   # if $self already had a join/prefetch specified on it, the requested
2678   # $rel might very well be already included. What we do in this case
2679   # is effectively a no-op (except that we bump up the chain_depth on
2680   # the join in question so we could tell it *is* the search_related)
2681   my $already_joined;
2682
2683   # we consider the last one thus reverse
2684   for my $j (reverse @requested_joins) {
2685     if ($rel eq $j->[0]{-join_path}[-1]) {
2686       $j->[0]{-relation_chain_depth}++;
2687       $already_joined++;
2688       last;
2689     }
2690   }
2691 # alternative way to scan the entire chain - not backwards compatible
2692 #  for my $j (reverse @$from) {
2693 #    next unless ref $j eq 'ARRAY';
2694 #    if ($j->[0]{-join_path} && $j->[0]{-join_path}[-1] eq $rel) {
2695 #      $j->[0]{-relation_chain_depth}++;
2696 #      $already_joined++;
2697 #      last;
2698 #    }
2699 #  }
2700
2701   unless ($already_joined) {
2702     push @$from, $source->_resolve_join(
2703       $rel,
2704       $attrs->{alias},
2705       $seen,
2706       $jpath,
2707     );
2708   }
2709
2710   $seen->{-relation_chain_depth}++;
2711
2712   return {%$attrs, from => $from, seen_join => $seen};
2713 }
2714
2715 # too many times we have to do $attrs = { %{$self->_resolved_attrs} }
2716 sub _resolved_attrs_copy {
2717   my $self = shift;
2718   return { %{$self->_resolved_attrs (@_)} };
2719 }
2720
2721 sub _resolved_attrs {
2722   my $self = shift;
2723   return $self->{_attrs} if $self->{_attrs};
2724
2725   my $attrs  = { %{ $self->{attrs} || {} } };
2726   my $source = $self->result_source;
2727   my $alias  = $attrs->{alias};
2728
2729   $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols};
2730   my @colbits;
2731
2732   # build columns (as long as select isn't set) into a set of as/select hashes
2733   unless ( $attrs->{select} ) {
2734
2735     my @cols;
2736     if ( ref $attrs->{columns} eq 'ARRAY' ) {
2737       @cols = @{ delete $attrs->{columns}}
2738     } elsif ( defined $attrs->{columns} ) {
2739       @cols = delete $attrs->{columns}
2740     } else {
2741       @cols = $source->columns
2742     }
2743
2744     for (@cols) {
2745       if ( ref $_ eq 'HASH' ) {
2746         push @colbits, $_
2747       } else {
2748         my $key = /^\Q${alias}.\E(.+)$/
2749           ? "$1"
2750           : "$_";
2751         my $value = /\./
2752           ? "$_"
2753           : "${alias}.$_";
2754         push @colbits, { $key => $value };
2755       }
2756     }
2757   }
2758
2759   # add the additional columns on
2760   foreach (qw{include_columns +columns}) {
2761     if ( $attrs->{$_} ) {
2762       my @list = ( ref($attrs->{$_}) eq 'ARRAY' )
2763         ? @{ delete $attrs->{$_} }
2764         : delete $attrs->{$_};
2765       for (@list) {
2766         if ( ref($_) eq 'HASH' ) {
2767           push @colbits, $_
2768         } else {
2769           my $key = ( split /\./, $_ )[-1];
2770           my $value = ( /\./ ? $_ : "$alias.$_" );
2771           push @colbits, { $key => $value };
2772         }
2773       }
2774     }
2775   }
2776
2777   # start with initial select items
2778   if ( $attrs->{select} ) {
2779     $attrs->{select} =
2780         ( ref $attrs->{select} eq 'ARRAY' )
2781       ? [ @{ $attrs->{select} } ]
2782       : [ $attrs->{select} ];
2783
2784     if ( $attrs->{as} ) {
2785       $attrs->{as} =
2786         (
2787           ref $attrs->{as} eq 'ARRAY'
2788             ? [ @{ $attrs->{as} } ]
2789             : [ $attrs->{as} ]
2790         )
2791     } else {
2792       $attrs->{as} = [ map {
2793          m/^\Q${alias}.\E(.+)$/
2794            ? $1
2795            : $_
2796          } @{ $attrs->{select} }
2797       ]
2798     }
2799   }
2800   else {
2801
2802     # otherwise we intialise select & as to empty
2803     $attrs->{select} = [];
2804     $attrs->{as}     = [];
2805   }
2806
2807   # now add colbits to select/as
2808   push @{ $attrs->{select} }, map values %{$_}, @colbits;
2809   push @{ $attrs->{as}     }, map keys   %{$_}, @colbits;
2810
2811   if ( my $adds = delete $attrs->{'+select'} ) {
2812     $adds = [$adds] unless ref $adds eq 'ARRAY';
2813     push @{ $attrs->{select} },
2814       map { /\./ || ref $_ ? $_ : "$alias.$_" } @$adds;
2815   }
2816   if ( my $adds = delete $attrs->{'+as'} ) {
2817     $adds = [$adds] unless ref $adds eq 'ARRAY';
2818     push @{ $attrs->{as} }, @$adds;
2819   }
2820
2821   $attrs->{from} ||= [{
2822     -source_handle => $source->handle,
2823     -alias => $self->{attrs}{alias},
2824     $self->{attrs}{alias} => $source->from,
2825   }];
2826
2827   if ( $attrs->{join} || $attrs->{prefetch} ) {
2828
2829     $self->throw_exception ('join/prefetch can not be used with a custom {from}')
2830       if ref $attrs->{from} ne 'ARRAY';
2831
2832     my $join = delete $attrs->{join} || {};
2833
2834     if ( defined $attrs->{prefetch} ) {
2835       $join = $self->_merge_attr( $join, $attrs->{prefetch} );
2836     }
2837
2838     $attrs->{from} =    # have to copy here to avoid corrupting the original
2839       [
2840         @{ $attrs->{from} },
2841         $source->_resolve_join(
2842           $join,
2843           $alias,
2844           { %{ $attrs->{seen_join} || {} } },
2845           ( $attrs->{seen_join} && keys %{$attrs->{seen_join}})
2846             ? $attrs->{from}[-1][0]{-join_path}
2847             : []
2848           ,
2849         )
2850       ];
2851   }
2852
2853   if ( defined $attrs->{order_by} ) {
2854     $attrs->{order_by} = (
2855       ref( $attrs->{order_by} ) eq 'ARRAY'
2856       ? [ @{ $attrs->{order_by} } ]
2857       : [ $attrs->{order_by} || () ]
2858     );
2859   }
2860
2861   if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') {
2862     $attrs->{group_by} = [ $attrs->{group_by} ];
2863   }
2864
2865   # generate the distinct induced group_by early, as prefetch will be carried via a
2866   # subquery (since a group_by is present)
2867   if (delete $attrs->{distinct}) {
2868     if ($attrs->{group_by}) {
2869       carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
2870     }
2871     else {
2872       $attrs->{group_by} = [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ];
2873
2874       # add any order_by parts that are not already present in the group_by
2875       # we need to be careful not to add any named functions/aggregates
2876       # i.e. select => [ ... { count => 'foo', -as 'foocount' } ... ]
2877       my %already_grouped = map { $_ => 1 } (@{$attrs->{group_by}});
2878
2879       my $storage = $self->result_source->schema->storage;
2880       my $rs_column_list = $storage->_resolve_column_info ($attrs->{from});
2881       my @chunks = $storage->sql_maker->_order_by_chunks ($attrs->{order_by});
2882
2883       for my $chunk (map { ref $_ ? @$_ : $_ } (@chunks) ) {
2884         $chunk =~ s/\s+ (?: ASC|DESC ) \s* $//ix;
2885         if ($rs_column_list->{$chunk} && not $already_grouped{$chunk}++) {
2886           push @{$attrs->{group_by}}, $chunk;
2887         }
2888       }
2889     }
2890   }
2891
2892   $attrs->{collapse} ||= {};
2893   if ( my $prefetch = delete $attrs->{prefetch} ) {
2894     $prefetch = $self->_merge_attr( {}, $prefetch );
2895
2896     my $prefetch_ordering = [];
2897
2898     my $join_map = $self->_joinpath_aliases ($attrs->{from}, $attrs->{seen_join});
2899
2900     my @prefetch =
2901       $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
2902
2903     # we need to somehow mark which columns came from prefetch
2904     $attrs->{_prefetch_select} = [ map { $_->[0] } @prefetch ];
2905
2906     push @{ $attrs->{select} }, @{$attrs->{_prefetch_select}};
2907     push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
2908
2909     push( @{$attrs->{order_by}}, @$prefetch_ordering );
2910     $attrs->{_collapse_order_by} = \@$prefetch_ordering;
2911   }
2912
2913   # if both page and offset are specified, produce a combined offset
2914   # even though it doesn't make much sense, this is what pre 081xx has
2915   # been doing
2916   if (my $page = delete $attrs->{page}) {
2917     $attrs->{offset} =
2918       ($attrs->{rows} * ($page - 1))
2919             +
2920       ($attrs->{offset} || 0)
2921     ;
2922   }
2923
2924   return $self->{_attrs} = $attrs;
2925 }
2926
2927 sub _joinpath_aliases {
2928   my ($self, $fromspec, $seen) = @_;
2929
2930   my $paths = {};
2931   return $paths unless ref $fromspec eq 'ARRAY';
2932
2933   my $cur_depth = $seen->{-relation_chain_depth} || 0;
2934
2935   if ($cur_depth % 2) {
2936     $self->throw_exception ("-relation_chain_depth is not even, something went horribly wrong ($cur_depth)");
2937   }
2938
2939   for my $j (@$fromspec) {
2940
2941     next if ref $j ne 'ARRAY';
2942     next if ($j->[0]{-relation_chain_depth} || 0) < $cur_depth;
2943
2944     my $jpath = $j->[0]{-join_path};
2945
2946     my $p = $paths;
2947     $p = $p->{$_} ||= {} for @{$jpath}[$cur_depth/2 .. $#$jpath]; #only even depths are actual jpath boundaries
2948     push @{$p->{-join_aliases} }, $j->[0]{-alias};
2949   }
2950
2951   return $paths;
2952 }
2953
2954 sub _rollout_attr {
2955   my ($self, $attr) = @_;
2956
2957   if (ref $attr eq 'HASH') {
2958     return $self->_rollout_hash($attr);
2959   } elsif (ref $attr eq 'ARRAY') {
2960     return $self->_rollout_array($attr);
2961   } else {
2962     return [$attr];
2963   }
2964 }
2965
2966 sub _rollout_array {
2967   my ($self, $attr) = @_;
2968
2969   my @rolled_array;
2970   foreach my $element (@{$attr}) {
2971     if (ref $element eq 'HASH') {
2972       push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
2973     } elsif (ref $element eq 'ARRAY') {
2974       #  XXX - should probably recurse here
2975       push( @rolled_array, @{$self->_rollout_array($element)} );
2976     } else {
2977       push( @rolled_array, $element );
2978     }
2979   }
2980   return \@rolled_array;
2981 }
2982
2983 sub _rollout_hash {
2984   my ($self, $attr) = @_;
2985
2986   my @rolled_array;
2987   foreach my $key (keys %{$attr}) {
2988     push( @rolled_array, { $key => $attr->{$key} } );
2989   }
2990   return \@rolled_array;
2991 }
2992
2993 sub _calculate_score {
2994   my ($self, $a, $b) = @_;
2995
2996   if (defined $a xor defined $b) {
2997     return 0;
2998   }
2999   elsif (not defined $a) {
3000     return 1;
3001   }
3002
3003   if (ref $b eq 'HASH') {
3004     my ($b_key) = keys %{$b};
3005     if (ref $a eq 'HASH') {
3006       my ($a_key) = keys %{$a};
3007       if ($a_key eq $b_key) {
3008         return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
3009       } else {
3010         return 0;
3011       }
3012     } else {
3013       return ($a eq $b_key) ? 1 : 0;
3014     }
3015   } else {
3016     if (ref $a eq 'HASH') {
3017       my ($a_key) = keys %{$a};
3018       return ($b eq $a_key) ? 1 : 0;
3019     } else {
3020       return ($b eq $a) ? 1 : 0;
3021     }
3022   }
3023 }
3024
3025 sub _merge_attr {
3026   my ($self, $orig, $import) = @_;
3027
3028   return $import unless defined($orig);
3029   return $orig unless defined($import);
3030
3031   $orig = $self->_rollout_attr($orig);
3032   $import = $self->_rollout_attr($import);
3033
3034   my $seen_keys;
3035   foreach my $import_element ( @{$import} ) {
3036     # find best candidate from $orig to merge $b_element into
3037     my $best_candidate = { position => undef, score => 0 }; my $position = 0;
3038     foreach my $orig_element ( @{$orig} ) {
3039       my $score = $self->_calculate_score( $orig_element, $import_element );
3040       if ($score > $best_candidate->{score}) {
3041         $best_candidate->{position} = $position;
3042         $best_candidate->{score} = $score;
3043       }
3044       $position++;
3045     }
3046     my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
3047
3048     if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
3049       push( @{$orig}, $import_element );
3050     } else {
3051       my $orig_best = $orig->[$best_candidate->{position}];
3052       # merge orig_best and b_element together and replace original with merged
3053       if (ref $orig_best ne 'HASH') {
3054         $orig->[$best_candidate->{position}] = $import_element;
3055       } elsif (ref $import_element eq 'HASH') {
3056         my ($key) = keys %{$orig_best};
3057         $orig->[$best_candidate->{position}] = { $key => $self->_merge_attr($orig_best->{$key}, $import_element->{$key}) };
3058       }
3059     }
3060     $seen_keys->{$import_key} = 1; # don't merge the same key twice
3061   }
3062
3063   return $orig;
3064 }
3065
3066 sub result_source {
3067     my $self = shift;
3068
3069     if (@_) {
3070         $self->_source_handle($_[0]->handle);
3071     } else {
3072         $self->_source_handle->resolve;
3073     }
3074 }
3075
3076 =head2 throw_exception
3077
3078 See L<DBIx::Class::Schema/throw_exception> for details.
3079
3080 =cut
3081
3082 sub throw_exception {
3083   my $self=shift;
3084
3085   if (ref $self && $self->_source_handle->schema) {
3086     $self->_source_handle->schema->throw_exception(@_)
3087   }
3088   else {
3089     DBIx::Class::Exception->throw(@_);
3090   }
3091 }
3092
3093 # XXX: FIXME: Attributes docs need clearing up
3094
3095 =head1 ATTRIBUTES
3096
3097 Attributes are used to refine a ResultSet in various ways when
3098 searching for data. They can be passed to any method which takes an
3099 C<\%attrs> argument. See L</search>, L</search_rs>, L</find>,
3100 L</count>.
3101
3102 These are in no particular order:
3103
3104 =head2 order_by
3105
3106 =over 4
3107
3108 =item Value: ( $order_by | \@order_by | \%order_by )
3109
3110 =back
3111
3112 Which column(s) to order the results by.
3113
3114 [The full list of suitable values is documented in
3115 L<SQL::Abstract/"ORDER BY CLAUSES">; the following is a summary of
3116 common options.]
3117
3118 If a single column name, or an arrayref of names is supplied, the
3119 argument is passed through directly to SQL. The hashref syntax allows
3120 for connection-agnostic specification of ordering direction:
3121
3122  For descending order:
3123
3124   order_by => { -desc => [qw/col1 col2 col3/] }
3125
3126  For explicit ascending order:
3127
3128   order_by => { -asc => 'col' }
3129
3130 The old scalarref syntax (i.e. order_by => \'year DESC') is still
3131 supported, although you are strongly encouraged to use the hashref
3132 syntax as outlined above.
3133
3134 =head2 columns
3135
3136 =over 4
3137
3138 =item Value: \@columns
3139
3140 =back
3141
3142 Shortcut to request a particular set of columns to be retrieved. Each
3143 column spec may be a string (a table column name), or a hash (in which
3144 case the key is the C<as> value, and the value is used as the C<select>
3145 expression). Adds C<me.> onto the start of any column without a C<.> in
3146 it and sets C<select> from that, then auto-populates C<as> from
3147 C<select> as normal. (You may also use the C<cols> attribute, as in
3148 earlier versions of DBIC.)
3149
3150 =head2 +columns
3151
3152 =over 4
3153
3154 =item Value: \@columns
3155
3156 =back
3157
3158 Indicates additional columns to be selected from storage. Works the same
3159 as L</columns> but adds columns to the selection. (You may also use the
3160 C<include_columns> attribute, as in earlier versions of DBIC). For
3161 example:-
3162
3163   $schema->resultset('CD')->search(undef, {
3164     '+columns' => ['artist.name'],
3165     join => ['artist']
3166   });
3167
3168 would return all CDs and include a 'name' column to the information
3169 passed to object inflation. Note that the 'artist' is the name of the
3170 column (or relationship) accessor, and 'name' is the name of the column
3171 accessor in the related table.
3172
3173 =head2 include_columns
3174
3175 =over 4
3176
3177 =item Value: \@columns
3178
3179 =back
3180
3181 Deprecated.  Acts as a synonym for L</+columns> for backward compatibility.
3182
3183 =head2 select
3184
3185 =over 4
3186
3187 =item Value: \@select_columns
3188
3189 =back
3190
3191 Indicates which columns should be selected from the storage. You can use
3192 column names, or in the case of RDBMS back ends, function or stored procedure
3193 names:
3194
3195   $rs = $schema->resultset('Employee')->search(undef, {
3196     select => [
3197       'name',
3198       { count => 'employeeid' },
3199       { sum => 'salary' }
3200     ]
3201   });
3202
3203 When you use function/stored procedure names and do not supply an C<as>
3204 attribute, the column names returned are storage-dependent. E.g. MySQL would
3205 return a column named C<count(employeeid)> in the above example.
3206
3207 B<NOTE:> You will almost always need a corresponding 'as' entry when you use
3208 'select'.
3209
3210 =head2 +select
3211
3212 =over 4
3213
3214 Indicates additional columns to be selected from storage.  Works the same as
3215 L</select> but adds columns to the selection.
3216
3217 =back
3218
3219 =head2 +as
3220
3221 =over 4
3222
3223 Indicates additional column names for those added via L</+select>. See L</as>.
3224
3225 =back
3226
3227 =head2 as
3228
3229 =over 4
3230
3231 =item Value: \@inflation_names
3232
3233 =back
3234
3235 Indicates column names for object inflation. That is, C<as>
3236 indicates the name that the column can be accessed as via the
3237 C<get_column> method (or via the object accessor, B<if one already
3238 exists>).  It has nothing to do with the SQL code C<SELECT foo AS bar>.
3239
3240 The C<as> attribute is used in conjunction with C<select>,
3241 usually when C<select> contains one or more function or stored
3242 procedure names:
3243
3244   $rs = $schema->resultset('Employee')->search(undef, {
3245     select => [
3246       'name',
3247       { count => 'employeeid' }
3248     ],
3249     as => ['name', 'employee_count'],
3250   });
3251
3252   my $employee = $rs->first(); # get the first Employee
3253
3254 If the object against which the search is performed already has an accessor
3255 matching a column name specified in C<as>, the value can be retrieved using
3256 the accessor as normal:
3257
3258   my $name = $employee->name();
3259
3260 If on the other hand an accessor does not exist in the object, you need to
3261 use C<get_column> instead:
3262
3263   my $employee_count = $employee->get_column('employee_count');
3264
3265 You can create your own accessors if required - see
3266 L<DBIx::Class::Manual::Cookbook> for details.
3267
3268 Please note: This will NOT insert an C<AS employee_count> into the SQL
3269 statement produced, it is used for internal access only. Thus
3270 attempting to use the accessor in an C<order_by> clause or similar
3271 will fail miserably.
3272
3273 To get around this limitation, you can supply literal SQL to your
3274 C<select> attibute that contains the C<AS alias> text, eg:
3275
3276   select => [\'myfield AS alias']
3277
3278 =head2 join
3279
3280 =over 4
3281
3282 =item Value: ($rel_name | \@rel_names | \%rel_names)
3283
3284 =back
3285
3286 Contains a list of relationships that should be joined for this query.  For
3287 example:
3288
3289   # Get CDs by Nine Inch Nails
3290   my $rs = $schema->resultset('CD')->search(
3291     { 'artist.name' => 'Nine Inch Nails' },
3292     { join => 'artist' }
3293   );
3294
3295 Can also contain a hash reference to refer to the other relation's relations.
3296 For example:
3297
3298   package MyApp::Schema::Track;
3299   use base qw/DBIx::Class/;
3300   __PACKAGE__->table('track');
3301   __PACKAGE__->add_columns(qw/trackid cd position title/);
3302   __PACKAGE__->set_primary_key('trackid');
3303   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
3304   1;
3305
3306   # In your application
3307   my $rs = $schema->resultset('Artist')->search(
3308     { 'track.title' => 'Teardrop' },
3309     {
3310       join     => { cd => 'track' },
3311       order_by => 'artist.name',
3312     }
3313   );
3314
3315 You need to use the relationship (not the table) name in  conditions,
3316 because they are aliased as such. The current table is aliased as "me", so
3317 you need to use me.column_name in order to avoid ambiguity. For example:
3318
3319   # Get CDs from 1984 with a 'Foo' track
3320   my $rs = $schema->resultset('CD')->search(
3321     {
3322       'me.year' => 1984,
3323       'tracks.name' => 'Foo'
3324     },
3325     { join => 'tracks' }
3326   );
3327
3328 If the same join is supplied twice, it will be aliased to <rel>_2 (and
3329 similarly for a third time). For e.g.
3330
3331   my $rs = $schema->resultset('Artist')->search({
3332     'cds.title'   => 'Down to Earth',
3333     'cds_2.title' => 'Popular',
3334   }, {
3335     join => [ qw/cds cds/ ],
3336   });
3337
3338 will return a set of all artists that have both a cd with title 'Down
3339 to Earth' and a cd with title 'Popular'.
3340
3341 If you want to fetch related objects from other tables as well, see C<prefetch>
3342 below.
3343
3344 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
3345
3346 =head2 prefetch
3347
3348 =over 4
3349
3350 =item Value: ($rel_name | \@rel_names | \%rel_names)
3351
3352 =back
3353
3354 Contains one or more relationships that should be fetched along with
3355 the main query (when they are accessed afterwards the data will
3356 already be available, without extra queries to the database).  This is
3357 useful for when you know you will need the related objects, because it
3358 saves at least one query:
3359
3360   my $rs = $schema->resultset('Tag')->search(
3361     undef,
3362     {
3363       prefetch => {
3364         cd => 'artist'
3365       }
3366     }
3367   );
3368
3369 The initial search results in SQL like the following:
3370
3371   SELECT tag.*, cd.*, artist.* FROM tag
3372   JOIN cd ON tag.cd = cd.cdid
3373   JOIN artist ON cd.artist = artist.artistid
3374
3375 L<DBIx::Class> has no need to go back to the database when we access the
3376 C<cd> or C<artist> relationships, which saves us two SQL statements in this
3377 case.
3378
3379 Simple prefetches will be joined automatically, so there is no need
3380 for a C<join> attribute in the above search.
3381
3382 C<prefetch> can be used with the following relationship types: C<belongs_to>,
3383 C<has_one> (or if you're using C<add_relationship>, any relationship declared
3384 with an accessor type of 'single' or 'filter'). A more complex example that
3385 prefetches an artists cds, the tracks on those cds, and the tags associted
3386 with that artist is given below (assuming many-to-many from artists to tags):
3387
3388  my $rs = $schema->resultset('Artist')->search(
3389    undef,
3390    {
3391      prefetch => [
3392        { cds => 'tracks' },
3393        { artist_tags => 'tags' }
3394      ]
3395    }
3396  );
3397
3398
3399 B<NOTE:> If you specify a C<prefetch> attribute, the C<join> and C<select>
3400 attributes will be ignored.
3401
3402 B<CAVEATs>: Prefetch does a lot of deep magic. As such, it may not behave
3403 exactly as you might expect.
3404
3405 =over 4
3406
3407 =item *
3408
3409 Prefetch uses the L</cache> to populate the prefetched relationships. This
3410 may or may not be what you want.
3411
3412 =item *
3413
3414 If you specify a condition on a prefetched relationship, ONLY those
3415 rows that match the prefetched condition will be fetched into that relationship.
3416 This means that adding prefetch to a search() B<may alter> what is returned by
3417 traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
3418
3419   my $artist_rs = $schema->resultset('Artist')->search({
3420       'cds.year' => 2008,
3421   }, {
3422       join => 'cds',
3423   });
3424
3425   my $count = $artist_rs->first->cds->count;
3426
3427   my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
3428
3429   my $prefetch_count = $artist_rs_prefetch->first->cds->count;
3430
3431   cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
3432
3433 that cmp_ok() may or may not pass depending on the datasets involved. This
3434 behavior may or may not survive the 0.09 transition.
3435
3436 =back
3437
3438 =head2 page
3439
3440 =over 4
3441
3442 =item Value: $page
3443
3444 =back
3445
3446 Makes the resultset paged and specifies the page to retrieve. Effectively
3447 identical to creating a non-pages resultset and then calling ->page($page)
3448 on it.
3449
3450 If L<rows> attribute is not specified it defaults to 10 rows per page.
3451
3452 When you have a paged resultset, L</count> will only return the number
3453 of rows in the page. To get the total, use the L</pager> and call
3454 C<total_entries> on it.
3455
3456 =head2 rows
3457
3458 =over 4
3459
3460 =item Value: $rows
3461
3462 =back
3463
3464 Specifes the maximum number of rows for direct retrieval or the number of
3465 rows per page if the page attribute or method is used.
3466
3467 =head2 offset
3468
3469 =over 4
3470
3471 =item Value: $offset
3472
3473 =back
3474
3475 Specifies the (zero-based) row number for the  first row to be returned, or the
3476 of the first row of the first page if paging is used.
3477
3478 =head2 group_by
3479
3480 =over 4
3481
3482 =item Value: \@columns
3483
3484 =back
3485
3486 A arrayref of columns to group by. Can include columns of joined tables.
3487
3488   group_by => [qw/ column1 column2 ... /]
3489
3490 =head2 having
3491
3492 =over 4
3493
3494 =item Value: $condition
3495
3496 =back
3497
3498 HAVING is a select statement attribute that is applied between GROUP BY and
3499 ORDER BY. It is applied to the after the grouping calculations have been
3500 done.
3501
3502   having => { 'count(employee)' => { '>=', 100 } }
3503
3504 =head2 distinct
3505
3506 =over 4
3507
3508 =item Value: (0 | 1)
3509
3510 =back
3511
3512 Set to 1 to group by all columns. If the resultset already has a group_by
3513 attribute, this setting is ignored and an appropriate warning is issued.
3514
3515 =head2 where
3516
3517 =over 4
3518
3519 Adds to the WHERE clause.
3520
3521   # only return rows WHERE deleted IS NULL for all searches
3522   __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
3523
3524 Can be overridden by passing C<< { where => undef } >> as an attribute
3525 to a resultset.
3526
3527 =back
3528
3529 =head2 cache
3530
3531 Set to 1 to cache search results. This prevents extra SQL queries if you
3532 revisit rows in your ResultSet:
3533
3534   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
3535
3536   while( my $artist = $resultset->next ) {
3537     ... do stuff ...
3538   }
3539
3540   $rs->first; # without cache, this would issue a query
3541
3542 By default, searches are not cached.
3543
3544 For more examples of using these attributes, see
3545 L<DBIx::Class::Manual::Cookbook>.
3546
3547 =head2 for
3548
3549 =over 4
3550
3551 =item Value: ( 'update' | 'shared' )
3552
3553 =back
3554
3555 Set to 'update' for a SELECT ... FOR UPDATE or 'shared' for a SELECT
3556 ... FOR SHARED.
3557
3558 =cut
3559
3560 1;