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