lib/DBIx/Class/ResultSet.pm

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