lib/DBIx/Class/ResultSet.pm

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