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