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 $select = { count => '*' };
1147
1148   my $attrs = { %{$self->_resolved_attrs} };
1149   if (my $group_by = delete $attrs->{group_by}) {
1150     delete $attrs->{having};
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     $select = { count => { distinct => \@distinct } };
1165   }
1166
1167   $attrs->{select} = $select;
1168   $attrs->{as} = [qw/count/];
1169
1170   # offset, order by and page are not needed to count. record_filter is cdbi
1171   delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
1172
1173   my $tmp_rs = (ref $self)->new($self->result_source, $attrs);
1174   my ($count) = $tmp_rs->cursor->next;
1175   return $count;
1176 }
1177
1178 sub _bool {
1179   return 1;
1180 }
1181
1182 =head2 count_literal
1183
1184 =over 4
1185
1186 =item Arguments: $sql_fragment, @bind_values
1187
1188 =item Return Value: $count
1189
1190 =back
1191
1192 Counts the results in a literal query. Equivalent to calling L</search_literal>
1193 with the passed arguments, then L</count>.
1194
1195 =cut
1196
1197 sub count_literal { shift->search_literal(@_)->count; }
1198
1199 =head2 all
1200
1201 =over 4
1202
1203 =item Arguments: none
1204
1205 =item Return Value: @objects
1206
1207 =back
1208
1209 Returns all elements in the resultset. Called implicitly if the resultset
1210 is returned in list context.
1211
1212 =cut
1213
1214 sub all {
1215   my $self = shift;
1216   if(@_) {
1217       $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
1218   }
1219
1220   return @{ $self->get_cache } if $self->get_cache;
1221
1222   my @obj;
1223
1224   # TODO: don't call resolve here
1225   if (keys %{$self->_resolved_attrs->{collapse}}) {
1226 #  if ($self->{attrs}{prefetch}) {
1227       # Using $self->cursor->all is really just an optimisation.
1228       # If we're collapsing has_many prefetches it probably makes
1229       # very little difference, and this is cleaner than hacking
1230       # _construct_object to survive the approach
1231     my @row = $self->cursor->next;
1232     while (@row) {
1233       push(@obj, $self->_construct_object(@row));
1234       @row = (exists $self->{stashed_row}
1235                ? @{delete $self->{stashed_row}}
1236                : $self->cursor->next);
1237     }
1238   } else {
1239     @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
1240   }
1241
1242   $self->set_cache(\@obj) if $self->{attrs}{cache};
1243   return @obj;
1244 }
1245
1246 =head2 reset
1247
1248 =over 4
1249
1250 =item Arguments: none
1251
1252 =item Return Value: $self
1253
1254 =back
1255
1256 Resets the resultset's cursor, so you can iterate through the elements again.
1257
1258 =cut
1259
1260 sub reset {
1261   my ($self) = @_;
1262   delete $self->{_attrs} if exists $self->{_attrs};
1263   $self->{all_cache_position} = 0;
1264   $self->cursor->reset;
1265   return $self;
1266 }
1267
1268 =head2 first
1269
1270 =over 4
1271
1272 =item Arguments: none
1273
1274 =item Return Value: $object?
1275
1276 =back
1277
1278 Resets the resultset and returns an object for the first result (if the
1279 resultset returns anything).
1280
1281 =cut
1282
1283 sub first {
1284   return $_[0]->reset->next;
1285 }
1286
1287 # _cond_for_update_delete
1288 #
1289 # update/delete require the condition to be modified to handle
1290 # the differing SQL syntax available.  This transforms the $self->{cond}
1291 # appropriately, returning the new condition.
1292
1293 sub _cond_for_update_delete {
1294   my ($self, $full_cond) = @_;
1295   my $cond = {};
1296
1297   $full_cond ||= $self->{cond};
1298   # No-op. No condition, we're updating/deleting everything
1299   return $cond unless ref $full_cond;
1300
1301   if (ref $full_cond eq 'ARRAY') {
1302     $cond = [
1303       map {
1304         my %hash;
1305         foreach my $key (keys %{$_}) {
1306           $key =~ /([^.]+)$/;
1307           $hash{$1} = $_->{$key};
1308         }
1309         \%hash;
1310       } @{$full_cond}
1311     ];
1312   }
1313   elsif (ref $full_cond eq 'HASH') {
1314     if ((keys %{$full_cond})[0] eq '-and') {
1315       $cond->{-and} = [];
1316
1317       my @cond = @{$full_cond->{-and}};
1318       for (my $i = 0; $i < @cond; $i++) {
1319         my $entry = $cond[$i];
1320
1321         my $hash;
1322         if (ref $entry eq 'HASH') {
1323           $hash = $self->_cond_for_update_delete($entry);
1324         }
1325         else {
1326           $entry =~ /([^.]+)$/;
1327           $hash->{$1} = $cond[++$i];
1328         }
1329
1330         push @{$cond->{-and}}, $hash;
1331       }
1332     }
1333     else {
1334       foreach my $key (keys %{$full_cond}) {
1335         $key =~ /([^.]+)$/;
1336         $cond->{$1} = $full_cond->{$key};
1337       }
1338     }
1339   }
1340   else {
1341     $self->throw_exception(
1342       "Can't update/delete on resultset with condition unless hash or array"
1343     );
1344   }
1345
1346   return $cond;
1347 }
1348
1349
1350 =head2 update
1351
1352 =over 4
1353
1354 =item Arguments: \%values
1355
1356 =item Return Value: $storage_rv
1357
1358 =back
1359
1360 Sets the specified columns in the resultset to the supplied values in a
1361 single query. Return value will be true if the update succeeded or false
1362 if no records were updated; exact type of success value is storage-dependent.
1363
1364 =cut
1365
1366 sub update {
1367   my ($self, $values) = @_;
1368   $self->throw_exception("Values for update must be a hash")
1369     unless ref $values eq 'HASH';
1370
1371   carp(   'WARNING! Currently $rs->update() does not generate proper SQL'
1372         . ' on joined resultsets, and may affect rows well outside of the'
1373         . ' contents of $rs. Use at your own risk' )
1374     if ( $self->{attrs}{seen_join} );
1375
1376   my $cond = $self->_cond_for_update_delete;
1377
1378   return $self->result_source->storage->update(
1379     $self->result_source, $values, $cond
1380   );
1381 }
1382
1383 =head2 update_all
1384
1385 =over 4
1386
1387 =item Arguments: \%values
1388
1389 =item Return Value: 1
1390
1391 =back
1392
1393 Fetches all objects and updates them one at a time. Note that C<update_all>
1394 will run DBIC cascade triggers, while L</update> will not.
1395
1396 =cut
1397
1398 sub update_all {
1399   my ($self, $values) = @_;
1400   $self->throw_exception("Values for update must be a hash")
1401     unless ref $values eq 'HASH';
1402   foreach my $obj ($self->all) {
1403     $obj->set_columns($values)->update;
1404   }
1405   return 1;
1406 }
1407
1408 =head2 delete
1409
1410 =over 4
1411
1412 =item Arguments: none
1413
1414 =item Return Value: 1
1415
1416 =back
1417
1418 Deletes the contents of the resultset from its result source. Note that this
1419 will not run DBIC cascade triggers. See L</delete_all> if you need triggers
1420 to run. See also L<DBIx::Class::Row/delete>.
1421
1422 delete may not generate correct SQL for a query with joins or a resultset
1423 chained from a related resultset.  In this case it will generate a warning:-
1424
1425   WARNING! Currently $rs->delete() does not generate proper SQL on
1426   joined resultsets, and may delete rows well outside of the contents
1427   of $rs. Use at your own risk
1428
1429 In these cases you may find that delete_all is more appropriate, or you
1430 need to respecify your query in a way that can be expressed without a join.
1431
1432 =cut
1433
1434 sub delete {
1435   my ($self) = @_;
1436   $self->throw_exception("Delete should not be passed any arguments")
1437     if $_[1];
1438   carp(   'WARNING! Currently $rs->delete() does not generate proper SQL'
1439         . ' on joined resultsets, and may delete rows well outside of the'
1440         . ' contents of $rs. Use at your own risk' )
1441     if ( $self->{attrs}{seen_join} );
1442   my $cond = $self->_cond_for_update_delete;
1443
1444   $self->result_source->storage->delete($self->result_source, $cond);
1445   return 1;
1446 }
1447
1448 =head2 delete_all
1449
1450 =over 4
1451
1452 =item Arguments: none
1453
1454 =item Return Value: 1
1455
1456 =back
1457
1458 Fetches all objects and deletes them one at a time. Note that C<delete_all>
1459 will run DBIC cascade triggers, while L</delete> will not.
1460
1461 =cut
1462
1463 sub delete_all {
1464   my ($self) = @_;
1465   $_->delete for $self->all;
1466   return 1;
1467 }
1468
1469 =head2 populate
1470
1471 =over 4
1472
1473 =item Arguments: \@data;
1474
1475 =back
1476
1477 Accepts either an arrayref of hashrefs or alternatively an arrayref of arrayrefs.
1478 For the arrayref of hashrefs style each hashref should be a structure suitable
1479 forsubmitting to a $resultset->create(...) method.
1480
1481 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
1482 to insert the data, as this is a faster method.
1483
1484 Otherwise, each set of data is inserted into the database using
1485 L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
1486 objects is returned.
1487
1488 Example:  Assuming an Artist Class that has many CDs Classes relating:
1489
1490   my $Artist_rs = $schema->resultset("Artist");
1491
1492   ## Void Context Example
1493   $Artist_rs->populate([
1494      { artistid => 4, name => 'Manufactured Crap', cds => [
1495         { title => 'My First CD', year => 2006 },
1496         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
1497       ],
1498      },
1499      { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
1500         { title => 'My parents sold me to a record company' ,year => 2005 },
1501         { title => 'Why Am I So Ugly?', year => 2006 },
1502         { title => 'I Got Surgery and am now Popular', year => 2007 }
1503       ],
1504      },
1505   ]);
1506
1507   ## Array Context Example
1508   my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([
1509     { name => "Artist One"},
1510     { name => "Artist Two"},
1511     { name => "Artist Three", cds=> [
1512     { title => "First CD", year => 2007},
1513     { title => "Second CD", year => 2008},
1514   ]}
1515   ]);
1516
1517   print $ArtistOne->name; ## response is 'Artist One'
1518   print $ArtistThree->cds->count ## reponse is '2'
1519
1520 For the arrayref of arrayrefs style,  the first element should be a list of the
1521 fieldsnames to which the remaining elements are rows being inserted.  For
1522 example:
1523
1524   $Arstist_rs->populate([
1525     [qw/artistid name/],
1526     [100, 'A Formally Unknown Singer'],
1527     [101, 'A singer that jumped the shark two albums ago'],
1528     [102, 'An actually cool singer.'],
1529   ]);
1530
1531 Please note an important effect on your data when choosing between void and
1532 wantarray context. Since void context goes straight to C<insert_bulk> in
1533 L<DBIx::Class::Storage::DBI> this will skip any component that is overriding
1534 c<insert>.  So if you are using something like L<DBIx-Class-UUIDColumns> to
1535 create primary keys for you, you will find that your PKs are empty.  In this
1536 case you will have to use the wantarray context in order to create those
1537 values.
1538
1539 =cut
1540
1541 sub populate {
1542   my $self = shift @_;
1543   my $data = ref $_[0][0] eq 'HASH'
1544     ? $_[0] : ref $_[0][0] eq 'ARRAY' ? $self->_normalize_populate_args($_[0]) :
1545     $self->throw_exception('Populate expects an arrayref of hashes or arrayref of arrayrefs');
1546
1547   if(defined wantarray) {
1548     my @created;
1549     foreach my $item (@$data) {
1550       push(@created, $self->create($item));
1551     }
1552     return @created;
1553   } else {
1554     my ($first, @rest) = @$data;
1555
1556     my @names = grep {!ref $first->{$_}} keys %$first;
1557     my @rels = grep { $self->result_source->has_relationship($_) } keys %$first;
1558     my @pks = $self->result_source->primary_columns;
1559
1560     ## do the belongs_to relationships
1561     foreach my $index (0..$#$data) {
1562       if( grep { !defined $data->[$index]->{$_} } @pks ) {
1563         my @ret = $self->populate($data);
1564         return;
1565       }
1566
1567       foreach my $rel (@rels) {
1568         next unless $data->[$index]->{$rel} && ref $data->[$index]->{$rel} eq "HASH";
1569         my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
1570         my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)};
1571         my $related = $result->result_source->resolve_condition(
1572           $result->result_source->relationship_info($reverse)->{cond},
1573           $self,
1574           $result,
1575         );
1576
1577         delete $data->[$index]->{$rel};
1578         $data->[$index] = {%{$data->[$index]}, %$related};
1579
1580         push @names, keys %$related if $index == 0;
1581       }
1582     }
1583
1584     ## do bulk insert on current row
1585     my @values = map { [ @$_{@names} ] } @$data;
1586
1587     $self->result_source->storage->insert_bulk(
1588       $self->result_source,
1589       \@names,
1590       \@values,
1591     );
1592
1593     ## do the has_many relationships
1594     foreach my $item (@$data) {
1595
1596       foreach my $rel (@rels) {
1597         next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY";
1598
1599         my $parent = $self->find(map {{$_=>$item->{$_}} } @pks)
1600      || $self->throw_exception('Cannot find the relating object.');
1601
1602         my $child = $parent->$rel;
1603
1604         my $related = $child->result_source->resolve_condition(
1605           $parent->result_source->relationship_info($rel)->{cond},
1606           $child,
1607           $parent,
1608         );
1609
1610         my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
1611         my @populate = map { {%$_, %$related} } @rows_to_add;
1612
1613         $child->populate( \@populate );
1614       }
1615     }
1616   }
1617 }
1618
1619 =head2 _normalize_populate_args ($args)
1620
1621 Private method used by L</populate> to normalize its incoming arguments.  Factored
1622 out in case you want to subclass and accept new argument structures to the
1623 L</populate> method.
1624
1625 =cut
1626
1627 sub _normalize_populate_args {
1628   my ($self, $data) = @_;
1629   my @names = @{shift(@$data)};
1630   my @results_to_create;
1631   foreach my $datum (@$data) {
1632     my %result_to_create;
1633     foreach my $index (0..$#names) {
1634       $result_to_create{$names[$index]} = $$datum[$index];
1635     }
1636     push @results_to_create, \%result_to_create;
1637   }
1638   return \@results_to_create;
1639 }
1640
1641 =head2 pager
1642
1643 =over 4
1644
1645 =item Arguments: none
1646
1647 =item Return Value: $pager
1648
1649 =back
1650
1651 Return Value a L<Data::Page> object for the current resultset. Only makes
1652 sense for queries with a C<page> attribute.
1653
1654 To get the full count of entries for a paged resultset, call
1655 C<total_entries> on the L<Data::Page> object.
1656
1657 =cut
1658
1659 sub pager {
1660   my ($self) = @_;
1661   my $attrs = $self->{attrs};
1662   $self->throw_exception("Can't create pager for non-paged rs")
1663     unless $self->{attrs}{page};
1664   $attrs->{rows} ||= 10;
1665   return $self->{pager} ||= Data::Page->new(
1666     $self->_count, $attrs->{rows}, $self->{attrs}{page});
1667 }
1668
1669 =head2 page
1670
1671 =over 4
1672
1673 =item Arguments: $page_number
1674
1675 =item Return Value: $rs
1676
1677 =back
1678
1679 Returns a resultset for the $page_number page of the resultset on which page
1680 is called, where each page contains a number of rows equal to the 'rows'
1681 attribute set on the resultset (10 by default).
1682
1683 =cut
1684
1685 sub page {
1686   my ($self, $page) = @_;
1687   return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
1688 }
1689
1690 =head2 new_result
1691
1692 =over 4
1693
1694 =item Arguments: \%vals
1695
1696 =item Return Value: $rowobject
1697
1698 =back
1699
1700 Creates a new row object in the resultset's result class and returns
1701 it. The row is not inserted into the database at this point, call
1702 L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
1703 will tell you whether the row object has been inserted or not.
1704
1705 Passes the hashref of input on to L<DBIx::Class::Row/new>.
1706
1707 =cut
1708
1709 sub new_result {
1710   my ($self, $values) = @_;
1711   $self->throw_exception( "new_result needs a hash" )
1712     unless (ref $values eq 'HASH');
1713
1714   my %new;
1715   my $alias = $self->{attrs}{alias};
1716
1717   if (
1718     defined $self->{cond}
1719     && $self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION
1720   ) {
1721     %new = %{ $self->{attrs}{related_objects} || {} };  # nothing might have been inserted yet
1722     $new{-from_resultset} = [ keys %new ] if keys %new;
1723   } else {
1724     $self->throw_exception(
1725       "Can't abstract implicit construct, condition not a hash"
1726     ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
1727
1728     my $collapsed_cond = (
1729       $self->{cond}
1730         ? $self->_collapse_cond($self->{cond})
1731         : {}
1732     );
1733
1734     # precendence must be given to passed values over values inherited from
1735     # the cond, so the order here is important.
1736     my %implied =  %{$self->_remove_alias($collapsed_cond, $alias)};
1737     while( my($col,$value) = each %implied ){
1738       if(ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '='){
1739         $new{$col} = $value->{'='};
1740         next;
1741       }
1742       $new{$col} = $value if $self->_is_deterministic_value($value);
1743     }
1744   }
1745
1746   %new = (
1747     %new,
1748     %{ $self->_remove_alias($values, $alias) },
1749     -source_handle => $self->_source_handle,
1750     -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
1751   );
1752
1753   return $self->result_class->new(\%new);
1754 }
1755
1756 # _is_deterministic_value
1757 #
1758 # Make an effor to strip non-deterministic values from the condition,
1759 # to make sure new_result chokes less
1760
1761 sub _is_deterministic_value {
1762   my $self = shift;
1763   my $value = shift;
1764   my $ref_type = ref $value;
1765   return 1 if $ref_type eq '' || $ref_type eq 'SCALAR';
1766   return 1 if Scalar::Util::blessed($value);
1767   return 0;
1768 }
1769
1770 # _collapse_cond
1771 #
1772 # Recursively collapse the condition.
1773
1774 sub _collapse_cond {
1775   my ($self, $cond, $collapsed) = @_;
1776
1777   $collapsed ||= {};
1778
1779   if (ref $cond eq 'ARRAY') {
1780     foreach my $subcond (@$cond) {
1781       next unless ref $subcond;  # -or
1782 #      warn "ARRAY: " . Dumper $subcond;
1783       $collapsed = $self->_collapse_cond($subcond, $collapsed);
1784     }
1785   }
1786   elsif (ref $cond eq 'HASH') {
1787     if (keys %$cond and (keys %$cond)[0] eq '-and') {
1788       foreach my $subcond (@{$cond->{-and}}) {
1789 #        warn "HASH: " . Dumper $subcond;
1790         $collapsed = $self->_collapse_cond($subcond, $collapsed);
1791       }
1792     }
1793     else {
1794 #      warn "LEAF: " . Dumper $cond;
1795       foreach my $col (keys %$cond) {
1796         my $value = $cond->{$col};
1797         $collapsed->{$col} = $value;
1798       }
1799     }
1800   }
1801
1802   return $collapsed;
1803 }
1804
1805 # _remove_alias
1806 #
1807 # Remove the specified alias from the specified query hash. A copy is made so
1808 # the original query is not modified.
1809
1810 sub _remove_alias {
1811   my ($self, $query, $alias) = @_;
1812
1813   my %orig = %{ $query || {} };
1814   my %unaliased;
1815
1816   foreach my $key (keys %orig) {
1817     if ($key !~ /\./) {
1818       $unaliased{$key} = $orig{$key};
1819       next;
1820     }
1821     $unaliased{$1} = $orig{$key}
1822       if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
1823   }
1824
1825   return \%unaliased;
1826 }
1827
1828 =head2 as_query (EXPERIMENTAL)
1829
1830 =over 4
1831
1832 =item Arguments: none
1833
1834 =item Return Value: \[ $sql, @bind ]
1835
1836 =back
1837
1838 Returns the SQL query and bind vars associated with the invocant.
1839
1840 This is generally used as the RHS for a subquery.
1841
1842 B<NOTE>: This feature is still experimental.
1843
1844 =cut
1845
1846 sub as_query { return shift->cursor->as_query(@_) }
1847
1848 =head2 find_or_new
1849
1850 =over 4
1851
1852 =item Arguments: \%vals, \%attrs?
1853
1854 =item Return Value: $rowobject
1855
1856 =back
1857
1858   my $artist = $schema->resultset('Artist')->find_or_new(
1859     { artist => 'fred' }, { key => 'artists' });
1860
1861   $cd->cd_to_producer->find_or_new({ producer => $producer },
1862                                    { key => 'primary });
1863
1864 Find an existing record from this resultset, based on its primary
1865 key, or a unique constraint. If none exists, instantiate a new result
1866 object and return it. The object will not be saved into your storage
1867 until you call L<DBIx::Class::Row/insert> on it.
1868
1869 You most likely want this method when looking for existing rows using
1870 a unique constraint that is not the primary key, or looking for
1871 related rows.
1872
1873 If you want objects to be saved immediately, use L</find_or_create> instead.
1874
1875 B<Note>: C<find_or_new> is probably not what you want when creating a
1876 new row in a table that uses primary keys supplied by the
1877 database. Passing in a primary key column with a value of I<undef>
1878 will cause L</find> to attempt to search for a row with a value of
1879 I<NULL>.
1880
1881 =cut
1882
1883 sub find_or_new {
1884   my $self     = shift;
1885   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1886   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
1887   my $exists   = $self->find($hash, $attrs);
1888   return defined $exists ? $exists : $self->new_result($hash);
1889 }
1890
1891 =head2 create
1892
1893 =over 4
1894
1895 =item Arguments: \%vals
1896
1897 =item Return Value: a L<DBIx::Class::Row> $object
1898
1899 =back
1900
1901 Attempt to create a single new row or a row with multiple related rows
1902 in the table represented by the resultset (and related tables). This
1903 will not check for duplicate rows before inserting, use
1904 L</find_or_create> to do that.
1905
1906 To create one row for this resultset, pass a hashref of key/value
1907 pairs representing the columns of the table and the values you wish to
1908 store. If the appropriate relationships are set up, foreign key fields
1909 can also be passed an object representing the foreign row, and the
1910 value will be set to its primary key.
1911
1912 To create related objects, pass a hashref for the value if the related
1913 item is a foreign key relationship (L<DBIx::Class::Relationship/belongs_to>),
1914 and use the name of the relationship as the key. (NOT the name of the field,
1915 necessarily). For C<has_many> and C<has_one> relationships, pass an arrayref
1916 of hashrefs containing the data for each of the rows to create in the foreign
1917 tables, again using the relationship name as the key.
1918
1919 Instead of hashrefs of plain related data (key/value pairs), you may
1920 also pass new or inserted objects. New objects (not inserted yet, see
1921 L</new>), will be inserted into their appropriate tables.
1922
1923 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
1924
1925 Example of creating a new row.
1926
1927   $person_rs->create({
1928     name=>"Some Person",
1929     email=>"somebody@someplace.com"
1930   });
1931
1932 Example of creating a new row and also creating rows in a related C<has_many>
1933 or C<has_one> resultset.  Note Arrayref.
1934
1935   $artist_rs->create(
1936      { artistid => 4, name => 'Manufactured Crap', cds => [
1937         { title => 'My First CD', year => 2006 },
1938         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
1939       ],
1940      },
1941   );
1942
1943 Example of creating a new row and also creating a row in a related
1944 C<belongs_to>resultset. Note Hashref.
1945
1946   $cd_rs->create({
1947     title=>"Music for Silly Walks",
1948     year=>2000,
1949     artist => {
1950       name=>"Silly Musician",
1951     }
1952   });
1953
1954 =cut
1955
1956 sub create {
1957   my ($self, $attrs) = @_;
1958   $self->throw_exception( "create needs a hashref" )
1959     unless ref $attrs eq 'HASH';
1960   return $self->new_result($attrs)->insert;
1961 }
1962
1963 =head2 find_or_create
1964
1965 =over 4
1966
1967 =item Arguments: \%vals, \%attrs?
1968
1969 =item Return Value: $rowobject
1970
1971 =back
1972
1973   $cd->cd_to_producer->find_or_create({ producer => $producer },
1974                                       { key => 'primary });
1975
1976 Tries to find a record based on its primary key or unique constraints; if none
1977 is found, creates one and returns that instead.
1978
1979   my $cd = $schema->resultset('CD')->find_or_create({
1980     cdid   => 5,
1981     artist => 'Massive Attack',
1982     title  => 'Mezzanine',
1983     year   => 2005,
1984   });
1985
1986 Also takes an optional C<key> attribute, to search by a specific key or unique
1987 constraint. For example:
1988
1989   my $cd = $schema->resultset('CD')->find_or_create(
1990     {
1991       artist => 'Massive Attack',
1992       title  => 'Mezzanine',
1993     },
1994     { key => 'cd_artist_title' }
1995   );
1996
1997 B<Note>: Because find_or_create() reads from the database and then
1998 possibly inserts based on the result, this method is subject to a race
1999 condition. Another process could create a record in the table after
2000 the find has completed and before the create has started. To avoid
2001 this problem, use find_or_create() inside a transaction.
2002
2003 B<Note>: C<find_or_create> is probably not what you want when creating
2004 a new row in a table that uses primary keys supplied by the
2005 database. Passing in a primary key column with a value of I<undef>
2006 will cause L</find> to attempt to search for a row with a value of
2007 I<NULL>.
2008
2009 See also L</find> and L</update_or_create>. For information on how to declare
2010 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2011
2012 =cut
2013
2014 sub find_or_create {
2015   my $self     = shift;
2016   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2017   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2018   my $exists   = $self->find($hash, $attrs);
2019   return defined $exists ? $exists : $self->create($hash);
2020 }
2021
2022 =head2 update_or_create
2023
2024 =over 4
2025
2026 =item Arguments: \%col_values, { key => $unique_constraint }?
2027
2028 =item Return Value: $rowobject
2029
2030 =back
2031
2032   $resultset->update_or_create({ col => $val, ... });
2033
2034 First, searches for an existing row matching one of the unique constraints
2035 (including the primary key) on the source of this resultset. If a row is
2036 found, updates it with the other given column values. Otherwise, creates a new
2037 row.
2038
2039 Takes an optional C<key> attribute to search on a specific unique constraint.
2040 For example:
2041
2042   # In your application
2043   my $cd = $schema->resultset('CD')->update_or_create(
2044     {
2045       artist => 'Massive Attack',
2046       title  => 'Mezzanine',
2047       year   => 1998,
2048     },
2049     { key => 'cd_artist_title' }
2050   );
2051
2052   $cd->cd_to_producer->update_or_create({
2053     producer => $producer,
2054     name => 'harry',
2055   }, {
2056     key => 'primary,
2057   });
2058
2059
2060 If no C<key> is specified, it searches on all unique constraints defined on the
2061 source, including the primary key.
2062
2063 If the C<key> is specified as C<primary>, it searches only on the primary key.
2064
2065 See also L</find> and L</find_or_create>. For information on how to declare
2066 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2067
2068 B<Note>: C<update_or_create> is probably not what you want when
2069 looking for a row in a table that uses primary keys supplied by the
2070 database, unless you actually have a key value. Passing in a primary
2071 key column with a value of I<undef> will cause L</find> to attempt to
2072 search for a row with a value of I<NULL>.
2073
2074 =cut
2075
2076 sub update_or_create {
2077   my $self = shift;
2078   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2079   my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
2080
2081   my $row = $self->find($cond, $attrs);
2082   if (defined $row) {
2083     $row->update($cond);
2084     return $row;
2085   }
2086
2087   return $self->create($cond);
2088 }
2089
2090 =head2 get_cache
2091
2092 =over 4
2093
2094 =item Arguments: none
2095
2096 =item Return Value: \@cache_objects?
2097
2098 =back
2099
2100 Gets the contents of the cache for the resultset, if the cache is set.
2101
2102 The cache is populated either by using the L</prefetch> attribute to
2103 L</search> or by calling L</set_cache>.
2104
2105 =cut
2106
2107 sub get_cache {
2108   shift->{all_cache};
2109 }
2110
2111 =head2 set_cache
2112
2113 =over 4
2114
2115 =item Arguments: \@cache_objects
2116
2117 =item Return Value: \@cache_objects
2118
2119 =back
2120
2121 Sets the contents of the cache for the resultset. Expects an arrayref
2122 of objects of the same class as those produced by the resultset. Note that
2123 if the cache is set the resultset will return the cached objects rather
2124 than re-querying the database even if the cache attr is not set.
2125
2126 The contents of the cache can also be populated by using the
2127 L</prefetch> attribute to L</search>.
2128
2129 =cut
2130
2131 sub set_cache {
2132   my ( $self, $data ) = @_;
2133   $self->throw_exception("set_cache requires an arrayref")
2134       if defined($data) && (ref $data ne 'ARRAY');
2135   $self->{all_cache} = $data;
2136 }
2137
2138 =head2 clear_cache
2139
2140 =over 4
2141
2142 =item Arguments: none
2143
2144 =item Return Value: []
2145
2146 =back
2147
2148 Clears the cache for the resultset.
2149
2150 =cut
2151
2152 sub clear_cache {
2153   shift->set_cache(undef);
2154 }
2155
2156 =head2 related_resultset
2157
2158 =over 4
2159
2160 =item Arguments: $relationship_name
2161
2162 =item Return Value: $resultset
2163
2164 =back
2165
2166 Returns a related resultset for the supplied relationship name.
2167
2168   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
2169
2170 =cut
2171
2172 sub related_resultset {
2173   my ($self, $rel) = @_;
2174
2175   $self->{related_resultsets} ||= {};
2176   return $self->{related_resultsets}{$rel} ||= do {
2177     my $rel_obj = $self->result_source->relationship_info($rel);
2178
2179     $self->throw_exception(
2180       "search_related: result source '" . $self->result_source->source_name .
2181         "' has no such relationship $rel")
2182       unless $rel_obj;
2183
2184     my ($from,$seen) = $self->_resolve_from($rel);
2185
2186     my $join_count = $seen->{$rel};
2187     my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
2188
2189     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
2190     my %attrs = %{$self->{attrs}||{}};
2191     delete @attrs{qw(result_class alias)};
2192
2193     my $new_cache;
2194
2195     if (my $cache = $self->get_cache) {
2196       if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) {
2197         $new_cache = [ map { @{$_->related_resultset($rel)->get_cache} }
2198                         @$cache ];
2199       }
2200     }
2201
2202     my $rel_source = $self->result_source->related_source($rel);
2203
2204     my $new = do {
2205
2206       # The reason we do this now instead of passing the alias to the
2207       # search_rs below is that if you wrap/overload resultset on the
2208       # source you need to know what alias it's -going- to have for things
2209       # to work sanely (e.g. RestrictWithObject wants to be able to add
2210       # extra query restrictions, and these may need to be $alias.)
2211
2212       my $attrs = $rel_source->resultset_attributes;
2213       local $attrs->{alias} = $alias;
2214
2215       $rel_source->resultset
2216                  ->search_rs(
2217                      undef, {
2218                        %attrs,
2219                        join => undef,
2220                        prefetch => undef,
2221                        select => undef,
2222                        as => undef,
2223                        where => $self->{cond},
2224                        seen_join => $seen,
2225                        from => $from,
2226                    });
2227     };
2228     $new->set_cache($new_cache) if $new_cache;
2229     $new;
2230   };
2231 }
2232
2233 =head2 current_source_alias
2234
2235 =over 4
2236
2237 =item Arguments: none
2238
2239 =item Return Value: $source_alias
2240
2241 =back
2242
2243 Returns the current table alias for the result source this resultset is built
2244 on, that will be used in the SQL query. Usually it is C<me>.
2245
2246 Currently the source alias that refers to the result set returned by a
2247 L</search>/L</find> family method depends on how you got to the resultset: it's
2248 C<me> by default, but eg. L</search_related> aliases it to the related result
2249 source name (and keeps C<me> referring to the original result set). The long
2250 term goal is to make L<DBIx::Class> always alias the current resultset as C<me>
2251 (and make this method unnecessary).
2252
2253 Thus it's currently necessary to use this method in predefined queries (see
2254 L<DBIx::Class::Manual::Cookbook/Predefined searches>) when referring to the
2255 source alias of the current result set:
2256
2257   # in a result set class
2258   sub modified_by {
2259     my ($self, $user) = @_;
2260
2261     my $me = $self->current_source_alias;
2262
2263     return $self->search(
2264       "$me.modified" => $user->id,
2265     );
2266   }
2267
2268 =cut
2269
2270 sub current_source_alias {
2271   my ($self) = @_;
2272
2273   return ($self->{attrs} || {})->{alias} || 'me';
2274 }
2275
2276 sub _resolve_from {
2277   my ($self, $extra_join) = @_;
2278   my $source = $self->result_source;
2279   my $attrs = $self->{attrs};
2280
2281   my $from = $attrs->{from}
2282     || [ { $attrs->{alias} => $source->from } ];
2283
2284   my $seen = { %{$attrs->{seen_join}||{}} };
2285
2286   my $join = ($attrs->{join}
2287                ? [ $attrs->{join}, $extra_join ]
2288                : $extra_join);
2289
2290   # we need to take the prefetch the attrs into account before we
2291   # ->resolve_join as otherwise they get lost - captainL
2292   my $merged = $self->_merge_attr( $join, $attrs->{prefetch} );
2293
2294   $from = [
2295     @$from,
2296     ($join ? $source->resolve_join($merged, $attrs->{alias}, $seen) : ()),
2297   ];
2298
2299   return ($from,$seen);
2300 }
2301
2302 sub _resolved_attrs {
2303   my $self = shift;
2304   return $self->{_attrs} if $self->{_attrs};
2305
2306   my $attrs  = { %{ $self->{attrs} || {} } };
2307   my $source = $self->result_source;
2308   my $alias  = $attrs->{alias};
2309
2310   $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols};
2311   my @colbits;
2312
2313   # build columns (as long as select isn't set) into a set of as/select hashes
2314   unless ( $attrs->{select} ) {
2315       @colbits = map {
2316           ( ref($_) eq 'HASH' ) ? $_
2317             : {
2318               (
2319                   /^\Q${alias}.\E(.+)$/ ? $1
2320                   : $_
2321                 ) => ( /\./ ? $_ : "${alias}.$_" )
2322             }
2323       } ( ref($attrs->{columns}) eq 'ARRAY' ) ? @{ delete $attrs->{columns}} : (delete $attrs->{columns} || $source->columns );
2324   }
2325   # add the additional columns on
2326   foreach ( 'include_columns', '+columns' ) {
2327       push @colbits, map {
2328           ( ref($_) eq 'HASH' )
2329             ? $_
2330             : { ( split( /\./, $_ ) )[-1] => ( /\./ ? $_ : "${alias}.$_" ) }
2331       } ( ref($attrs->{$_}) eq 'ARRAY' ) ? @{ delete $attrs->{$_} } : delete $attrs->{$_} if ( $attrs->{$_} );
2332   }
2333
2334   # start with initial select items
2335   if ( $attrs->{select} ) {
2336     $attrs->{select} =
2337         ( ref $attrs->{select} eq 'ARRAY' )
2338       ? [ @{ $attrs->{select} } ]
2339       : [ $attrs->{select} ];
2340     $attrs->{as} = (
2341       $attrs->{as}
2342       ? (
2343         ref $attrs->{as} eq 'ARRAY'
2344         ? [ @{ $attrs->{as} } ]
2345         : [ $attrs->{as} ]
2346         )
2347       : [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{ $attrs->{select} } ]
2348     );
2349   }
2350   else {
2351
2352     # otherwise we intialise select & as to empty
2353     $attrs->{select} = [];
2354     $attrs->{as}     = [];
2355   }
2356
2357   # now add colbits to select/as
2358   push( @{ $attrs->{select} }, map { values( %{$_} ) } @colbits );
2359   push( @{ $attrs->{as} },     map { keys( %{$_} ) } @colbits );
2360
2361   my $adds;
2362   if ( $adds = delete $attrs->{'+select'} ) {
2363     $adds = [$adds] unless ref $adds eq 'ARRAY';
2364     push(
2365       @{ $attrs->{select} },
2366       map { /\./ || ref $_ ? $_ : "${alias}.$_" } @$adds
2367     );
2368   }
2369   if ( $adds = delete $attrs->{'+as'} ) {
2370     $adds = [$adds] unless ref $adds eq 'ARRAY';
2371     push( @{ $attrs->{as} }, @$adds );
2372   }
2373
2374   $attrs->{from} ||= [ { $self->{attrs}{alias} => $source->from } ];
2375
2376   if ( exists $attrs->{join} || exists $attrs->{prefetch} ) {
2377     my $join = delete $attrs->{join} || {};
2378
2379     if ( defined $attrs->{prefetch} ) {
2380       $join = $self->_merge_attr( $join, $attrs->{prefetch} );
2381
2382     }
2383
2384     $attrs->{from} =    # have to copy here to avoid corrupting the original
2385       [
2386       @{ $attrs->{from} },
2387       $source->resolve_join(
2388         $join, $alias, { %{ $attrs->{seen_join} || {} } }
2389       )
2390       ];
2391
2392   }
2393
2394   $attrs->{group_by} ||= $attrs->{select}
2395     if delete $attrs->{distinct};
2396   if ( $attrs->{order_by} ) {
2397     $attrs->{order_by} = (
2398       ref( $attrs->{order_by} ) eq 'ARRAY'
2399       ? [ @{ $attrs->{order_by} } ]
2400       : [ $attrs->{order_by} ]
2401     );
2402   }
2403   else {
2404     $attrs->{order_by} = [];
2405   }
2406
2407   my $collapse = $attrs->{collapse} || {};
2408   if ( my $prefetch = delete $attrs->{prefetch} ) {
2409     $prefetch = $self->_merge_attr( {}, $prefetch );
2410     my @pre_order;
2411     my $seen = { %{ $attrs->{seen_join} || {} } };
2412     foreach my $p ( ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch) ) {
2413
2414       # bring joins back to level of current class
2415       my @prefetch =
2416         $source->resolve_prefetch( $p, $alias, $seen, \@pre_order, $collapse );
2417       push( @{ $attrs->{select} }, map { $_->[0] } @prefetch );
2418       push( @{ $attrs->{as} },     map { $_->[1] } @prefetch );
2419     }
2420     push( @{ $attrs->{order_by} }, @pre_order );
2421   }
2422   $attrs->{collapse} = $collapse;
2423
2424   if ( $attrs->{page} ) {
2425     $attrs->{offset} ||= 0;
2426     $attrs->{offset} += ( $attrs->{rows} * ( $attrs->{page} - 1 ) );
2427   }
2428
2429   return $self->{_attrs} = $attrs;
2430 }
2431
2432 sub _rollout_attr {
2433   my ($self, $attr) = @_;
2434
2435   if (ref $attr eq 'HASH') {
2436     return $self->_rollout_hash($attr);
2437   } elsif (ref $attr eq 'ARRAY') {
2438     return $self->_rollout_array($attr);
2439   } else {
2440     return [$attr];
2441   }
2442 }
2443
2444 sub _rollout_array {
2445   my ($self, $attr) = @_;
2446
2447   my @rolled_array;
2448   foreach my $element (@{$attr}) {
2449     if (ref $element eq 'HASH') {
2450       push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
2451     } elsif (ref $element eq 'ARRAY') {
2452       #  XXX - should probably recurse here
2453       push( @rolled_array, @{$self->_rollout_array($element)} );
2454     } else {
2455       push( @rolled_array, $element );
2456     }
2457   }
2458   return \@rolled_array;
2459 }
2460
2461 sub _rollout_hash {
2462   my ($self, $attr) = @_;
2463
2464   my @rolled_array;
2465   foreach my $key (keys %{$attr}) {
2466     push( @rolled_array, { $key => $attr->{$key} } );
2467   }
2468   return \@rolled_array;
2469 }
2470
2471 sub _calculate_score {
2472   my ($self, $a, $b) = @_;
2473
2474   if (ref $b eq 'HASH') {
2475     my ($b_key) = keys %{$b};
2476     if (ref $a eq 'HASH') {
2477       my ($a_key) = keys %{$a};
2478       if ($a_key eq $b_key) {
2479         return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
2480       } else {
2481         return 0;
2482       }
2483     } else {
2484       return ($a eq $b_key) ? 1 : 0;
2485     }
2486   } else {
2487     if (ref $a eq 'HASH') {
2488       my ($a_key) = keys %{$a};
2489       return ($b eq $a_key) ? 1 : 0;
2490     } else {
2491       return ($b eq $a) ? 1 : 0;
2492     }
2493   }
2494 }
2495
2496 sub _merge_attr {
2497   my ($self, $orig, $import) = @_;
2498
2499   return $import unless defined($orig);
2500   return $orig unless defined($import);
2501
2502   $orig = $self->_rollout_attr($orig);
2503   $import = $self->_rollout_attr($import);
2504
2505   my $seen_keys;
2506   foreach my $import_element ( @{$import} ) {
2507     # find best candidate from $orig to merge $b_element into
2508     my $best_candidate = { position => undef, score => 0 }; my $position = 0;
2509     foreach my $orig_element ( @{$orig} ) {
2510       my $score = $self->_calculate_score( $orig_element, $import_element );
2511       if ($score > $best_candidate->{score}) {
2512         $best_candidate->{position} = $position;
2513         $best_candidate->{score} = $score;
2514       }
2515       $position++;
2516     }
2517     my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
2518
2519     if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
2520       push( @{$orig}, $import_element );
2521     } else {
2522       my $orig_best = $orig->[$best_candidate->{position}];
2523       # merge orig_best and b_element together and replace original with merged
2524       if (ref $orig_best ne 'HASH') {
2525         $orig->[$best_candidate->{position}] = $import_element;
2526       } elsif (ref $import_element eq 'HASH') {
2527         my ($key) = keys %{$orig_best};
2528         $orig->[$best_candidate->{position}] = { $key => $self->_merge_attr($orig_best->{$key}, $import_element->{$key}) };
2529       }
2530     }
2531     $seen_keys->{$import_key} = 1; # don't merge the same key twice
2532   }
2533
2534   return $orig;
2535 }
2536
2537 sub result_source {
2538     my $self = shift;
2539
2540     if (@_) {
2541         $self->_source_handle($_[0]->handle);
2542     } else {
2543         $self->_source_handle->resolve;
2544     }
2545 }
2546
2547 =head2 throw_exception
2548
2549 See L<DBIx::Class::Schema/throw_exception> for details.
2550
2551 =cut
2552
2553 sub throw_exception {
2554   my $self=shift;
2555   if (ref $self && $self->_source_handle->schema) {
2556     $self->_source_handle->schema->throw_exception(@_)
2557   } else {
2558     croak(@_);
2559   }
2560
2561 }
2562
2563 # XXX: FIXME: Attributes docs need clearing up
2564
2565 =head1 ATTRIBUTES
2566
2567 Attributes are used to refine a ResultSet in various ways when
2568 searching for data. They can be passed to any method which takes an
2569 C<\%attrs> argument. See L</search>, L</search_rs>, L</find>,
2570 L</count>.
2571
2572 These are in no particular order:
2573
2574 =head2 order_by
2575
2576 =over 4
2577
2578 =item Value: ( $order_by | \@order_by | \%order_by )
2579
2580 =back
2581
2582 Which column(s) to order the results by. If a single column name, or
2583 an arrayref of names is supplied, the argument is passed through
2584 directly to SQL. The hashref syntax allows for connection-agnostic
2585 specification of ordering direction:
2586
2587  For descending order:
2588
2589   order_by => { -desc => [qw/col1 col2 col3/] }
2590
2591  For explicit ascending order:
2592
2593   order_by => { -asc => 'col' }
2594
2595 The old scalarref syntax (i.e. order_by => \'year DESC') is still
2596 supported, although you are strongly encouraged to use the hashref
2597 syntax as outlined above.
2598
2599 =head2 columns
2600
2601 =over 4
2602
2603 =item Value: \@columns
2604
2605 =back
2606
2607 Shortcut to request a particular set of columns to be retrieved. Each
2608 column spec may be a string (a table column name), or a hash (in which
2609 case the key is the C<as> value, and the value is used as the C<select>
2610 expression). Adds C<me.> onto the start of any column without a C<.> in
2611 it and sets C<select> from that, then auto-populates C<as> from
2612 C<select> as normal. (You may also use the C<cols> attribute, as in
2613 earlier versions of DBIC.)
2614
2615 =head2 +columns
2616
2617 =over 4
2618
2619 =item Value: \@columns
2620
2621 =back
2622
2623 Indicates additional columns to be selected from storage. Works the same
2624 as L</columns> but adds columns to the selection. (You may also use the
2625 C<include_columns> attribute, as in earlier versions of DBIC). For
2626 example:-
2627
2628   $schema->resultset('CD')->search(undef, {
2629     '+columns' => ['artist.name'],
2630     join => ['artist']
2631   });
2632
2633 would return all CDs and include a 'name' column to the information
2634 passed to object inflation. Note that the 'artist' is the name of the
2635 column (or relationship) accessor, and 'name' is the name of the column
2636 accessor in the related table.
2637
2638 =head2 include_columns
2639
2640 =over 4
2641
2642 =item Value: \@columns
2643
2644 =back
2645
2646 Deprecated.  Acts as a synonym for L</+columns> for backward compatibility.
2647
2648 =head2 select
2649
2650 =over 4
2651
2652 =item Value: \@select_columns
2653
2654 =back
2655
2656 Indicates which columns should be selected from the storage. You can use
2657 column names, or in the case of RDBMS back ends, function or stored procedure
2658 names:
2659
2660   $rs = $schema->resultset('Employee')->search(undef, {
2661     select => [
2662       'name',
2663       { count => 'employeeid' },
2664       { sum => 'salary' }
2665     ]
2666   });
2667
2668 When you use function/stored procedure names and do not supply an C<as>
2669 attribute, the column names returned are storage-dependent. E.g. MySQL would
2670 return a column named C<count(employeeid)> in the above example.
2671
2672 =head2 +select
2673
2674 =over 4
2675
2676 Indicates additional columns to be selected from storage.  Works the same as
2677 L</select> but adds columns to the selection.
2678
2679 =back
2680
2681 =head2 +as
2682
2683 =over 4
2684
2685 Indicates additional column names for those added via L</+select>. See L</as>.
2686
2687 =back
2688
2689 =head2 as
2690
2691 =over 4
2692
2693 =item Value: \@inflation_names
2694
2695 =back
2696
2697 Indicates column names for object inflation. That is, C<as>
2698 indicates the name that the column can be accessed as via the
2699 C<get_column> method (or via the object accessor, B<if one already
2700 exists>).  It has nothing to do with the SQL code C<SELECT foo AS bar>.
2701
2702 The C<as> attribute is used in conjunction with C<select>,
2703 usually when C<select> contains one or more function or stored
2704 procedure names:
2705
2706   $rs = $schema->resultset('Employee')->search(undef, {
2707     select => [
2708       'name',
2709       { count => 'employeeid' }
2710     ],
2711     as => ['name', 'employee_count'],
2712   });
2713
2714   my $employee = $rs->first(); # get the first Employee
2715
2716 If the object against which the search is performed already has an accessor
2717 matching a column name specified in C<as>, the value can be retrieved using
2718 the accessor as normal:
2719
2720   my $name = $employee->name();
2721
2722 If on the other hand an accessor does not exist in the object, you need to
2723 use C<get_column> instead:
2724
2725   my $employee_count = $employee->get_column('employee_count');
2726
2727 You can create your own accessors if required - see
2728 L<DBIx::Class::Manual::Cookbook> for details.
2729
2730 Please note: This will NOT insert an C<AS employee_count> into the SQL
2731 statement produced, it is used for internal access only. Thus
2732 attempting to use the accessor in an C<order_by> clause or similar
2733 will fail miserably.
2734
2735 To get around this limitation, you can supply literal SQL to your
2736 C<select> attibute that contains the C<AS alias> text, eg:
2737
2738   select => [\'myfield AS alias']
2739
2740 =head2 join
2741
2742 =over 4
2743
2744 =item Value: ($rel_name | \@rel_names | \%rel_names)
2745
2746 =back
2747
2748 Contains a list of relationships that should be joined for this query.  For
2749 example:
2750
2751   # Get CDs by Nine Inch Nails
2752   my $rs = $schema->resultset('CD')->search(
2753     { 'artist.name' => 'Nine Inch Nails' },
2754     { join => 'artist' }
2755   );
2756
2757 Can also contain a hash reference to refer to the other relation's relations.
2758 For example:
2759
2760   package MyApp::Schema::Track;
2761   use base qw/DBIx::Class/;
2762   __PACKAGE__->table('track');
2763   __PACKAGE__->add_columns(qw/trackid cd position title/);
2764   __PACKAGE__->set_primary_key('trackid');
2765   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
2766   1;
2767
2768   # In your application
2769   my $rs = $schema->resultset('Artist')->search(
2770     { 'track.title' => 'Teardrop' },
2771     {
2772       join     => { cd => 'track' },
2773       order_by => 'artist.name',
2774     }
2775   );
2776
2777 You need to use the relationship (not the table) name in  conditions,
2778 because they are aliased as such. The current table is aliased as "me", so
2779 you need to use me.column_name in order to avoid ambiguity. For example:
2780
2781   # Get CDs from 1984 with a 'Foo' track
2782   my $rs = $schema->resultset('CD')->search(
2783     {
2784       'me.year' => 1984,
2785       'tracks.name' => 'Foo'
2786     },
2787     { join => 'tracks' }
2788   );
2789
2790 If the same join is supplied twice, it will be aliased to <rel>_2 (and
2791 similarly for a third time). For e.g.
2792
2793   my $rs = $schema->resultset('Artist')->search({
2794     'cds.title'   => 'Down to Earth',
2795     'cds_2.title' => 'Popular',
2796   }, {
2797     join => [ qw/cds cds/ ],
2798   });
2799
2800 will return a set of all artists that have both a cd with title 'Down
2801 to Earth' and a cd with title 'Popular'.
2802
2803 If you want to fetch related objects from other tables as well, see C<prefetch>
2804 below.
2805
2806 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
2807
2808 =head2 prefetch
2809
2810 =over 4
2811
2812 =item Value: ($rel_name | \@rel_names | \%rel_names)
2813
2814 =back
2815
2816 Contains one or more relationships that should be fetched along with
2817 the main query (when they are accessed afterwards the data will
2818 already be available, without extra queries to the database).  This is
2819 useful for when you know you will need the related objects, because it
2820 saves at least one query:
2821
2822   my $rs = $schema->resultset('Tag')->search(
2823     undef,
2824     {
2825       prefetch => {
2826         cd => 'artist'
2827       }
2828     }
2829   );
2830
2831 The initial search results in SQL like the following:
2832
2833   SELECT tag.*, cd.*, artist.* FROM tag
2834   JOIN cd ON tag.cd = cd.cdid
2835   JOIN artist ON cd.artist = artist.artistid
2836
2837 L<DBIx::Class> has no need to go back to the database when we access the
2838 C<cd> or C<artist> relationships, which saves us two SQL statements in this
2839 case.
2840
2841 Simple prefetches will be joined automatically, so there is no need
2842 for a C<join> attribute in the above search.
2843
2844 C<prefetch> can be used with the following relationship types: C<belongs_to>,
2845 C<has_one> (or if you're using C<add_relationship>, any relationship declared
2846 with an accessor type of 'single' or 'filter'). A more complex example that
2847 prefetches an artists cds, the tracks on those cds, and the tags associted
2848 with that artist is given below (assuming many-to-many from artists to tags):
2849
2850  my $rs = $schema->resultset('Artist')->search(
2851    undef,
2852    {
2853      prefetch => [
2854        { cds => 'tracks' },
2855        { artist_tags => 'tags' }
2856      ]
2857    }
2858  );
2859
2860
2861 B<NOTE:> If you specify a C<prefetch> attribute, the C<join> and C<select>
2862 attributes will be ignored.
2863
2864 =head2 page
2865
2866 =over 4
2867
2868 =item Value: $page
2869
2870 =back
2871
2872 Makes the resultset paged and specifies the page to retrieve. Effectively
2873 identical to creating a non-pages resultset and then calling ->page($page)
2874 on it.
2875
2876 If L<rows> attribute is not specified it defualts to 10 rows per page.
2877
2878 When you have a paged resultset, L</count> will only return the number
2879 of rows in the page. To get the total, use the L</pager> and call
2880 C<total_entries> on it.
2881
2882 =head2 rows
2883
2884 =over 4
2885
2886 =item Value: $rows
2887
2888 =back
2889
2890 Specifes the maximum number of rows for direct retrieval or the number of
2891 rows per page if the page attribute or method is used.
2892
2893 =head2 offset
2894
2895 =over 4
2896
2897 =item Value: $offset
2898
2899 =back
2900
2901 Specifies the (zero-based) row number for the  first row to be returned, or the
2902 of the first row of the first page if paging is used.
2903
2904 =head2 group_by
2905
2906 =over 4
2907
2908 =item Value: \@columns
2909
2910 =back
2911
2912 A arrayref of columns to group by. Can include columns of joined tables.
2913
2914   group_by => [qw/ column1 column2 ... /]
2915
2916 =head2 having
2917
2918 =over 4
2919
2920 =item Value: $condition
2921
2922 =back
2923
2924 HAVING is a select statement attribute that is applied between GROUP BY and
2925 ORDER BY. It is applied to the after the grouping calculations have been
2926 done.
2927
2928   having => { 'count(employee)' => { '>=', 100 } }
2929
2930 =head2 distinct
2931
2932 =over 4
2933
2934 =item Value: (0 | 1)
2935
2936 =back
2937
2938 Set to 1 to group by all columns.
2939
2940 =head2 where
2941
2942 =over 4
2943
2944 Adds to the WHERE clause.
2945
2946   # only return rows WHERE deleted IS NULL for all searches
2947   __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
2948
2949 Can be overridden by passing C<{ where => undef }> as an attribute
2950 to a resulset.
2951
2952 =back
2953
2954 =head2 cache
2955
2956 Set to 1 to cache search results. This prevents extra SQL queries if you
2957 revisit rows in your ResultSet:
2958
2959   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
2960
2961   while( my $artist = $resultset->next ) {
2962     ... do stuff ...
2963   }
2964
2965   $rs->first; # without cache, this would issue a query
2966
2967 By default, searches are not cached.
2968
2969 For more examples of using these attributes, see
2970 L<DBIx::Class::Manual::Cookbook>.
2971
2972 =head2 from
2973
2974 =over 4
2975
2976 =item Value: \@from_clause
2977
2978 =back
2979
2980 The C<from> attribute gives you manual control over the C<FROM> clause of SQL
2981 statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
2982 clauses.
2983
2984 NOTE: Use this on your own risk.  This allows you to shoot off your foot!
2985
2986 C<join> will usually do what you need and it is strongly recommended that you
2987 avoid using C<from> unless you cannot achieve the desired result using C<join>.
2988 And we really do mean "cannot", not just tried and failed. Attempting to use
2989 this because you're having problems with C<join> is like trying to use x86
2990 ASM because you've got a syntax error in your C. Trust us on this.
2991
2992 Now, if you're still really, really sure you need to use this (and if you're
2993 not 100% sure, ask the mailing list first), here's an explanation of how this
2994 works.
2995
2996 The syntax is as follows -
2997
2998   [
2999     { <alias1> => <table1> },
3000     [
3001       { <alias2> => <table2>, -join_type => 'inner|left|right' },
3002       [], # nested JOIN (optional)
3003       { <table1.column1> => <table2.column2>, ... (more conditions) },
3004     ],
3005     # More of the above [ ] may follow for additional joins
3006   ]
3007
3008   <table1> <alias1>
3009   JOIN
3010     <table2> <alias2>
3011     [JOIN ...]
3012   ON <table1.column1> = <table2.column2>
3013   <more joins may follow>
3014
3015 An easy way to follow the examples below is to remember the following:
3016
3017     Anything inside "[]" is a JOIN
3018     Anything inside "{}" is a condition for the enclosing JOIN
3019
3020 The following examples utilize a "person" table in a family tree application.
3021 In order to express parent->child relationships, this table is self-joined:
3022
3023     # Person->belongs_to('father' => 'Person');
3024     # Person->belongs_to('mother' => 'Person');
3025
3026 C<from> can be used to nest joins. Here we return all children with a father,
3027 then search against all mothers of those children:
3028
3029   $rs = $schema->resultset('Person')->search(
3030       undef,
3031       {
3032           alias => 'mother', # alias columns in accordance with "from"
3033           from => [
3034               { mother => 'person' },
3035               [
3036                   [
3037                       { child => 'person' },
3038                       [
3039                           { father => 'person' },
3040                           { 'father.person_id' => 'child.father_id' }
3041                       ]
3042                   ],
3043                   { 'mother.person_id' => 'child.mother_id' }
3044               ],
3045           ]
3046       },
3047   );
3048
3049   # Equivalent SQL:
3050   # SELECT mother.* FROM person mother
3051   # JOIN (
3052   #   person child
3053   #   JOIN person father
3054   #   ON ( father.person_id = child.father_id )
3055   # )
3056   # ON ( mother.person_id = child.mother_id )
3057
3058 The type of any join can be controlled manually. To search against only people
3059 with a father in the person table, we could explicitly use C<INNER JOIN>:
3060
3061     $rs = $schema->resultset('Person')->search(
3062         undef,
3063         {
3064             alias => 'child', # alias columns in accordance with "from"
3065             from => [
3066                 { child => 'person' },
3067                 [
3068                     { father => 'person', -join_type => 'inner' },
3069                     { 'father.id' => 'child.father_id' }
3070                 ],
3071             ]
3072         },
3073     );
3074
3075     # Equivalent SQL:
3076     # SELECT child.* FROM person child
3077     # INNER JOIN person father ON child.father_id = father.id
3078
3079 If you need to express really complex joins or you need a subselect, you
3080 can supply literal SQL to C<from> via a scalar reference. In this case
3081 the contents of the scalar will replace the table name asscoiated with the
3082 resultsource.
3083
3084 WARNING: This technique might very well not work as expected on chained
3085 searches - you have been warned.
3086
3087     # Assuming the Event resultsource is defined as:
3088
3089         MySchema::Event->add_columns (
3090             sequence => {
3091                 data_type => 'INT',
3092                 is_auto_increment => 1,
3093             },
3094             location => {
3095                 data_type => 'INT',
3096             },
3097             type => {
3098                 data_type => 'INT',
3099             },
3100         );
3101         MySchema::Event->set_primary_key ('sequence');
3102
3103     # This will get back the latest event for every location. The column
3104     # selector is still provided by DBIC, all we do is add a JOIN/WHERE
3105     # combo to limit the resultset
3106
3107     $rs = $schema->resultset('Event');
3108     $table = $rs->result_source->name;
3109     $latest = $rs->search (
3110         undef,
3111         { from => \ "
3112             (SELECT e1.* FROM $table e1
3113                 JOIN $table e2
3114                     ON e1.location = e2.location
3115                     AND e1.sequence < e2.sequence
3116                 WHERE e2.sequence is NULL
3117             ) me",
3118         },
3119     );
3120
3121     # Equivalent SQL (with the DBIC chunks added):
3122
3123     SELECT me.sequence, me.location, me.type FROM
3124        (SELECT e1.* FROM events e1
3125            JOIN events e2
3126                ON e1.location = e2.location
3127                AND e1.sequence < e2.sequence
3128            WHERE e2.sequence is NULL
3129        ) me;
3130
3131 =head2 for
3132
3133 =over 4
3134
3135 =item Value: ( 'update' | 'shared' )
3136
3137 =back
3138
3139 Set to 'update' for a SELECT ... FOR UPDATE or 'shared' for a SELECT
3140 ... FOR SHARED.
3141
3142 =cut
3143
3144 1;