lib/DBIx/Class/ResultSet.pm

   1 package DBIx::Class::ResultSet;
   2
   3 use strict;
   4 use warnings;
   5 use base qw/DBIx::Class/;
   6 use DBIx::Class::Carp;
   7 use DBIx::Class::Exception;
   8 use DBIx::Class::ResultSetColumn;
   9 use Scalar::Util qw/blessed weaken/;
  10 use Try::Tiny;
  11 use Data::Compare (); # no imports!!! guard against insane architecture
  12
  13 # not importing first() as it will clash with our own method
  14 use List::Util ();
  15
  16 BEGIN {
  17   # De-duplication in _merge_attr() is disabled, but left in for reference
  18   # (the merger is used for other things that ought not to be de-duped)
  19   *__HM_DEDUP = sub () { 0 };
  20 }
  21
  22 use namespace::clean;
  23
  24 use overload
  25         '0+'     => "count",
  26         'bool'   => "_bool",
  27         fallback => 1;
  28
  29 __PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/);
  30
  31 =head1 NAME
  32
  33 DBIx::Class::ResultSet - Represents a query used for fetching a set of results.
  34
  35 =head1 SYNOPSIS
  36
  37   my $users_rs   = $schema->resultset('User');
  38   while( $user = $users_rs->next) {
  39     print $user->username;
  40   }
  41
  42   my $registered_users_rs   = $schema->resultset('User')->search({ registered => 1 });
  43   my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all();
  44
  45 =head1 DESCRIPTION
  46
  47 A ResultSet is an object which stores a set of conditions representing
  48 a query. It is the backbone of DBIx::Class (i.e. the really
  49 important/useful bit).
  50
  51 No SQL is executed on the database when a ResultSet is created, it
  52 just stores all the conditions needed to create the query.
  53
  54 A basic ResultSet representing the data of an entire table is returned
  55 by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
  56 L<Source|DBIx::Class::Manual::Glossary/Source> name.
  57
  58   my $users_rs = $schema->resultset('User');
  59
  60 A new ResultSet is returned from calling L</search> on an existing
  61 ResultSet. The new one will contain all the conditions of the
  62 original, plus any new conditions added in the C<search> call.
  63
  64 A ResultSet also incorporates an implicit iterator. L</next> and L</reset>
  65 can be used to walk through all the L<DBIx::Class::Row>s the ResultSet
  66 represents.
  67
  68 The query that the ResultSet represents is B<only> executed against
  69 the database when these methods are called:
  70 L</find>, L</next>, L</all>, L</first>, L</single>, L</count>.
  71
  72 If a resultset is used in a numeric context it returns the L</count>.
  73 However, if it is used in a boolean context it is B<always> true.  So if
  74 you want to check if a resultset has any results, you must use C<if $rs
  75 != 0>.
  76
  77 =head1 CUSTOM ResultSet CLASSES THAT USE Moose
  78
  79 If you want to make your custom ResultSet classes with L<Moose>, use a template
  80 similar to:
  81
  82     package MyApp::Schema::ResultSet::User;
  83
  84     use Moose;
  85     use namespace::autoclean;
  86     use MooseX::NonMoose;
  87     extends 'DBIx::Class::ResultSet';
  88
  89     sub BUILDARGS { $_[2] }
  90
  91     ...your code...
  92
  93     __PACKAGE__->meta->make_immutable;
  94
  95     1;
  96
  97 The L<MooseX::NonMoose> is necessary so that the L<Moose> constructor does not
  98 clash with the regular ResultSet constructor. Alternatively, you can use:
  99
 100     __PACKAGE__->meta->make_immutable(inline_constructor => 0);
 101
 102 The L<BUILDARGS|Moose::Manual::Construction/BUILDARGS> is necessary because the
 103 signature of the ResultSet C<new> is C<< ->new($source, \%args) >>.
 104
 105 =head1 EXAMPLES
 106
 107 =head2 Chaining resultsets
 108
 109 Let's say you've got a query that needs to be run to return some data
 110 to the user. But, you have an authorization system in place that
 111 prevents certain users from seeing certain information. So, you want
 112 to construct the basic query in one method, but add constraints to it in
 113 another.
 114
 115   sub get_data {
 116     my $self = shift;
 117     my $request = $self->get_request; # Get a request object somehow.
 118     my $schema = $self->result_source->schema;
 119
 120     my $cd_rs = $schema->resultset('CD')->search({
 121       title => $request->param('title'),
 122       year => $request->param('year'),
 123     });
 124
 125     $cd_rs = $self->apply_security_policy( $cd_rs );
 126
 127     return $cd_rs->all();
 128   }
 129
 130   sub apply_security_policy {
 131     my $self = shift;
 132     my ($rs) = @_;
 133
 134     return $rs->search({
 135       subversive => 0,
 136     });
 137   }
 138
 139 =head3 Resolving conditions and attributes
 140
 141 When a resultset is chained from another resultset, conditions and
 142 attributes with the same keys need resolving.
 143
 144 L</join>, L</prefetch>, L</+select>, L</+as> attributes are merged
 145 into the existing ones from the original resultset.
 146
 147 The L</where> and L</having> attributes, and any search conditions, are
 148 merged with an SQL C<AND> to the existing condition from the original
 149 resultset.
 150
 151 All other attributes are overridden by any new ones supplied in the
 152 search attributes.
 153
 154 =head2 Multiple queries
 155
 156 Since a resultset just defines a query, you can do all sorts of
 157 things with it with the same object.
 158
 159   # Don't hit the DB yet.
 160   my $cd_rs = $schema->resultset('CD')->search({
 161     title => 'something',
 162     year => 2009,
 163   });
 164
 165   # Each of these hits the DB individually.
 166   my $count = $cd_rs->count;
 167   my $most_recent = $cd_rs->get_column('date_released')->max();
 168   my @records = $cd_rs->all;
 169
 170 And it's not just limited to SELECT statements.
 171
 172   $cd_rs->delete();
 173
 174 This is even cooler:
 175
 176   $cd_rs->create({ artist => 'Fred' });
 177
 178 Which is the same as:
 179
 180   $schema->resultset('CD')->create({
 181     title => 'something',
 182     year => 2009,
 183     artist => 'Fred'
 184   });
 185
 186 See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
 187
 188 =head1 METHODS
 189
 190 =head2 new
 191
 192 =over 4
 193
 194 =item Arguments: $source, \%$attrs
 195
 196 =item Return Value: $rs
 197
 198 =back
 199
 200 The resultset constructor. Takes a source object (usually a
 201 L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
 202 L</ATTRIBUTES> below).  Does not perform any queries -- these are
 203 executed as needed by the other methods.
 204
 205 Generally you won't need to construct a resultset manually.  You'll
 206 automatically get one from e.g. a L</search> called in scalar context:
 207
 208   my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
 209
 210 IMPORTANT: If called on an object, proxies to new_result instead so
 211
 212   my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
 213
 214 will return a CD object, not a ResultSet.
 215
 216 =cut
 217
 218 sub new {
 219   my $class = shift;
 220   return $class->new_result(@_) if ref $class;
 221
 222   my ($source, $attrs) = @_;
 223   $source = $source->resolve
 224     if $source->isa('DBIx::Class::ResultSourceHandle');
 225   $attrs = { %{$attrs||{}} };
 226
 227   if ($attrs->{page}) {
 228     $attrs->{rows} ||= 10;
 229   }
 230
 231   $attrs->{alias} ||= 'me';
 232
 233   my $self = bless {
 234     result_source => $source,
 235     cond => $attrs->{where},
 236     pager => undef,
 237     attrs => $attrs,
 238   }, $class;
 239
 240   # if there is a dark selector, this means we are already in a
 241   # chain and the cleanup/sanification was taken care of by
 242   # _search_rs already
 243   $self->_normalize_selection($attrs)
 244     unless $attrs->{_dark_selector};
 245
 246   $self->result_class(
 247     $attrs->{result_class} || $source->result_class
 248   );
 249
 250   $self;
 251 }
 252
 253 =head2 search
 254
 255 =over 4
 256
 257 =item Arguments: $cond, \%attrs?
 258
 259 =item Return Value: $resultset (scalar context) ||  @row_objs (list context)
 260
 261 =back
 262
 263   my @cds    = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
 264   my $new_rs = $cd_rs->search({ year => 2005 });
 265
 266   my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
 267                  # year = 2005 OR year = 2004
 268
 269 In list context, C<< ->all() >> is called implicitly on the resultset, thus
 270 returning a list of row objects instead. To avoid that, use L</search_rs>.
 271
 272 If you need to pass in additional attributes but no additional condition,
 273 call it as C<search(undef, \%attrs)>.
 274
 275   # "SELECT name, artistid FROM $artist_table"
 276   my @all_artists = $schema->resultset('Artist')->search(undef, {
 277     columns => [qw/name artistid/],
 278   });
 279
 280 For a list of attributes that can be passed to C<search>, see
 281 L</ATTRIBUTES>. For more examples of using this function, see
 282 L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
 283 documentation for the first argument, see L<SQL::Abstract>
 284 and its extension L<DBIx::Class::SQLMaker>.
 285
 286 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
 287
 288 =head3 CAVEAT
 289
 290 Note that L</search> does not process/deflate any of the values passed in the
 291 L<SQL::Abstract>-compatible search condition structure. This is unlike other
 292 condition-bound methods L</new>, L</create> and L</find>. The user must ensure
 293 manually that any value passed to this method will stringify to something the
 294 RDBMS knows how to deal with. A notable example is the handling of L<DateTime>
 295 objects, for more info see:
 296 L<DBIx::Class::Manual::Cookbook/Formatting DateTime objects in queries>.
 297
 298 =cut
 299
 300 sub search {
 301   my $self = shift;
 302   my $rs = $self->search_rs( @_ );
 303
 304   if (wantarray) {
 305     return $rs->all;
 306   }
 307   elsif (defined wantarray) {
 308     return $rs;
 309   }
 310   else {
 311     # we can be called by a relationship helper, which in
 312     # turn may be called in void context due to some braindead
 313     # overload or whatever else the user decided to be clever
 314     # at this particular day. Thus limit the exception to
 315     # external code calls only
 316     $self->throw_exception ('->search is *not* a mutator, calling it in void context makes no sense')
 317       if (caller)[0] !~ /^\QDBIx::Class::/;
 318
 319     return ();
 320   }
 321 }
 322
 323 =head2 search_rs
 324
 325 =over 4
 326
 327 =item Arguments: $cond, \%attrs?
 328
 329 =item Return Value: $resultset
 330
 331 =back
 332
 333 This method does the same exact thing as search() except it will
 334 always return a resultset, even in list context.
 335
 336 =cut
 337
 338 sub search_rs {
 339   my $self = shift;
 340
 341   # Special-case handling for (undef, undef).
 342   if ( @_ == 2 && !defined $_[1] && !defined $_[0] ) {
 343     @_ = ();
 344   }
 345
 346   my $call_attrs = {};
 347   if (@_ > 1) {
 348     if (ref $_[-1] eq 'HASH') {
 349       # copy for _normalize_selection
 350       $call_attrs = { %{ pop @_ } };
 351     }
 352     elsif (! defined $_[-1] ) {
 353       pop @_;   # search({}, undef)
 354     }
 355   }
 356
 357   # see if we can keep the cache (no $rs changes)
 358   my $cache;
 359   my %safe = (alias => 1, cache => 1);
 360   if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and (
 361     ! defined $_[0]
 362       or
 363     ref $_[0] eq 'HASH' && ! keys %{$_[0]}
 364       or
 365     ref $_[0] eq 'ARRAY' && ! @{$_[0]}
 366   )) {
 367     $cache = $self->get_cache;
 368   }
 369
 370   my $rsrc = $self->result_source;
 371
 372   my $old_attrs = { %{$self->{attrs}} };
 373   my $old_having = delete $old_attrs->{having};
 374   my $old_where = delete $old_attrs->{where};
 375
 376   my $new_attrs = { %$old_attrs };
 377
 378   # take care of call attrs (only if anything is changing)
 379   if (keys %$call_attrs) {
 380
 381     my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/;
 382
 383     # reset the current selector list if new selectors are supplied
 384     if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) {
 385       delete @{$old_attrs}{(@selector_attrs, '_dark_selector')};
 386     }
 387
 388     # Normalize the new selector list (operates on the passed-in attr structure)
 389     # Need to do it on every chain instead of only once on _resolved_attrs, in
 390     # order to allow detection of empty vs partial 'as'
 391     $call_attrs->{_dark_selector} = $old_attrs->{_dark_selector}
 392       if $old_attrs->{_dark_selector};
 393     $self->_normalize_selection ($call_attrs);
 394
 395     # start with blind overwriting merge, exclude selector attrs
 396     $new_attrs = { %{$old_attrs}, %{$call_attrs} };
 397     delete @{$new_attrs}{@selector_attrs};
 398
 399     for (@selector_attrs) {
 400       $new_attrs->{$_} = $self->_merge_attr($old_attrs->{$_}, $call_attrs->{$_})
 401         if ( exists $old_attrs->{$_} or exists $call_attrs->{$_} );
 402     }
 403
 404     # older deprecated name, use only if {columns} is not there
 405     if (my $c = delete $new_attrs->{cols}) {
 406       if ($new_attrs->{columns}) {
 407         carp "Resultset specifies both the 'columns' and the legacy 'cols' attributes - ignoring 'cols'";
 408       }
 409       else {
 410         $new_attrs->{columns} = $c;
 411       }
 412     }
 413
 414
 415     # join/prefetch use their own crazy merging heuristics
 416     foreach my $key (qw/join prefetch/) {
 417       $new_attrs->{$key} = $self->_merge_joinpref_attr($old_attrs->{$key}, $call_attrs->{$key})
 418         if exists $call_attrs->{$key};
 419     }
 420
 421     # stack binds together
 422     $new_attrs->{bind} = [ @{ $old_attrs->{bind} || [] }, @{ $call_attrs->{bind} || [] } ];
 423   }
 424
 425
 426   # rip apart the rest of @_, parse a condition
 427   my $call_cond = do {
 428
 429     if (ref $_[0] eq 'HASH') {
 430       (keys %{$_[0]}) ? $_[0] : undef
 431     }
 432     elsif (@_ == 1) {
 433       $_[0]
 434     }
 435     elsif (@_ % 2) {
 436       $self->throw_exception('Odd number of arguments to search')
 437     }
 438     else {
 439       +{ @_ }
 440     }
 441
 442   } if @_;
 443
 444   if( @_ > 1 and ! $rsrc->result_class->isa('DBIx::Class::CDBICompat') ) {
 445     carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead';
 446   }
 447
 448   for ($old_where, $call_cond) {
 449     if (defined $_) {
 450       $new_attrs->{where} = $self->_stack_cond (
 451         $_, $new_attrs->{where}
 452       );
 453     }
 454   }
 455
 456   if (defined $old_having) {
 457     $new_attrs->{having} = $self->_stack_cond (
 458       $old_having, $new_attrs->{having}
 459     )
 460   }
 461
 462   my $rs = (ref $self)->new($rsrc, $new_attrs);
 463
 464   $rs->set_cache($cache) if ($cache);
 465
 466   return $rs;
 467 }
 468
 469 my $dark_sel_dumper;
 470 sub _normalize_selection {
 471   my ($self, $attrs) = @_;
 472
 473   # legacy syntax
 474   $attrs->{'+columns'} = $self->_merge_attr($attrs->{'+columns'}, delete $attrs->{include_columns})
 475     if exists $attrs->{include_columns};
 476
 477   # columns are always placed first, however
 478
 479   # Keep the X vs +X separation until _resolved_attrs time - this allows to
 480   # delay the decision on whether to use a default select list ($rsrc->columns)
 481   # allowing stuff like the remove_columns helper to work
 482   #
 483   # select/as +select/+as pairs need special handling - the amount of select/as
 484   # elements in each pair does *not* have to be equal (think multicolumn
 485   # selectors like distinct(foo, bar) ). If the selector is bare (no 'as'
 486   # supplied at all) - try to infer the alias, either from the -as parameter
 487   # of the selector spec, or use the parameter whole if it looks like a column
 488   # name (ugly legacy heuristic). If all fails - leave the selector bare (which
 489   # is ok as well), but make sure no more additions to the 'as' chain take place
 490   for my $pref ('', '+') {
 491
 492     my ($sel, $as) = map {
 493       my $key = "${pref}${_}";
 494
 495       my $val = [ ref $attrs->{$key} eq 'ARRAY'
 496         ? @{$attrs->{$key}}
 497         : $attrs->{$key} || ()
 498       ];
 499       delete $attrs->{$key};
 500       $val;
 501     } qw/select as/;
 502
 503     if (! @$as and ! @$sel ) {
 504       next;
 505     }
 506     elsif (@$as and ! @$sel) {
 507       $self->throw_exception(
 508         "Unable to handle ${pref}as specification (@$as) without a corresponding ${pref}select"
 509       );
 510     }
 511     elsif( ! @$as ) {
 512       # no as part supplied at all - try to deduce (unless explicit end of named selection is declared)
 513       # if any @$as has been supplied we assume the user knows what (s)he is doing
 514       # and blindly keep stacking up pieces
 515       unless ($attrs->{_dark_selector}) {
 516         SELECTOR:
 517         for (@$sel) {
 518           if ( ref $_ eq 'HASH' and exists $_->{-as} ) {
 519             push @$as, $_->{-as};
 520           }
 521           # assume any plain no-space, no-parenthesis string to be a column spec
 522           # FIXME - this is retarded but is necessary to support shit like 'count(foo)'
 523           elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) {
 524             push @$as, $_;
 525           }
 526           # if all else fails - raise a flag that no more aliasing will be allowed
 527           else {
 528             $attrs->{_dark_selector} = {
 529               plus_stage => $pref,
 530               string => ($dark_sel_dumper ||= do {
 531                   require Data::Dumper::Concise;
 532                   Data::Dumper::Concise::DumperObject()->Indent(0);
 533                 })->Values([$_])->Dump
 534               ,
 535             };
 536             last SELECTOR;
 537           }
 538         }
 539       }
 540     }
 541     elsif (@$as < @$sel) {
 542       $self->throw_exception(
 543         "Unable to handle an ${pref}as specification (@$as) with less elements than the corresponding ${pref}select"
 544       );
 545     }
 546     elsif ($pref and $attrs->{_dark_selector}) {
 547       $self->throw_exception(
 548         "Unable to process named '+select', resultset contains an unnamed selector $attrs->{_dark_selector}{string}"
 549       );
 550     }
 551
 552
 553     # merge result
 554     $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel);
 555     $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as);
 556   }
 557 }
 558
 559 sub _stack_cond {
 560   my ($self, $left, $right) = @_;
 561
 562   # collapse single element top-level conditions
 563   # (single pass only, unlikely to need recursion)
 564   for ($left, $right) {
 565     if (ref $_ eq 'ARRAY') {
 566       if (@$_ == 0) {
 567         $_ = undef;
 568       }
 569       elsif (@$_ == 1) {
 570         $_ = $_->[0];
 571       }
 572     }
 573     elsif (ref $_ eq 'HASH') {
 574       my ($first, $more) = keys %$_;
 575
 576       # empty hash
 577       if (! defined $first) {
 578         $_ = undef;
 579       }
 580       # one element hash
 581       elsif (! defined $more) {
 582         if ($first eq '-and' and ref $_->{'-and'} eq 'HASH') {
 583           $_ = $_->{'-and'};
 584         }
 585         elsif ($first eq '-or' and ref $_->{'-or'} eq 'ARRAY') {
 586           $_ = $_->{'-or'};
 587         }
 588       }
 589     }
 590   }
 591
 592   # merge hashes with weeding out of duplicates (simple cases only)
 593   if (ref $left eq 'HASH' and ref $right eq 'HASH') {
 594
 595     # shallow copy to destroy
 596     $right = { %$right };
 597     for (grep { exists $right->{$_} } keys %$left) {
 598       # the use of eq_deeply here is justified - the rhs of an
 599       # expression can contain a lot of twisted weird stuff
 600       delete $right->{$_} if Data::Compare::Compare( $left->{$_}, $right->{$_} );
 601     }
 602
 603     $right = undef unless keys %$right;
 604   }
 605
 606
 607   if (defined $left xor defined $right) {
 608     return defined $left ? $left : $right;
 609   }
 610   elsif (! defined $left) {
 611     return undef;
 612   }
 613   else {
 614     return { -and => [ $left, $right ] };
 615   }
 616 }
 617
 618 =head2 search_literal
 619
 620 =over 4
 621
 622 =item Arguments: $sql_fragment, @bind_values
 623
 624 =item Return Value: $resultset (scalar context) || @row_objs (list context)
 625
 626 =back
 627
 628   my @cds   = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
 629   my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
 630
 631 Pass a literal chunk of SQL to be added to the conditional part of the
 632 resultset query.
 633
 634 CAVEAT: C<search_literal> is provided for Class::DBI compatibility and should
 635 only be used in that context. C<search_literal> is a convenience method.
 636 It is equivalent to calling $schema->search(\[]), but if you want to ensure
 637 columns are bound correctly, use C<search>.
 638
 639 Example of how to use C<search> instead of C<search_literal>
 640
 641   my @cds = $cd_rs->search_literal('cdid = ? AND (artist = ? OR artist = ?)', (2, 1, 2));
 642   my @cds = $cd_rs->search(\[ 'cdid = ? AND (artist = ? OR artist = ?)', [ 'cdid', 2 ], [ 'artist', 1 ], [ 'artist', 2 ] ]);
 643
 644
 645 See L<DBIx::Class::Manual::Cookbook/Searching> and
 646 L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
 647 require C<search_literal>.
 648
 649 =cut
 650
 651 sub search_literal {
 652   my ($self, $sql, @bind) = @_;
 653   my $attr;
 654   if ( @bind && ref($bind[-1]) eq 'HASH' ) {
 655     $attr = pop @bind;
 656   }
 657   return $self->search(\[ $sql, map [ __DUMMY__ => $_ ], @bind ], ($attr || () ));
 658 }
 659
 660 =head2 find
 661
 662 =over 4
 663
 664 =item Arguments: \%columns_values | @pk_values, \%attrs?
 665
 666 =item Return Value: $row_object | undef
 667
 668 =back
 669
 670 Finds and returns a single row based on supplied criteria. Takes either a
 671 hashref with the same format as L</create> (including inference of foreign
 672 keys from related objects), or a list of primary key values in the same
 673 order as the L<primary columns|DBIx::Class::ResultSource/primary_columns>
 674 declaration on the L</result_source>.
 675
 676 In either case an attempt is made to combine conditions already existing on
 677 the resultset with the condition passed to this method.
 678
 679 To aid with preparing the correct query for the storage you may supply the
 680 C<key> attribute, which is the name of a
 681 L<unique constraint|DBIx::Class::ResultSource/add_unique_constraint> (the
 682 unique constraint corresponding to the
 683 L<primary columns|DBIx::Class::ResultSource/primary_columns> is always named
 684 C<primary>). If the C<key> attribute has been supplied, and DBIC is unable
 685 to construct a query that satisfies the named unique constraint fully (
 686 non-NULL values for each column member of the constraint) an exception is
 687 thrown.
 688
 689 If no C<key> is specified, the search is carried over all unique constraints
 690 which are fully defined by the available condition.
 691
 692 If no such constraint is found, C<find> currently defaults to a simple
 693 C<< search->(\%column_values) >> which may or may not do what you expect.
 694 Note that this fallback behavior may be deprecated in further versions. If
 695 you need to search with arbitrary conditions - use L</search>. If the query
 696 resulting from this fallback produces more than one row, a warning to the
 697 effect is issued, though only the first row is constructed and returned as
 698 C<$row_object>.
 699
 700 In addition to C<key>, L</find> recognizes and applies standard
 701 L<resultset attributes|/ATTRIBUTES> in the same way as L</search> does.
 702
 703 Note that if you have extra concerns about the correctness of the resulting
 704 query you need to specify the C<key> attribute and supply the entire condition
 705 as an argument to find (since it is not always possible to perform the
 706 combination of the resultset condition with the supplied one, especially if
 707 the resultset condition contains literal sql).
 708
 709 For example, to find a row by its primary key:
 710
 711   my $cd = $schema->resultset('CD')->find(5);
 712
 713 You can also find a row by a specific unique constraint:
 714
 715   my $cd = $schema->resultset('CD')->find(
 716     {
 717       artist => 'Massive Attack',
 718       title  => 'Mezzanine',
 719     },
 720     { key => 'cd_artist_title' }
 721   );
 722
 723 See also L</find_or_create> and L</update_or_create>.
 724
 725 =cut
 726
 727 sub find {
 728   my $self = shift;
 729   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 730
 731   my $rsrc = $self->result_source;
 732
 733   my $constraint_name;
 734   if (exists $attrs->{key}) {
 735     $constraint_name = defined $attrs->{key}
 736       ? $attrs->{key}
 737       : $self->throw_exception("An undefined 'key' resultset attribute makes no sense")
 738     ;
 739   }
 740
 741   # Parse out the condition from input
 742   my $call_cond;
 743
 744   if (ref $_[0] eq 'HASH') {
 745     $call_cond = { %{$_[0]} };
 746   }
 747   else {
 748     # if only values are supplied we need to default to 'primary'
 749     $constraint_name = 'primary' unless defined $constraint_name;
 750
 751     my @c_cols = $rsrc->unique_constraint_columns($constraint_name);
 752
 753     $self->throw_exception(
 754       "No constraint columns, maybe a malformed '$constraint_name' constraint?"
 755     ) unless @c_cols;
 756
 757     $self->throw_exception (
 758       'find() expects either a column/value hashref, or a list of values '
 759     . "corresponding to the columns of the specified unique constraint '$constraint_name'"
 760     ) unless @c_cols == @_;
 761
 762     $call_cond = {};
 763     @{$call_cond}{@c_cols} = @_;
 764   }
 765
 766   my %related;
 767   for my $key (keys %$call_cond) {
 768     if (
 769       my $keyref = ref($call_cond->{$key})
 770         and
 771       my $relinfo = $rsrc->relationship_info($key)
 772     ) {
 773       my $val = delete $call_cond->{$key};
 774
 775       next if $keyref eq 'ARRAY'; # has_many for multi_create
 776
 777       my $rel_q = $rsrc->_resolve_condition(
 778         $relinfo->{cond}, $val, $key, $key
 779       );
 780       die "Can't handle complex relationship conditions in find" if ref($rel_q) ne 'HASH';
 781       @related{keys %$rel_q} = values %$rel_q;
 782     }
 783   }
 784
 785   # relationship conditions take precedence (?)
 786   @{$call_cond}{keys %related} = values %related;
 787
 788   my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
 789   my $final_cond;
 790   if (defined $constraint_name) {
 791     $final_cond = $self->_qualify_cond_columns (
 792
 793       $self->_build_unique_cond (
 794         $constraint_name,
 795         $call_cond,
 796       ),
 797
 798       $alias,
 799     );
 800   }
 801   elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') {
 802     # This means that we got here after a merger of relationship conditions
 803     # in ::Relationship::Base::search_related (the row method), and furthermore
 804     # the relationship is of the 'single' type. This means that the condition
 805     # provided by the relationship (already attached to $self) is sufficient,
 806     # as there can be only one row in the database that would satisfy the
 807     # relationship
 808   }
 809   else {
 810     # no key was specified - fall down to heuristics mode:
 811     # run through all unique queries registered on the resultset, and
 812     # 'OR' all qualifying queries together
 813     my (@unique_queries, %seen_column_combinations);
 814     for my $c_name ($rsrc->unique_constraint_names) {
 815       next if $seen_column_combinations{
 816         join "\x00", sort $rsrc->unique_constraint_columns($c_name)
 817       }++;
 818
 819       push @unique_queries, try {
 820         $self->_build_unique_cond ($c_name, $call_cond, 'croak_on_nulls')
 821       } || ();
 822     }
 823
 824     $final_cond = @unique_queries
 825       ? [ map { $self->_qualify_cond_columns($_, $alias) } @unique_queries ]
 826       : $self->_non_unique_find_fallback ($call_cond, $attrs)
 827     ;
 828   }
 829
 830   # Run the query, passing the result_class since it should propagate for find
 831   my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs});
 832   if ($rs->_resolved_attrs->{collapse}) {
 833     my $row = $rs->next;
 834     carp "Query returned more than one row" if $rs->next;
 835     return $row;
 836   }
 837   else {
 838     return $rs->single;
 839   }
 840 }
 841
 842 # This is a stop-gap method as agreed during the discussion on find() cleanup:
 843 # http://lists.scsys.co.uk/pipermail/dbix-class/2010-October/009535.html
 844 #
 845 # It is invoked when find() is called in legacy-mode with insufficiently-unique
 846 # condition. It is provided for overrides until a saner way forward is devised
 847 #
 848 # *NOTE* This is not a public method, and it's *GUARANTEED* to disappear down
 849 # the road. Please adjust your tests accordingly to catch this situation early
 850 # DBIx::Class::ResultSet->can('_non_unique_find_fallback') is reasonable
 851 #
 852 # The method will not be removed without an adequately complete replacement
 853 # for strict-mode enforcement
 854 sub _non_unique_find_fallback {
 855   my ($self, $cond, $attrs) = @_;
 856
 857   return $self->_qualify_cond_columns(
 858     $cond,
 859     exists $attrs->{alias}
 860       ? $attrs->{alias}
 861       : $self->{attrs}{alias}
 862   );
 863 }
 864
 865
 866 sub _qualify_cond_columns {
 867   my ($self, $cond, $alias) = @_;
 868
 869   my %aliased = %$cond;
 870   for (keys %aliased) {
 871     $aliased{"$alias.$_"} = delete $aliased{$_}
 872       if $_ !~ /\./;
 873   }
 874
 875   return \%aliased;
 876 }
 877
 878 sub _build_unique_cond {
 879   my ($self, $constraint_name, $extra_cond, $croak_on_null) = @_;
 880
 881   my @c_cols = $self->result_source->unique_constraint_columns($constraint_name);
 882
 883   # combination may fail if $self->{cond} is non-trivial
 884   my ($final_cond) = try {
 885     $self->_merge_with_rscond ($extra_cond)
 886   } catch {
 887     +{ %$extra_cond }
 888   };
 889
 890   # trim out everything not in $columns
 891   $final_cond = { map {
 892     exists $final_cond->{$_}
 893       ? ( $_ => $final_cond->{$_} )
 894       : ()
 895   } @c_cols };
 896
 897   if (my @missing = grep
 898     { ! ($croak_on_null ? defined $final_cond->{$_} : exists $final_cond->{$_}) }
 899     (@c_cols)
 900   ) {
 901     $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', no values for column(s): %s",
 902       $constraint_name,
 903       join (', ', map { "'$_'" } @missing),
 904     ) );
 905   }
 906
 907   if (
 908     !$croak_on_null
 909       and
 910     !$ENV{DBIC_NULLABLE_KEY_NOWARN}
 911       and
 912     my @undefs = grep { ! defined $final_cond->{$_} } (keys %$final_cond)
 913   ) {
 914     carp_unique ( sprintf (
 915       "NULL/undef values supplied for requested unique constraint '%s' (NULL "
 916     . 'values in column(s): %s). This is almost certainly not what you wanted, '
 917     . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
 918       $constraint_name,
 919       join (', ', map { "'$_'" } @undefs),
 920     ));
 921   }
 922
 923   return $final_cond;
 924 }
 925
 926 =head2 search_related
 927
 928 =over 4
 929
 930 =item Arguments: $rel, $cond?, \%attrs?
 931
 932 =item Return Value: $new_resultset (scalar context) || @row_objs (list context)
 933
 934 =back
 935
 936   $new_rs = $cd_rs->search_related('artist', {
 937     name => 'Emo-R-Us',
 938   });
 939
 940 Searches the specified relationship, optionally specifying a condition and
 941 attributes for matching records. See L</ATTRIBUTES> for more information.
 942
 943 In list context, C<< ->all() >> is called implicitly on the resultset, thus
 944 returning a list of row objects instead. To avoid that, use L</search_related_rs>.
 945
 946 See also L</search_related_rs>.
 947
 948 =cut
 949
 950 sub search_related {
 951   return shift->related_resultset(shift)->search(@_);
 952 }
 953
 954 =head2 search_related_rs
 955
 956 This method works exactly the same as search_related, except that
 957 it guarantees a resultset, even in list context.
 958
 959 =cut
 960
 961 sub search_related_rs {
 962   return shift->related_resultset(shift)->search_rs(@_);
 963 }
 964
 965 =head2 cursor
 966
 967 =over 4
 968
 969 =item Arguments: none
 970
 971 =item Return Value: $cursor
 972
 973 =back
 974
 975 Returns a storage-driven cursor to the given resultset. See
 976 L<DBIx::Class::Cursor> for more information.
 977
 978 =cut
 979
 980 sub cursor {
 981   my ($self) = @_;
 982
 983   my $attrs = $self->_resolved_attrs_copy;
 984
 985   return $self->{cursor}
 986     ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
 987           $attrs->{where},$attrs);
 988 }
 989
 990 =head2 single
 991
 992 =over 4
 993
 994 =item Arguments: $cond?
 995
 996 =item Return Value: $row_object | undef
 997
 998 =back
 999
1000   my $cd = $schema->resultset('CD')->single({ year => 2001 });
1001
1002 Inflates the first result without creating a cursor if the resultset has
1003 any records in it; if not returns C<undef>. Used by L</find> as a lean version
1004 of L</search>.
1005
1006 While this method can take an optional search condition (just like L</search>)
1007 being a fast-code-path it does not recognize search attributes. If you need to
1008 add extra joins or similar, call L</search> and then chain-call L</single> on the
1009 L<DBIx::Class::ResultSet> returned.
1010
1011 =over
1012
1013 =item B<Note>
1014
1015 As of 0.08100, this method enforces the assumption that the preceding
1016 query returns only one row. If more than one row is returned, you will receive
1017 a warning:
1018
1019   Query returned more than one row
1020
1021 In this case, you should be using L</next> or L</find> instead, or if you really
1022 know what you are doing, use the L</rows> attribute to explicitly limit the size
1023 of the resultset.
1024
1025 This method will also throw an exception if it is called on a resultset prefetching
1026 has_many, as such a prefetch implies fetching multiple rows from the database in
1027 order to assemble the resulting object.
1028
1029 =back
1030
1031 =cut
1032
1033 sub single {
1034   my ($self, $where) = @_;
1035   if(@_ > 2) {
1036       $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()');
1037   }
1038
1039   my $attrs = $self->_resolved_attrs_copy;
1040
1041   $self->throw_exception(
1042     'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead'
1043   ) if $attrs->{collapse};
1044
1045   if ($where) {
1046     if (defined $attrs->{where}) {
1047       $attrs->{where} = {
1048         '-and' =>
1049             [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
1050                $where, delete $attrs->{where} ]
1051       };
1052     } else {
1053       $attrs->{where} = $where;
1054     }
1055   }
1056
1057   my $data = [ $self->result_source->storage->select_single(
1058     $attrs->{from}, $attrs->{select},
1059     $attrs->{where}, $attrs
1060   )];
1061   return undef unless @$data;
1062   $self->{stashed_rows} = [ $data ];
1063   $self->_construct_objects->[0];
1064 }
1065
1066
1067 # _collapse_query
1068 #
1069 # Recursively collapse the query, accumulating values for each column.
1070
1071 sub _collapse_query {
1072   my ($self, $query, $collapsed) = @_;
1073
1074   $collapsed ||= {};
1075
1076   if (ref $query eq 'ARRAY') {
1077     foreach my $subquery (@$query) {
1078       next unless ref $subquery;  # -or
1079       $collapsed = $self->_collapse_query($subquery, $collapsed);
1080     }
1081   }
1082   elsif (ref $query eq 'HASH') {
1083     if (keys %$query and (keys %$query)[0] eq '-and') {
1084       foreach my $subquery (@{$query->{-and}}) {
1085         $collapsed = $self->_collapse_query($subquery, $collapsed);
1086       }
1087     }
1088     else {
1089       foreach my $col (keys %$query) {
1090         my $value = $query->{$col};
1091         $collapsed->{$col}{$value}++;
1092       }
1093     }
1094   }
1095
1096   return $collapsed;
1097 }
1098
1099 =head2 get_column
1100
1101 =over 4
1102
1103 =item Arguments: $cond?
1104
1105 =item Return Value: $resultsetcolumn
1106
1107 =back
1108
1109   my $max_length = $rs->get_column('length')->max;
1110
1111 Returns a L<DBIx::Class::ResultSetColumn> instance for a column of the ResultSet.
1112
1113 =cut
1114
1115 sub get_column {
1116   my ($self, $column) = @_;
1117   my $new = DBIx::Class::ResultSetColumn->new($self, $column);
1118   return $new;
1119 }
1120
1121 =head2 search_like
1122
1123 =over 4
1124
1125 =item Arguments: $cond, \%attrs?
1126
1127 =item Return Value: $resultset (scalar context) || @row_objs (list context)
1128
1129 =back
1130
1131   # WHERE title LIKE '%blue%'
1132   $cd_rs = $rs->search_like({ title => '%blue%'});
1133
1134 Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
1135 that this is simply a convenience method retained for ex Class::DBI users.
1136 You most likely want to use L</search> with specific operators.
1137
1138 For more information, see L<DBIx::Class::Manual::Cookbook>.
1139
1140 This method is deprecated and will be removed in 0.09. Use L</search()>
1141 instead. An example conversion is:
1142
1143   ->search_like({ foo => 'bar' });
1144
1145   # Becomes
1146
1147   ->search({ foo => { like => 'bar' } });
1148
1149 =cut
1150
1151 sub search_like {
1152   my $class = shift;
1153   carp_unique (
1154     'search_like() is deprecated and will be removed in DBIC version 0.09.'
1155    .' Instead use ->search({ x => { -like => "y%" } })'
1156    .' (note the outer pair of {}s - they are important!)'
1157   );
1158   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1159   my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
1160   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
1161   return $class->search($query, { %$attrs });
1162 }
1163
1164 =head2 slice
1165
1166 =over 4
1167
1168 =item Arguments: $first, $last
1169
1170 =item Return Value: $resultset (scalar context) || @row_objs (list context)
1171
1172 =back
1173
1174 Returns a resultset or object list representing a subset of elements from the
1175 resultset slice is called on. Indexes are from 0, i.e., to get the first
1176 three records, call:
1177
1178   my ($one, $two, $three) = $rs->slice(0, 2);
1179
1180 =cut
1181
1182 sub slice {
1183   my ($self, $min, $max) = @_;
1184   my $attrs = {}; # = { %{ $self->{attrs} || {} } };
1185   $attrs->{offset} = $self->{attrs}{offset} || 0;
1186   $attrs->{offset} += $min;
1187   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
1188   return $self->search(undef, $attrs);
1189   #my $slice = (ref $self)->new($self->result_source, $attrs);
1190   #return (wantarray ? $slice->all : $slice);
1191 }
1192
1193 =head2 next
1194
1195 =over 4
1196
1197 =item Arguments: none
1198
1199 =item Return Value: $result | undef
1200
1201 =back
1202
1203 Returns the next element in the resultset (C<undef> is there is none).
1204
1205 Can be used to efficiently iterate over records in the resultset:
1206
1207   my $rs = $schema->resultset('CD')->search;
1208   while (my $cd = $rs->next) {
1209     print $cd->title;
1210   }
1211
1212 Note that you need to store the resultset object, and call C<next> on it.
1213 Calling C<< resultset('Table')->next >> repeatedly will always return the
1214 first record from the resultset.
1215
1216 =cut
1217
1218 sub next {
1219   my ($self) = @_;
1220
1221   if (my $cache = $self->get_cache) {
1222     $self->{all_cache_position} ||= 0;
1223     return $cache->[$self->{all_cache_position}++];
1224   }
1225
1226   if ($self->{attrs}{cache}) {
1227     delete $self->{pager};
1228     $self->{all_cache_position} = 1;
1229     return ($self->all)[0];
1230   }
1231
1232   return shift(@{$self->{stashed_objects}}) if @{ $self->{stashed_objects}||[] };
1233
1234   $self->{stashed_objects} = $self->_construct_objects
1235     or return undef;
1236
1237   return shift @{$self->{stashed_objects}};
1238 }
1239
1240 # Constructs as many objects as it can in one pass while respecting
1241 # cursor laziness. Several modes of operation:
1242 #
1243 # * Always builds everything present in @{$self->{stashed_rows}}
1244 # * If called with $fetch_all true - pulls everything off the cursor and
1245 #   builds all objects in one pass
1246 # * If $self->_resolved_attrs->{collapse} is true, checks the order_by
1247 #   and if the resultset is ordered properly by the left side:
1248 #   * Fetches stuff off the cursor until the "master object" changes,
1249 #     and saves the last extra row (if any) in @{$self->{stashed_rows}}
1250 #   OR
1251 #   * Just fetches, and collapses/constructs everything as if $fetch_all
1252 #     was requested (there is no other way to collapse except for an
1253 #     eager cursor)
1254 # * If no collapse is requested - just get the next row, construct and
1255 #   return
1256 sub _construct_objects {
1257   my ($self, $fetch_all) = @_;
1258
1259   my $rsrc = $self->result_source;
1260   my $attrs = $self->_resolved_attrs;
1261   my $cursor = $self->cursor;
1262
1263   # this will be used as both initial raw-row collector AND as a RV of
1264   # _construct_objects. Not regrowing the array twice matters a lot...
1265   # a suprising amount actually
1266   my $rows = (delete $self->{stashed_rows}) || [];
1267   if ($fetch_all) {
1268     # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1269     $rows = [ @$rows, $cursor->all ];
1270   }
1271   elsif (!$attrs->{collapse}) {
1272     # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1273     push @$rows, do { my @r = $cursor->next; @r ? \@r : () }
1274       unless @$rows;
1275   }
1276   else {
1277     $attrs->{_ordered_for_collapse} ||= (!$attrs->{order_by}) ? undef : do {
1278       my $st = $rsrc->schema->storage;
1279       my @ord_cols = map
1280         { $_->[0] }
1281         ( $st->_extract_order_criteria($attrs->{order_by}) )
1282       ;
1283
1284       my $colinfos = $st->_resolve_column_info($attrs->{from}, \@ord_cols);
1285
1286       for (0 .. $#ord_cols) {
1287         if (
1288           ! $colinfos->{$ord_cols[$_]}
1289             or
1290           $colinfos->{$ord_cols[$_]}{-result_source} != $rsrc
1291         ) {
1292           splice @ord_cols, $_;
1293           last;
1294         }
1295       }
1296
1297       # since all we check here are the start of the order_by belonging to the
1298       # top level $rsrc, a present identifying set will mean that the resultset
1299       # is ordered by its leftmost table in a tsable manner
1300       (@ord_cols and $rsrc->_identifying_column_set({ map
1301         { $colinfos->{$_}{-colname} => $colinfos->{$_} }
1302         @ord_cols
1303       })) ? 1 : 0;
1304     };
1305
1306     if ($attrs->{_ordered_for_collapse}) {
1307       push @$rows, do { my @r = $cursor->next; @r ? \@r : () };
1308     }
1309     # instead of looping over ->next, use ->all in stealth mode
1310     # FIXME - encapsulation breach, got to be a better way
1311     elsif (! $cursor->{done}) {
1312       push @$rows, $cursor->all;
1313       $cursor->{done} = 1;
1314       $fetch_all = 1;
1315     }
1316   }
1317
1318   return undef unless @$rows;
1319
1320   my $res_class = $self->result_class;
1321   my $inflator = $res_class->can ('inflate_result')
1322     or $self->throw_exception("Inflator $res_class does not provide an inflate_result() method");
1323
1324   my $infmap = $attrs->{as};
1325
1326   if (!$attrs->{collapse} and $attrs->{_single_object_inflation}) {
1327     # construct a much simpler array->hash folder for the one-table cases right here
1328
1329     # FIXME SUBOPTIMAL this is a very very very hot spot
1330     # while rather optimal we can *still* do much better, by
1331     # building a smarter [Row|HRI]::inflate_result(), and
1332     # switch to feeding it data via a much leaner interface
1333     #
1334     # crude unscientific benchmarking indicated the shortcut eval is not worth it for
1335     # this particular resultset size
1336     if (@$rows < 60) {
1337       my @as_idx = 0..$#$infmap;
1338       for my $r (@$rows) {
1339         $r = $inflator->($res_class, $rsrc, { map { $infmap->[$_] => $r->[$_] } @as_idx } );
1340       }
1341     }
1342     else {
1343       eval sprintf (
1344         '$_ = $inflator->($res_class, $rsrc, { %s }) for @$rows',
1345         join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap )
1346       );
1347     }
1348   }
1349   else {
1350     ($self->{_row_parser} ||= eval sprintf 'sub { %s }', $rsrc->_mk_row_parser({
1351       inflate_map => $infmap,
1352       selection => $attrs->{select},
1353       collapse => $attrs->{collapse},
1354     }) or die $@)->($rows, $fetch_all ? () : (
1355       # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1356       sub { my @r = $cursor->next or return; \@r }, # how the collapser gets more rows
1357       ($self->{stashed_rows} = []),                 # where does it stuff excess
1358     ));  # modify $rows in-place, shrinking/extending as necessary
1359
1360     $_ = $inflator->($res_class, $rsrc, @$_) for @$rows;
1361
1362   }
1363
1364   # CDBI compat stuff
1365   if ($attrs->{record_filter}) {
1366     $_ = $attrs->{record_filter}->($_) for @$rows;
1367   }
1368
1369   return $rows;
1370 }
1371
1372 =head2 result_source
1373
1374 =over 4
1375
1376 =item Arguments: $result_source?
1377
1378 =item Return Value: $result_source
1379
1380 =back
1381
1382 An accessor for the primary ResultSource object from which this ResultSet
1383 is derived.
1384
1385 =head2 result_class
1386
1387 =over 4
1388
1389 =item Arguments: $result_class?
1390
1391 =item Return Value: $result_class
1392
1393 =back
1394
1395 An accessor for the class to use when creating row objects. Defaults to
1396 C<< result_source->result_class >> - which in most cases is the name of the
1397 L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
1398
1399 Note that changing the result_class will also remove any components
1400 that were originally loaded in the source class via
1401 L<DBIx::Class::ResultSource/load_components>. Any overloaded methods
1402 in the original source class will not run.
1403
1404 =cut
1405
1406 sub result_class {
1407   my ($self, $result_class) = @_;
1408   if ($result_class) {
1409     unless (ref $result_class) { # don't fire this for an object
1410       $self->ensure_class_loaded($result_class);
1411     }
1412     $self->_result_class($result_class);
1413     # THIS LINE WOULD BE A BUG - this accessor specifically exists to
1414     # permit the user to set result class on one result set only; it only
1415     # chains if provided to search()
1416     #$self->{attrs}{result_class} = $result_class if ref $self;
1417   }
1418   $self->_result_class;
1419 }
1420
1421 =head2 count
1422
1423 =over 4
1424
1425 =item Arguments: $cond, \%attrs??
1426
1427 =item Return Value: $count
1428
1429 =back
1430
1431 Performs an SQL C<COUNT> with the same query as the resultset was built
1432 with to find the number of elements. Passing arguments is equivalent to
1433 C<< $rs->search ($cond, \%attrs)->count >>
1434
1435 =cut
1436
1437 sub count {
1438   my $self = shift;
1439   return $self->search(@_)->count if @_ and defined $_[0];
1440   return scalar @{ $self->get_cache } if $self->get_cache;
1441
1442   my $attrs = $self->_resolved_attrs_copy;
1443
1444   # this is a little optimization - it is faster to do the limit
1445   # adjustments in software, instead of a subquery
1446   my ($rows, $offset) = delete @{$attrs}{qw/rows offset/};
1447
1448   my $crs;
1449   if ($self->_has_resolved_attr (qw/collapse group_by/)) {
1450     $crs = $self->_count_subq_rs ($attrs);
1451   }
1452   else {
1453     $crs = $self->_count_rs ($attrs);
1454   }
1455   my $count = $crs->next;
1456
1457   $count -= $offset if $offset;
1458   $count = $rows if $rows and $rows < $count;
1459   $count = 0 if ($count < 0);
1460
1461   return $count;
1462 }
1463
1464 =head2 count_rs
1465
1466 =over 4
1467
1468 =item Arguments: $cond, \%attrs??
1469
1470 =item Return Value: $count_rs
1471
1472 =back
1473
1474 Same as L</count> but returns a L<DBIx::Class::ResultSetColumn> object.
1475 This can be very handy for subqueries:
1476
1477   ->search( { amount => $some_rs->count_rs->as_query } )
1478
1479 As with regular resultsets the SQL query will be executed only after
1480 the resultset is accessed via L</next> or L</all>. That would return
1481 the same single value obtainable via L</count>.
1482
1483 =cut
1484
1485 sub count_rs {
1486   my $self = shift;
1487   return $self->search(@_)->count_rs if @_;
1488
1489   # this may look like a lack of abstraction (count() does about the same)
1490   # but in fact an _rs *must* use a subquery for the limits, as the
1491   # software based limiting can not be ported if this $rs is to be used
1492   # in a subquery itself (i.e. ->as_query)
1493   if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) {
1494     return $self->_count_subq_rs;
1495   }
1496   else {
1497     return $self->_count_rs;
1498   }
1499 }
1500
1501 #
1502 # returns a ResultSetColumn object tied to the count query
1503 #
1504 sub _count_rs {
1505   my ($self, $attrs) = @_;
1506
1507   my $rsrc = $self->result_source;
1508   $attrs ||= $self->_resolved_attrs;
1509
1510   my $tmp_attrs = { %$attrs };
1511   # take off any limits, record_filter is cdbi, and no point of ordering nor locking a count
1512   delete @{$tmp_attrs}{qw/rows offset order_by record_filter for/};
1513
1514   # overwrite the selector (supplied by the storage)
1515   $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs);
1516   $tmp_attrs->{as} = 'count';
1517
1518   my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
1519
1520   return $tmp_rs;
1521 }
1522
1523 #
1524 # same as above but uses a subquery
1525 #
1526 sub _count_subq_rs {
1527   my ($self, $attrs) = @_;
1528
1529   my $rsrc = $self->result_source;
1530   $attrs ||= $self->_resolved_attrs;
1531
1532   my $sub_attrs = { %$attrs };
1533   # extra selectors do not go in the subquery and there is no point of ordering it, nor locking it
1534   delete @{$sub_attrs}{qw/collapse columns as select _prefetch_selector_range order_by for/};
1535
1536   # if we multi-prefetch we group_by something unique, as this is what we would
1537   # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
1538   if ( $attrs->{collapse}  ) {
1539     $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } @{
1540       $rsrc->_identifying_column_set || $self->throw_exception(
1541         'Unable to construct a unique group_by criteria properly collapsing the '
1542       . 'has_many prefetch before count()'
1543       );
1544     } ]
1545   }
1546
1547   # Calculate subquery selector
1548   if (my $g = $sub_attrs->{group_by}) {
1549
1550     my $sql_maker = $rsrc->storage->sql_maker;
1551
1552     # necessary as the group_by may refer to aliased functions
1553     my $sel_index;
1554     for my $sel (@{$attrs->{select}}) {
1555       $sel_index->{$sel->{-as}} = $sel
1556         if (ref $sel eq 'HASH' and $sel->{-as});
1557     }
1558
1559     # anything from the original select mentioned on the group-by needs to make it to the inner selector
1560     # also look for named aggregates referred in the having clause
1561     # having often contains scalarrefs - thus parse it out entirely
1562     my @parts = @$g;
1563     if ($attrs->{having}) {
1564       local $sql_maker->{having_bind};
1565       local $sql_maker->{quote_char} = $sql_maker->{quote_char};
1566       local $sql_maker->{name_sep} = $sql_maker->{name_sep};
1567       unless (defined $sql_maker->{quote_char} and length $sql_maker->{quote_char}) {
1568         $sql_maker->{quote_char} = [ "\x00", "\xFF" ];
1569         # if we don't unset it we screw up retarded but unfortunately working
1570         # 'MAX(foo.bar)' => { '>', 3 }
1571         $sql_maker->{name_sep} = '';
1572       }
1573
1574       my ($lquote, $rquote, $sep) = map { quotemeta $_ } ($sql_maker->_quote_chars, $sql_maker->name_sep);
1575
1576       my $sql = $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} });
1577
1578       # search for both a proper quoted qualified string, for a naive unquoted scalarref
1579       # and if all fails for an utterly naive quoted scalar-with-function
1580       while ($sql =~ /
1581         $rquote $sep $lquote (.+?) $rquote
1582           |
1583         [\s,] \w+ \. (\w+) [\s,]
1584           |
1585         [\s,] $lquote (.+?) $rquote [\s,]
1586       /gx) {
1587         push @parts, ($1 || $2 || $3);  # one of them matched if we got here
1588       }
1589     }
1590
1591     for (@parts) {
1592       my $colpiece = $sel_index->{$_} || $_;
1593
1594       # unqualify join-based group_by's. Arcane but possible query
1595       # also horrible horrible hack to alias a column (not a func.)
1596       # (probably need to introduce SQLA syntax)
1597       if ($colpiece =~ /\./ && $colpiece !~ /^$attrs->{alias}\./) {
1598         my $as = $colpiece;
1599         $as =~ s/\./__/;
1600         $colpiece = \ sprintf ('%s AS %s', map { $sql_maker->_quote ($_) } ($colpiece, $as) );
1601       }
1602       push @{$sub_attrs->{select}}, $colpiece;
1603     }
1604   }
1605   else {
1606     my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns);
1607     $sub_attrs->{select} = @pcols ? \@pcols : [ 1 ];
1608   }
1609
1610   return $rsrc->resultset_class
1611                ->new ($rsrc, $sub_attrs)
1612                 ->as_subselect_rs
1613                  ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } })
1614                   ->get_column ('count');
1615 }
1616
1617 sub _bool {
1618   return 1;
1619 }
1620
1621 =head2 count_literal
1622
1623 =over 4
1624
1625 =item Arguments: $sql_fragment, @bind_values
1626
1627 =item Return Value: $count
1628
1629 =back
1630
1631 Counts the results in a literal query. Equivalent to calling L</search_literal>
1632 with the passed arguments, then L</count>.
1633
1634 =cut
1635
1636 sub count_literal { shift->search_literal(@_)->count; }
1637
1638 =head2 all
1639
1640 =over 4
1641
1642 =item Arguments: none
1643
1644 =item Return Value: @objects
1645
1646 =back
1647
1648 Returns all elements in the resultset.
1649
1650 =cut
1651
1652 sub all {
1653   my $self = shift;
1654   if(@_) {
1655     $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
1656   }
1657
1658   delete @{$self}{qw/stashed_rows stashed_objects/};
1659
1660   if (my $c = $self->get_cache) {
1661     return @$c;
1662   }
1663
1664   $self->cursor->reset;
1665
1666   my $objs = $self->_construct_objects('fetch_all') || [];
1667
1668   $self->set_cache($objs) if $self->{attrs}{cache};
1669
1670   return @$objs;
1671 }
1672
1673 =head2 reset
1674
1675 =over 4
1676
1677 =item Arguments: none
1678
1679 =item Return Value: $self
1680
1681 =back
1682
1683 Resets the resultset's cursor, so you can iterate through the elements again.
1684 Implicitly resets the storage cursor, so a subsequent L</next> will trigger
1685 another query.
1686
1687 =cut
1688
1689 sub reset {
1690   my ($self) = @_;
1691
1692   delete @{$self}{qw/_attrs stashed_rows stashed_objects/};
1693
1694   $self->{all_cache_position} = 0;
1695   $self->cursor->reset;
1696   return $self;
1697 }
1698
1699 =head2 first
1700
1701 =over 4
1702
1703 =item Arguments: none
1704
1705 =item Return Value: $object | undef
1706
1707 =back
1708
1709 Resets the resultset and returns an object for the first result (or C<undef>
1710 if the resultset is empty).
1711
1712 =cut
1713
1714 sub first {
1715   return $_[0]->reset->next;
1716 }
1717
1718
1719 # _rs_update_delete
1720 #
1721 # Determines whether and what type of subquery is required for the $rs operation.
1722 # If grouping is necessary either supplies its own, or verifies the current one
1723 # After all is done delegates to the proper storage method.
1724
1725 sub _rs_update_delete {
1726   my ($self, $op, $values) = @_;
1727
1728   my $cond = $self->{cond};
1729   my $rsrc = $self->result_source;
1730   my $storage = $rsrc->schema->storage;
1731
1732   my $attrs = { %{$self->_resolved_attrs} };
1733
1734   # "needs" is a strong word here - if the subquery is part of an IN clause - no point of
1735   # even adding the group_by. It will really be used only when composing a poor-man's
1736   # multicolumn-IN equivalent OR set
1737   my $needs_group_by_subq = defined $attrs->{group_by};
1738
1739   # simplify the joinmap and maybe decide if a grouping (and thus subquery) is necessary
1740   my $relation_classifications;
1741   if (ref($attrs->{from}) eq 'ARRAY') {
1742     if (@{$attrs->{from}} == 1) {
1743       # not a fucking JOIN at all, quit with the dickery
1744       $relation_classifications = {};
1745     } else {
1746       $attrs->{from} = $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $cond, $attrs);
1747
1748       $relation_classifications = $storage->_resolve_aliastypes_from_select_args (
1749         [ @{$attrs->{from}}[1 .. $#{$attrs->{from}}] ],
1750         $attrs->{select},
1751         $cond,
1752         $attrs
1753       ) unless $needs_group_by_subq;  # we already know we need a group, no point of resolving them
1754     }
1755   }
1756   else {
1757     $needs_group_by_subq ||= 1; # if {from} is unparseable assume the worst
1758   }
1759
1760   $needs_group_by_subq ||= exists $relation_classifications->{multiplying};
1761
1762   # if no subquery - life is easy-ish
1763   unless (
1764     $needs_group_by_subq
1765       or
1766     keys %$relation_classifications # if any joins at all - need to wrap a subq
1767       or
1768     $self->_has_resolved_attr(qw/rows offset/) # limits call for a subq
1769   ) {
1770     # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
1771     # a condition containing 'me' or other table prefixes will not work
1772     # at all. Tell SQLMaker to dequalify idents via a gross hack.
1773     my $sqla = $rsrc->storage->sql_maker;
1774     local $sqla->{_dequalify_idents} = 1;
1775     return $rsrc->storage->$op(
1776       $rsrc,
1777       $op eq 'update' ? $values : (),
1778       $self->{cond},
1779     );
1780   }
1781
1782   # we got this far - means it is time to wrap a subquery
1783   my $idcols = $rsrc->_identifying_column_set || $self->throw_exception(
1784     sprintf(
1785       "Unable to perform complex resultset %s() without an identifying set of columns on source '%s'",
1786       $op,
1787       $rsrc->source_name,
1788     )
1789   );
1790   my $existing_group_by = delete $attrs->{group_by};
1791
1792   # make a new $rs selecting only the PKs (that's all we really need for the subq)
1793   delete @{$attrs}{qw/collapse select _prefetch_selector_range as/};
1794   $attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ];
1795   $attrs->{group_by} = \ '';  # FIXME - this is an evil hack, it causes the optimiser to kick in and throw away the LEFT joins
1796   my $subrs = (ref $self)->new($rsrc, $attrs);
1797
1798   if (@$idcols == 1) {
1799     return $storage->$op (
1800       $rsrc,
1801       $op eq 'update' ? $values : (),
1802       { $idcols->[0] => { -in => $subrs->as_query } },
1803     );
1804   }
1805   elsif ($storage->_use_multicolumn_in) {
1806     # This is hideously ugly, but SQLA does not understand multicol IN expressions
1807     my $sql_maker = $storage->sql_maker;
1808     my ($sql, @bind) = @${$subrs->as_query};
1809     $sql = sprintf ('(%s) IN %s', # the as_query already comes with a set of parenthesis
1810       join (', ', map { $sql_maker->_quote ($_) } @$idcols),
1811       $sql,
1812     );
1813
1814     return $storage->$op (
1815       $rsrc,
1816       $op eq 'update' ? $values : (),
1817       \[$sql, @bind],
1818     );
1819   }
1820   else {
1821     # if all else fails - get all primary keys and operate over a ORed set
1822     # wrap in a transaction for consistency
1823     # this is where the group_by starts to matter
1824     my $subq_group_by;
1825     if ($needs_group_by_subq) {
1826       $subq_group_by = $attrs->{columns};
1827
1828       # make sure if there is a supplied group_by it matches the columns compiled above
1829       # perfectly. Anything else can not be sanely executed on most databases so croak
1830       # right then and there
1831       if ($existing_group_by) {
1832         my @current_group_by = map
1833           { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
1834           @$existing_group_by
1835         ;
1836
1837         if (
1838           join ("\x00", sort @current_group_by)
1839             ne
1840           join ("\x00", sort @$subq_group_by )
1841         ) {
1842           $self->throw_exception (
1843             "You have just attempted a $op operation on a resultset which does group_by"
1844             . ' on columns other than the primary keys, while DBIC internally needs to retrieve'
1845             . ' the primary keys in a subselect. All sane RDBMS engines do not support this'
1846             . ' kind of queries. Please retry the operation with a modified group_by or'
1847             . ' without using one at all.'
1848           );
1849         }
1850       }
1851     }
1852
1853     my $guard = $storage->txn_scope_guard;
1854
1855     my @op_condition;
1856     for my $row ($subrs->search({}, { group_by => $subq_group_by })->cursor->all) {
1857       push @op_condition, { map
1858         { $idcols->[$_] => $row->[$_] }
1859         (0 .. $#$idcols)
1860       };
1861     }
1862
1863     my $res = $storage->$op (
1864       $rsrc,
1865       $op eq 'update' ? $values : (),
1866       \@op_condition,
1867     );
1868
1869     $guard->commit;
1870
1871     return $res;
1872   }
1873 }
1874
1875 =head2 update
1876
1877 =over 4
1878
1879 =item Arguments: \%values
1880
1881 =item Return Value: $storage_rv
1882
1883 =back
1884
1885 Sets the specified columns in the resultset to the supplied values in a
1886 single query. Note that this will not run any accessor/set_column/update
1887 triggers, nor will it update any row object instances derived from this
1888 resultset (this includes the contents of the L<resultset cache|/set_cache>
1889 if any). See L</update_all> if you need to execute any on-update
1890 triggers or cascades defined either by you or a
1891 L<result component|DBIx::Class::Manual::Component/WHAT IS A COMPONENT>.
1892
1893 The return value is a pass through of what the underlying
1894 storage backend returned, and may vary. See L<DBI/execute> for the most
1895 common case.
1896
1897 =head3 CAVEAT
1898
1899 Note that L</update> does not process/deflate any of the values passed in.
1900 This is unlike the corresponding L<DBIx::Class::Row/update>. The user must
1901 ensure manually that any value passed to this method will stringify to
1902 something the RDBMS knows how to deal with. A notable example is the
1903 handling of L<DateTime> objects, for more info see:
1904 L<DBIx::Class::Manual::Cookbook/Formatting DateTime objects in queries>.
1905
1906 =cut
1907
1908 sub update {
1909   my ($self, $values) = @_;
1910   $self->throw_exception('Values for update must be a hash')
1911     unless ref $values eq 'HASH';
1912
1913   return $self->_rs_update_delete ('update', $values);
1914 }
1915
1916 =head2 update_all
1917
1918 =over 4
1919
1920 =item Arguments: \%values
1921
1922 =item Return Value: 1
1923
1924 =back
1925
1926 Fetches all objects and updates them one at a time via
1927 L<DBIx::Class::Row/update>. Note that C<update_all> will run DBIC defined
1928 triggers, while L</update> will not.
1929
1930 =cut
1931
1932 sub update_all {
1933   my ($self, $values) = @_;
1934   $self->throw_exception('Values for update_all must be a hash')
1935     unless ref $values eq 'HASH';
1936
1937   my $guard = $self->result_source->schema->txn_scope_guard;
1938   $_->update({%$values}) for $self->all;  # shallow copy - update will mangle it
1939   $guard->commit;
1940   return 1;
1941 }
1942
1943 =head2 delete
1944
1945 =over 4
1946
1947 =item Arguments: none
1948
1949 =item Return Value: $storage_rv
1950
1951 =back
1952
1953 Deletes the rows matching this resultset in a single query. Note that this
1954 will not run any delete triggers, nor will it alter the
1955 L<in_storage|DBIx::Class::Row/in_storage> status of any row object instances
1956 derived from this resultset (this includes the contents of the
1957 L<resultset cache|/set_cache> if any). See L</delete_all> if you need to
1958 execute any on-delete triggers or cascades defined either by you or a
1959 L<result component|DBIx::Class::Manual::Component/WHAT IS A COMPONENT>.
1960
1961 The return value is a pass through of what the underlying storage backend
1962 returned, and may vary. See L<DBI/execute> for the most common case.
1963
1964 =cut
1965
1966 sub delete {
1967   my $self = shift;
1968   $self->throw_exception('delete does not accept any arguments')
1969     if @_;
1970
1971   return $self->_rs_update_delete ('delete');
1972 }
1973
1974 =head2 delete_all
1975
1976 =over 4
1977
1978 =item Arguments: none
1979
1980 =item Return Value: 1
1981
1982 =back
1983
1984 Fetches all objects and deletes them one at a time via
1985 L<DBIx::Class::Row/delete>. Note that C<delete_all> will run DBIC defined
1986 triggers, while L</delete> will not.
1987
1988 =cut
1989
1990 sub delete_all {
1991   my $self = shift;
1992   $self->throw_exception('delete_all does not accept any arguments')
1993     if @_;
1994
1995   my $guard = $self->result_source->schema->txn_scope_guard;
1996   $_->delete for $self->all;
1997   $guard->commit;
1998   return 1;
1999 }
2000
2001 =head2 populate
2002
2003 =over 4
2004
2005 =item Arguments: \@data;
2006
2007 =back
2008
2009 Accepts either an arrayref of hashrefs or alternatively an arrayref of arrayrefs.
2010 For the arrayref of hashrefs style each hashref should be a structure suitable
2011 for submitting to a $resultset->create(...) method.
2012
2013 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
2014 to insert the data, as this is a faster method.
2015
2016 Otherwise, each set of data is inserted into the database using
2017 L<DBIx::Class::ResultSet/create>, and the resulting objects are
2018 accumulated into an array. The array itself, or an array reference
2019 is returned depending on scalar or list context.
2020
2021 Example:  Assuming an Artist Class that has many CDs Classes relating:
2022
2023   my $Artist_rs = $schema->resultset("Artist");
2024
2025   ## Void Context Example
2026   $Artist_rs->populate([
2027      { artistid => 4, name => 'Manufactured Crap', cds => [
2028         { title => 'My First CD', year => 2006 },
2029         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2030       ],
2031      },
2032      { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
2033         { title => 'My parents sold me to a record company', year => 2005 },
2034         { title => 'Why Am I So Ugly?', year => 2006 },
2035         { title => 'I Got Surgery and am now Popular', year => 2007 }
2036       ],
2037      },
2038   ]);
2039
2040   ## Array Context Example
2041   my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([
2042     { name => "Artist One"},
2043     { name => "Artist Two"},
2044     { name => "Artist Three", cds=> [
2045     { title => "First CD", year => 2007},
2046     { title => "Second CD", year => 2008},
2047   ]}
2048   ]);
2049
2050   print $ArtistOne->name; ## response is 'Artist One'
2051   print $ArtistThree->cds->count ## reponse is '2'
2052
2053 For the arrayref of arrayrefs style,  the first element should be a list of the
2054 fieldsnames to which the remaining elements are rows being inserted.  For
2055 example:
2056
2057   $Arstist_rs->populate([
2058     [qw/artistid name/],
2059     [100, 'A Formally Unknown Singer'],
2060     [101, 'A singer that jumped the shark two albums ago'],
2061     [102, 'An actually cool singer'],
2062   ]);
2063
2064 Please note an important effect on your data when choosing between void and
2065 wantarray context. Since void context goes straight to C<insert_bulk> in
2066 L<DBIx::Class::Storage::DBI> this will skip any component that is overriding
2067 C<insert>.  So if you are using something like L<DBIx-Class-UUIDColumns> to
2068 create primary keys for you, you will find that your PKs are empty.  In this
2069 case you will have to use the wantarray context in order to create those
2070 values.
2071
2072 =cut
2073
2074 sub populate {
2075   my $self = shift;
2076
2077   # cruft placed in standalone method
2078   my $data = $self->_normalize_populate_args(@_);
2079
2080   return unless @$data;
2081
2082   if(defined wantarray) {
2083     my @created;
2084     foreach my $item (@$data) {
2085       push(@created, $self->create($item));
2086     }
2087     return wantarray ? @created : \@created;
2088   }
2089   else {
2090     my $first = $data->[0];
2091
2092     # if a column is a registered relationship, and is a non-blessed hash/array, consider
2093     # it relationship data
2094     my (@rels, @columns);
2095     my $rsrc = $self->result_source;
2096     my $rels = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships };
2097     for (keys %$first) {
2098       my $ref = ref $first->{$_};
2099       $rels->{$_} && ($ref eq 'ARRAY' or $ref eq 'HASH')
2100         ? push @rels, $_
2101         : push @columns, $_
2102       ;
2103     }
2104
2105     my @pks = $rsrc->primary_columns;
2106
2107     ## do the belongs_to relationships
2108     foreach my $index (0..$#$data) {
2109
2110       # delegate to create() for any dataset without primary keys with specified relationships
2111       if (grep { !defined $data->[$index]->{$_} } @pks ) {
2112         for my $r (@rels) {
2113           if (grep { ref $data->[$index]{$r} eq $_ } qw/HASH ARRAY/) {  # a related set must be a HASH or AoH
2114             my @ret = $self->populate($data);
2115             return;
2116           }
2117         }
2118       }
2119
2120       foreach my $rel (@rels) {
2121         next unless ref $data->[$index]->{$rel} eq "HASH";
2122         my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
2123         my ($reverse_relname, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)};
2124         my $related = $result->result_source->_resolve_condition(
2125           $reverse_relinfo->{cond},
2126           $self,
2127           $result,
2128           $rel,
2129         );
2130
2131         delete $data->[$index]->{$rel};
2132         $data->[$index] = {%{$data->[$index]}, %$related};
2133
2134         push @columns, keys %$related if $index == 0;
2135       }
2136     }
2137
2138     ## inherit the data locked in the conditions of the resultset
2139     my ($rs_data) = $self->_merge_with_rscond({});
2140     delete @{$rs_data}{@columns};
2141     my @inherit_cols = keys %$rs_data;
2142     my @inherit_data = values %$rs_data;
2143
2144     ## do bulk insert on current row
2145     $rsrc->storage->insert_bulk(
2146       $rsrc,
2147       [@columns, @inherit_cols],
2148       [ map { [ @$_{@columns}, @inherit_data ] } @$data ],
2149     );
2150
2151     ## do the has_many relationships
2152     foreach my $item (@$data) {
2153
2154       my $main_row;
2155
2156       foreach my $rel (@rels) {
2157         next unless ref $item->{$rel} eq "ARRAY" && @{ $item->{$rel} };
2158
2159         $main_row ||= $self->new_result({map { $_ => $item->{$_} } @pks});
2160
2161         my $child = $main_row->$rel;
2162
2163         my $related = $child->result_source->_resolve_condition(
2164           $rels->{$rel}{cond},
2165           $child,
2166           $main_row,
2167           $rel,
2168         );
2169
2170         my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
2171         my @populate = map { {%$_, %$related} } @rows_to_add;
2172
2173         $child->populate( \@populate );
2174       }
2175     }
2176   }
2177 }
2178
2179
2180 # populate() argumnets went over several incarnations
2181 # What we ultimately support is AoH
2182 sub _normalize_populate_args {
2183   my ($self, $arg) = @_;
2184
2185   if (ref $arg eq 'ARRAY') {
2186     if (!@$arg) {
2187       return [];
2188     }
2189     elsif (ref $arg->[0] eq 'HASH') {
2190       return $arg;
2191     }
2192     elsif (ref $arg->[0] eq 'ARRAY') {
2193       my @ret;
2194       my @colnames = @{$arg->[0]};
2195       foreach my $values (@{$arg}[1 .. $#$arg]) {
2196         push @ret, { map { $colnames[$_] => $values->[$_] } (0 .. $#colnames) };
2197       }
2198       return \@ret;
2199     }
2200   }
2201
2202   $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs');
2203 }
2204
2205 =head2 pager
2206
2207 =over 4
2208
2209 =item Arguments: none
2210
2211 =item Return Value: $pager
2212
2213 =back
2214
2215 Return Value a L<Data::Page> object for the current resultset. Only makes
2216 sense for queries with a C<page> attribute.
2217
2218 To get the full count of entries for a paged resultset, call
2219 C<total_entries> on the L<Data::Page> object.
2220
2221 =cut
2222
2223 sub pager {
2224   my ($self) = @_;
2225
2226   return $self->{pager} if $self->{pager};
2227
2228   my $attrs = $self->{attrs};
2229   if (!defined $attrs->{page}) {
2230     $self->throw_exception("Can't create pager for non-paged rs");
2231   }
2232   elsif ($attrs->{page} <= 0) {
2233     $self->throw_exception('Invalid page number (page-numbers are 1-based)');
2234   }
2235   $attrs->{rows} ||= 10;
2236
2237   # throw away the paging flags and re-run the count (possibly
2238   # with a subselect) to get the real total count
2239   my $count_attrs = { %$attrs };
2240   delete @{$count_attrs}{qw/rows offset page pager/};
2241
2242   my $total_rs = (ref $self)->new($self->result_source, $count_attrs);
2243
2244   require DBIx::Class::ResultSet::Pager;
2245   return $self->{pager} = DBIx::Class::ResultSet::Pager->new(
2246     sub { $total_rs->count },  #lazy-get the total
2247     $attrs->{rows},
2248     $self->{attrs}{page},
2249   );
2250 }
2251
2252 =head2 page
2253
2254 =over 4
2255
2256 =item Arguments: $page_number
2257
2258 =item Return Value: $rs
2259
2260 =back
2261
2262 Returns a resultset for the $page_number page of the resultset on which page
2263 is called, where each page contains a number of rows equal to the 'rows'
2264 attribute set on the resultset (10 by default).
2265
2266 =cut
2267
2268 sub page {
2269   my ($self, $page) = @_;
2270   return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
2271 }
2272
2273 =head2 new_result
2274
2275 =over 4
2276
2277 =item Arguments: \%vals
2278
2279 =item Return Value: $rowobject
2280
2281 =back
2282
2283 Creates a new row object in the resultset's result class and returns
2284 it. The row is not inserted into the database at this point, call
2285 L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
2286 will tell you whether the row object has been inserted or not.
2287
2288 Passes the hashref of input on to L<DBIx::Class::Row/new>.
2289
2290 =cut
2291
2292 sub new_result {
2293   my ($self, $values) = @_;
2294   $self->throw_exception( "new_result needs a hash" )
2295     unless (ref $values eq 'HASH');
2296
2297   my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values);
2298
2299   my %new = (
2300     %$merged_cond,
2301     @$cols_from_relations
2302       ? (-cols_from_relations => $cols_from_relations)
2303       : (),
2304     -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
2305   );
2306
2307   return $self->result_class->new(\%new);
2308 }
2309
2310 # _merge_with_rscond
2311 #
2312 # Takes a simple hash of K/V data and returns its copy merged with the
2313 # condition already present on the resultset. Additionally returns an
2314 # arrayref of value/condition names, which were inferred from related
2315 # objects (this is needed for in-memory related objects)
2316 sub _merge_with_rscond {
2317   my ($self, $data) = @_;
2318
2319   my (%new_data, @cols_from_relations);
2320
2321   my $alias = $self->{attrs}{alias};
2322
2323   if (! defined $self->{cond}) {
2324     # just massage $data below
2325   }
2326   elsif ($self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
2327     %new_data = %{ $self->{attrs}{related_objects} || {} };  # nothing might have been inserted yet
2328     @cols_from_relations = keys %new_data;
2329   }
2330   elsif (ref $self->{cond} ne 'HASH') {
2331     $self->throw_exception(
2332       "Can't abstract implicit construct, resultset condition not a hash"
2333     );
2334   }
2335   else {
2336     # precendence must be given to passed values over values inherited from
2337     # the cond, so the order here is important.
2338     my $collapsed_cond = $self->_collapse_cond($self->{cond});
2339     my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
2340
2341     while ( my($col, $value) = each %implied ) {
2342       my $vref = ref $value;
2343       if (
2344         $vref eq 'HASH'
2345           and
2346         keys(%$value) == 1
2347           and
2348         (keys %$value)[0] eq '='
2349       ) {
2350         $new_data{$col} = $value->{'='};
2351       }
2352       elsif( !$vref or $vref eq 'SCALAR' or blessed($value) ) {
2353         $new_data{$col} = $value;
2354       }
2355     }
2356   }
2357
2358   %new_data = (
2359     %new_data,
2360     %{ $self->_remove_alias($data, $alias) },
2361   );
2362
2363   return (\%new_data, \@cols_from_relations);
2364 }
2365
2366 # _has_resolved_attr
2367 #
2368 # determines if the resultset defines at least one
2369 # of the attributes supplied
2370 #
2371 # used to determine if a subquery is neccessary
2372 #
2373 # supports some virtual attributes:
2374 #   -join
2375 #     This will scan for any joins being present on the resultset.
2376 #     It is not a mere key-search but a deep inspection of {from}
2377 #
2378
2379 sub _has_resolved_attr {
2380   my ($self, @attr_names) = @_;
2381
2382   my $attrs = $self->_resolved_attrs;
2383
2384   my %extra_checks;
2385
2386   for my $n (@attr_names) {
2387     if (grep { $n eq $_ } (qw/-join/) ) {
2388       $extra_checks{$n}++;
2389       next;
2390     }
2391
2392     my $attr =  $attrs->{$n};
2393
2394     next if not defined $attr;
2395
2396     if (ref $attr eq 'HASH') {
2397       return 1 if keys %$attr;
2398     }
2399     elsif (ref $attr eq 'ARRAY') {
2400       return 1 if @$attr;
2401     }
2402     else {
2403       return 1 if $attr;
2404     }
2405   }
2406
2407   # a resolved join is expressed as a multi-level from
2408   return 1 if (
2409     $extra_checks{-join}
2410       and
2411     ref $attrs->{from} eq 'ARRAY'
2412       and
2413     @{$attrs->{from}} > 1
2414   );
2415
2416   return 0;
2417 }
2418
2419 # _collapse_cond
2420 #
2421 # Recursively collapse the condition.
2422
2423 sub _collapse_cond {
2424   my ($self, $cond, $collapsed) = @_;
2425
2426   $collapsed ||= {};
2427
2428   if (ref $cond eq 'ARRAY') {
2429     foreach my $subcond (@$cond) {
2430       next unless ref $subcond;  # -or
2431       $collapsed = $self->_collapse_cond($subcond, $collapsed);
2432     }
2433   }
2434   elsif (ref $cond eq 'HASH') {
2435     if (keys %$cond and (keys %$cond)[0] eq '-and') {
2436       foreach my $subcond (@{$cond->{-and}}) {
2437         $collapsed = $self->_collapse_cond($subcond, $collapsed);
2438       }
2439     }
2440     else {
2441       foreach my $col (keys %$cond) {
2442         my $value = $cond->{$col};
2443         $collapsed->{$col} = $value;
2444       }
2445     }
2446   }
2447
2448   return $collapsed;
2449 }
2450
2451 # _remove_alias
2452 #
2453 # Remove the specified alias from the specified query hash. A copy is made so
2454 # the original query is not modified.
2455
2456 sub _remove_alias {
2457   my ($self, $query, $alias) = @_;
2458
2459   my %orig = %{ $query || {} };
2460   my %unaliased;
2461
2462   foreach my $key (keys %orig) {
2463     if ($key !~ /\./) {
2464       $unaliased{$key} = $orig{$key};
2465       next;
2466     }
2467     $unaliased{$1} = $orig{$key}
2468       if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
2469   }
2470
2471   return \%unaliased;
2472 }
2473
2474 =head2 as_query
2475
2476 =over 4
2477
2478 =item Arguments: none
2479
2480 =item Return Value: \[ $sql, @bind ]
2481
2482 =back
2483
2484 Returns the SQL query and bind vars associated with the invocant.
2485
2486 This is generally used as the RHS for a subquery.
2487
2488 =cut
2489
2490 sub as_query {
2491   my $self = shift;
2492
2493   my $attrs = $self->_resolved_attrs_copy;
2494
2495   # For future use:
2496   #
2497   # in list ctx:
2498   # my ($sql, \@bind, \%dbi_bind_attrs) = _select_args_to_query (...)
2499   # $sql also has no wrapping parenthesis in list ctx
2500   #
2501   my $sqlbind = $self->result_source->storage
2502     ->_select_args_to_query ($attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs);
2503
2504   return $sqlbind;
2505 }
2506
2507 =head2 find_or_new
2508
2509 =over 4
2510
2511 =item Arguments: \%vals, \%attrs?
2512
2513 =item Return Value: $rowobject
2514
2515 =back
2516
2517   my $artist = $schema->resultset('Artist')->find_or_new(
2518     { artist => 'fred' }, { key => 'artists' });
2519
2520   $cd->cd_to_producer->find_or_new({ producer => $producer },
2521                                    { key => 'primary });
2522
2523 Find an existing record from this resultset using L</find>. if none exists,
2524 instantiate a new result object and return it. The object will not be saved
2525 into your storage until you call L<DBIx::Class::Row/insert> on it.
2526
2527 You most likely want this method when looking for existing rows using a unique
2528 constraint that is not the primary key, or looking for related rows.
2529
2530 If you want objects to be saved immediately, use L</find_or_create> instead.
2531
2532 B<Note>: Make sure to read the documentation of L</find> and understand the
2533 significance of the C<key> attribute, as its lack may skew your search, and
2534 subsequently result in spurious new objects.
2535
2536 B<Note>: Take care when using C<find_or_new> with a table having
2537 columns with default values that you intend to be automatically
2538 supplied by the database (e.g. an auto_increment primary key column).
2539 In normal usage, the value of such columns should NOT be included at
2540 all in the call to C<find_or_new>, even when set to C<undef>.
2541
2542 =cut
2543
2544 sub find_or_new {
2545   my $self     = shift;
2546   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2547   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2548   if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2549     return $row;
2550   }
2551   return $self->new_result($hash);
2552 }
2553
2554 =head2 create
2555
2556 =over 4
2557
2558 =item Arguments: \%vals
2559
2560 =item Return Value: a L<DBIx::Class::Row> $object
2561
2562 =back
2563
2564 Attempt to create a single new row or a row with multiple related rows
2565 in the table represented by the resultset (and related tables). This
2566 will not check for duplicate rows before inserting, use
2567 L</find_or_create> to do that.
2568
2569 To create one row for this resultset, pass a hashref of key/value
2570 pairs representing the columns of the table and the values you wish to
2571 store. If the appropriate relationships are set up, foreign key fields
2572 can also be passed an object representing the foreign row, and the
2573 value will be set to its primary key.
2574
2575 To create related objects, pass a hashref of related-object column values
2576 B<keyed on the relationship name>. If the relationship is of type C<multi>
2577 (L<DBIx::Class::Relationship/has_many>) - pass an arrayref of hashrefs.
2578 The process will correctly identify columns holding foreign keys, and will
2579 transparently populate them from the keys of the corresponding relation.
2580 This can be applied recursively, and will work correctly for a structure
2581 with an arbitrary depth and width, as long as the relationships actually
2582 exists and the correct column data has been supplied.
2583
2584
2585 Instead of hashrefs of plain related data (key/value pairs), you may
2586 also pass new or inserted objects. New objects (not inserted yet, see
2587 L</new>), will be inserted into their appropriate tables.
2588
2589 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
2590
2591 Example of creating a new row.
2592
2593   $person_rs->create({
2594     name=>"Some Person",
2595     email=>"somebody@someplace.com"
2596   });
2597
2598 Example of creating a new row and also creating rows in a related C<has_many>
2599 or C<has_one> resultset.  Note Arrayref.
2600
2601   $artist_rs->create(
2602      { artistid => 4, name => 'Manufactured Crap', cds => [
2603         { title => 'My First CD', year => 2006 },
2604         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2605       ],
2606      },
2607   );
2608
2609 Example of creating a new row and also creating a row in a related
2610 C<belongs_to> resultset. Note Hashref.
2611
2612   $cd_rs->create({
2613     title=>"Music for Silly Walks",
2614     year=>2000,
2615     artist => {
2616       name=>"Silly Musician",
2617     }
2618   });
2619
2620 =over
2621
2622 =item WARNING
2623
2624 When subclassing ResultSet never attempt to override this method. Since
2625 it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a
2626 lot of the internals simply never call it, so your override will be
2627 bypassed more often than not. Override either L<new|DBIx::Class::Row/new>
2628 or L<insert|DBIx::Class::Row/insert> depending on how early in the
2629 L</create> process you need to intervene.
2630
2631 =back
2632
2633 =cut
2634
2635 sub create {
2636   my ($self, $attrs) = @_;
2637   $self->throw_exception( "create needs a hashref" )
2638     unless ref $attrs eq 'HASH';
2639   return $self->new_result($attrs)->insert;
2640 }
2641
2642 =head2 find_or_create
2643
2644 =over 4
2645
2646 =item Arguments: \%vals, \%attrs?
2647
2648 =item Return Value: $rowobject
2649
2650 =back
2651
2652   $cd->cd_to_producer->find_or_create({ producer => $producer },
2653                                       { key => 'primary' });
2654
2655 Tries to find a record based on its primary key or unique constraints; if none
2656 is found, creates one and returns that instead.
2657
2658   my $cd = $schema->resultset('CD')->find_or_create({
2659     cdid   => 5,
2660     artist => 'Massive Attack',
2661     title  => 'Mezzanine',
2662     year   => 2005,
2663   });
2664
2665 Also takes an optional C<key> attribute, to search by a specific key or unique
2666 constraint. For example:
2667
2668   my $cd = $schema->resultset('CD')->find_or_create(
2669     {
2670       artist => 'Massive Attack',
2671       title  => 'Mezzanine',
2672     },
2673     { key => 'cd_artist_title' }
2674   );
2675
2676 B<Note>: Make sure to read the documentation of L</find> and understand the
2677 significance of the C<key> attribute, as its lack may skew your search, and
2678 subsequently result in spurious row creation.
2679
2680 B<Note>: Because find_or_create() reads from the database and then
2681 possibly inserts based on the result, this method is subject to a race
2682 condition. Another process could create a record in the table after
2683 the find has completed and before the create has started. To avoid
2684 this problem, use find_or_create() inside a transaction.
2685
2686 B<Note>: Take care when using C<find_or_create> with a table having
2687 columns with default values that you intend to be automatically
2688 supplied by the database (e.g. an auto_increment primary key column).
2689 In normal usage, the value of such columns should NOT be included at
2690 all in the call to C<find_or_create>, even when set to C<undef>.
2691
2692 See also L</find> and L</update_or_create>. For information on how to declare
2693 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2694
2695 If you need to know if an existing row was found or a new one created use
2696 L</find_or_new> and L<DBIx::Class::Row/in_storage> instead. Don't forget
2697 to call L<DBIx::Class::Row/insert> to save the newly created row to the
2698 database!
2699
2700   my $cd = $schema->resultset('CD')->find_or_new({
2701     cdid   => 5,
2702     artist => 'Massive Attack',
2703     title  => 'Mezzanine',
2704     year   => 2005,
2705   });
2706
2707   if( $cd->in_storage ) {
2708       # do some stuff
2709       $cd->insert;
2710   }
2711
2712 =cut
2713
2714 sub find_or_create {
2715   my $self     = shift;
2716   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2717   my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
2718   if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2719     return $row;
2720   }
2721   return $self->create($hash);
2722 }
2723
2724 =head2 update_or_create
2725
2726 =over 4
2727
2728 =item Arguments: \%col_values, { key => $unique_constraint }?
2729
2730 =item Return Value: $row_object
2731
2732 =back
2733
2734   $resultset->update_or_create({ col => $val, ... });
2735
2736 Like L</find_or_create>, but if a row is found it is immediately updated via
2737 C<< $found_row->update (\%col_values) >>.
2738
2739
2740 Takes an optional C<key> attribute to search on a specific unique constraint.
2741 For example:
2742
2743   # In your application
2744   my $cd = $schema->resultset('CD')->update_or_create(
2745     {
2746       artist => 'Massive Attack',
2747       title  => 'Mezzanine',
2748       year   => 1998,
2749     },
2750     { key => 'cd_artist_title' }
2751   );
2752
2753   $cd->cd_to_producer->update_or_create({
2754     producer => $producer,
2755     name => 'harry',
2756   }, {
2757     key => 'primary',
2758   });
2759
2760 B<Note>: Make sure to read the documentation of L</find> and understand the
2761 significance of the C<key> attribute, as its lack may skew your search, and
2762 subsequently result in spurious row creation.
2763
2764 B<Note>: Take care when using C<update_or_create> with a table having
2765 columns with default values that you intend to be automatically
2766 supplied by the database (e.g. an auto_increment primary key column).
2767 In normal usage, the value of such columns should NOT be included at
2768 all in the call to C<update_or_create>, even when set to C<undef>.
2769
2770 See also L</find> and L</find_or_create>. For information on how to declare
2771 unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2772
2773 If you need to know if an existing row was updated or a new one created use
2774 L</update_or_new> and L<DBIx::Class::Row/in_storage> instead. Don't forget
2775 to call L<DBIx::Class::Row/insert> to save the newly created row to the
2776 database!
2777
2778   my $cd = $schema->resultset('CD')->update_or_new(
2779     {
2780       artist => 'Massive Attack',
2781       title  => 'Mezzanine',
2782       year   => 1998,
2783     },
2784     { key => 'cd_artist_title' }
2785   );
2786
2787   if( $cd->in_storage ) {
2788       # do some stuff
2789       $cd->insert;
2790   }
2791
2792 =cut
2793
2794 sub update_or_create {
2795   my $self = shift;
2796   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2797   my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
2798
2799   my $row = $self->find($cond, $attrs);
2800   if (defined $row) {
2801     $row->update($cond);
2802     return $row;
2803   }
2804
2805   return $self->create($cond);
2806 }
2807
2808 =head2 update_or_new
2809
2810 =over 4
2811
2812 =item Arguments: \%col_values, { key => $unique_constraint }?
2813
2814 =item Return Value: $rowobject
2815
2816 =back
2817
2818   $resultset->update_or_new({ col => $val, ... });
2819
2820 Like L</find_or_new> but if a row is found it is immediately updated via
2821 C<< $found_row->update (\%col_values) >>.
2822
2823 For example:
2824
2825   # In your application
2826   my $cd = $schema->resultset('CD')->update_or_new(
2827     {
2828       artist => 'Massive Attack',
2829       title  => 'Mezzanine',
2830       year   => 1998,
2831     },
2832     { key => 'cd_artist_title' }
2833   );
2834
2835   if ($cd->in_storage) {
2836       # the cd was updated
2837   }
2838   else {
2839       # the cd is not yet in the database, let's insert it
2840       $cd->insert;
2841   }
2842
2843 B<Note>: Make sure to read the documentation of L</find> and understand the
2844 significance of the C<key> attribute, as its lack may skew your search, and
2845 subsequently result in spurious new objects.
2846
2847 B<Note>: Take care when using C<update_or_new> with a table having
2848 columns with default values that you intend to be automatically
2849 supplied by the database (e.g. an auto_increment primary key column).
2850 In normal usage, the value of such columns should NOT be included at
2851 all in the call to C<update_or_new>, even when set to C<undef>.
2852
2853 See also L</find>, L</find_or_create> and L</find_or_new>.
2854
2855 =cut
2856
2857 sub update_or_new {
2858     my $self  = shift;
2859     my $attrs = ( @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {} );
2860     my $cond  = ref $_[0] eq 'HASH' ? shift : {@_};
2861
2862     my $row = $self->find( $cond, $attrs );
2863     if ( defined $row ) {
2864         $row->update($cond);
2865         return $row;
2866     }
2867
2868     return $self->new_result($cond);
2869 }
2870
2871 =head2 get_cache
2872
2873 =over 4
2874
2875 =item Arguments: none
2876
2877 =item Return Value: \@cache_objects | undef
2878
2879 =back
2880
2881 Gets the contents of the cache for the resultset, if the cache is set.
2882
2883 The cache is populated either by using the L</prefetch> attribute to
2884 L</search> or by calling L</set_cache>.
2885
2886 =cut
2887
2888 sub get_cache {
2889   shift->{all_cache};
2890 }
2891
2892 =head2 set_cache
2893
2894 =over 4
2895
2896 =item Arguments: \@cache_objects
2897
2898 =item Return Value: \@cache_objects
2899
2900 =back
2901
2902 Sets the contents of the cache for the resultset. Expects an arrayref
2903 of objects of the same class as those produced by the resultset. Note that
2904 if the cache is set the resultset will return the cached objects rather
2905 than re-querying the database even if the cache attr is not set.
2906
2907 The contents of the cache can also be populated by using the
2908 L</prefetch> attribute to L</search>.
2909
2910 =cut
2911
2912 sub set_cache {
2913   my ( $self, $data ) = @_;
2914   $self->throw_exception("set_cache requires an arrayref")
2915       if defined($data) && (ref $data ne 'ARRAY');
2916   $self->{all_cache} = $data;
2917 }
2918
2919 =head2 clear_cache
2920
2921 =over 4
2922
2923 =item Arguments: none
2924
2925 =item Return Value: undef
2926
2927 =back
2928
2929 Clears the cache for the resultset.
2930
2931 =cut
2932
2933 sub clear_cache {
2934   shift->set_cache(undef);
2935 }
2936
2937 =head2 is_paged
2938
2939 =over 4
2940
2941 =item Arguments: none
2942
2943 =item Return Value: true, if the resultset has been paginated
2944
2945 =back
2946
2947 =cut
2948
2949 sub is_paged {
2950   my ($self) = @_;
2951   return !!$self->{attrs}{page};
2952 }
2953
2954 =head2 is_ordered
2955
2956 =over 4
2957
2958 =item Arguments: none
2959
2960 =item Return Value: true, if the resultset has been ordered with C<order_by>.
2961
2962 =back
2963
2964 =cut
2965
2966 sub is_ordered {
2967   my ($self) = @_;
2968   return scalar $self->result_source->storage->_extract_order_criteria($self->{attrs}{order_by});
2969 }
2970
2971 =head2 related_resultset
2972
2973 =over 4
2974
2975 =item Arguments: $relationship_name
2976
2977 =item Return Value: $resultset
2978
2979 =back
2980
2981 Returns a related resultset for the supplied relationship name.
2982
2983   $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
2984
2985 =cut
2986
2987 sub related_resultset {
2988   my ($self, $rel) = @_;
2989
2990   $self->{related_resultsets} ||= {};
2991   return $self->{related_resultsets}{$rel} ||= do {
2992     my $rsrc = $self->result_source;
2993     my $rel_info = $rsrc->relationship_info($rel);
2994
2995     $self->throw_exception(
2996       "search_related: result source '" . $rsrc->source_name .
2997         "' has no such relationship $rel")
2998       unless $rel_info;
2999
3000     my $attrs = $self->_chain_relationship($rel);
3001
3002     my $join_count = $attrs->{seen_join}{$rel};
3003
3004     my $alias = $self->result_source->storage
3005         ->relname_to_table_alias($rel, $join_count);
3006
3007     # since this is search_related, and we already slid the select window inwards
3008     # (the select/as attrs were deleted in the beginning), we need to flip all
3009     # left joins to inner, so we get the expected results
3010     # read the comment on top of the actual function to see what this does
3011     $attrs->{from} = $rsrc->schema->storage->_inner_join_to_node ($attrs->{from}, $alias);
3012
3013
3014     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
3015     delete @{$attrs}{qw(result_class alias)};
3016
3017     my $new_cache;
3018
3019     if (my $cache = $self->get_cache) {
3020       if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) {
3021         $new_cache = [ map { @{$_->related_resultset($rel)->get_cache||[]} }
3022                         @$cache ];
3023       }
3024     }
3025
3026     my $rel_source = $rsrc->related_source($rel);
3027
3028     my $new = do {
3029
3030       # The reason we do this now instead of passing the alias to the
3031       # search_rs below is that if you wrap/overload resultset on the
3032       # source you need to know what alias it's -going- to have for things
3033       # to work sanely (e.g. RestrictWithObject wants to be able to add
3034       # extra query restrictions, and these may need to be $alias.)
3035
3036       my $rel_attrs = $rel_source->resultset_attributes;
3037       local $rel_attrs->{alias} = $alias;
3038
3039       $rel_source->resultset
3040                  ->search_rs(
3041                      undef, {
3042                        %$attrs,
3043                        where => $attrs->{where},
3044                    });
3045     };
3046     $new->set_cache($new_cache) if $new_cache;
3047     $new;
3048   };
3049 }
3050
3051 =head2 current_source_alias
3052
3053 =over 4
3054
3055 =item Arguments: none
3056
3057 =item Return Value: $source_alias
3058
3059 =back
3060
3061 Returns the current table alias for the result source this resultset is built
3062 on, that will be used in the SQL query. Usually it is C<me>.
3063
3064 Currently the source alias that refers to the result set returned by a
3065 L</search>/L</find> family method depends on how you got to the resultset: it's
3066 C<me> by default, but eg. L</search_related> aliases it to the related result
3067 source name (and keeps C<me> referring to the original result set). The long
3068 term goal is to make L<DBIx::Class> always alias the current resultset as C<me>
3069 (and make this method unnecessary).
3070
3071 Thus it's currently necessary to use this method in predefined queries (see
3072 L<DBIx::Class::Manual::Cookbook/Predefined searches>) when referring to the
3073 source alias of the current result set:
3074
3075   # in a result set class
3076   sub modified_by {
3077     my ($self, $user) = @_;
3078
3079     my $me = $self->current_source_alias;
3080
3081     return $self->search({
3082       "$me.modified" => $user->id,
3083     });
3084   }
3085
3086 =cut
3087
3088 sub current_source_alias {
3089   my ($self) = @_;
3090
3091   return ($self->{attrs} || {})->{alias} || 'me';
3092 }
3093
3094 =head2 as_subselect_rs
3095
3096 =over 4
3097
3098 =item Arguments: none
3099
3100 =item Return Value: $resultset
3101
3102 =back
3103
3104 Act as a barrier to SQL symbols.  The resultset provided will be made into a
3105 "virtual view" by including it as a subquery within the from clause.  From this
3106 point on, any joined tables are inaccessible to ->search on the resultset (as if
3107 it were simply where-filtered without joins).  For example:
3108
3109  my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' });
3110
3111  # 'x' now pollutes the query namespace
3112
3113  # So the following works as expected
3114  my $ok_rs = $rs->search({'x.other' => 1});
3115
3116  # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and
3117  # def) we look for one row with contradictory terms and join in another table
3118  # (aliased 'x_2') which we never use
3119  my $broken_rs = $rs->search({'x.name' => 'def'});
3120
3121  my $rs2 = $rs->as_subselect_rs;
3122
3123  # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away
3124  my $not_joined_rs = $rs2->search({'x.other' => 1});
3125
3126  # works as expected: finds a 'table' row related to two x rows (abc and def)
3127  my $correctly_joined_rs = $rs2->search({'x.name' => 'def'});
3128
3129 Another example of when one might use this would be to select a subset of
3130 columns in a group by clause:
3131
3132  my $rs = $schema->resultset('Bar')->search(undef, {
3133    group_by => [qw{ id foo_id baz_id }],
3134  })->as_subselect_rs->search(undef, {
3135    columns => [qw{ id foo_id }]
3136  });
3137
3138 In the above example normally columns would have to be equal to the group by,
3139 but because we isolated the group by into a subselect the above works.
3140
3141 =cut
3142
3143 sub as_subselect_rs {
3144   my $self = shift;
3145
3146   my $attrs = $self->_resolved_attrs;
3147
3148   my $fresh_rs = (ref $self)->new (
3149     $self->result_source
3150   );
3151
3152   # these pieces will be locked in the subquery
3153   delete $fresh_rs->{cond};
3154   delete @{$fresh_rs->{attrs}}{qw/where bind/};
3155
3156   return $fresh_rs->search( {}, {
3157     from => [{
3158       $attrs->{alias} => $self->as_query,
3159       -alias  => $attrs->{alias},
3160       -rsrc   => $self->result_source,
3161     }],
3162     alias => $attrs->{alias},
3163   });
3164 }
3165
3166 # This code is called by search_related, and makes sure there
3167 # is clear separation between the joins before, during, and
3168 # after the relationship. This information is needed later
3169 # in order to properly resolve prefetch aliases (any alias
3170 # with a relation_chain_depth less than the depth of the
3171 # current prefetch is not considered)
3172 #
3173 # The increments happen twice per join. An even number means a
3174 # relationship specified via a search_related, whereas an odd
3175 # number indicates a join/prefetch added via attributes
3176 #
3177 # Also this code will wrap the current resultset (the one we
3178 # chain to) in a subselect IFF it contains limiting attributes
3179 sub _chain_relationship {
3180   my ($self, $rel) = @_;
3181   my $source = $self->result_source;
3182   my $attrs = { %{$self->{attrs}||{}} };
3183
3184   # we need to take the prefetch the attrs into account before we
3185   # ->_resolve_join as otherwise they get lost - captainL
3186   my $join = $self->_merge_joinpref_attr( $attrs->{join}, $attrs->{prefetch} );
3187
3188   delete @{$attrs}{qw/join prefetch collapse group_by distinct select as columns +select +as +columns/};
3189
3190   my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
3191
3192   my $from;
3193   my @force_subq_attrs = qw/offset rows group_by having/;
3194
3195   if (
3196     ($attrs->{from} && ref $attrs->{from} ne 'ARRAY')
3197       ||
3198     $self->_has_resolved_attr (@force_subq_attrs)
3199   ) {
3200     # Nuke the prefetch (if any) before the new $rs attrs
3201     # are resolved (prefetch is useless - we are wrapping
3202     # a subquery anyway).
3203     my $rs_copy = $self->search;
3204     $rs_copy->{attrs}{join} = $self->_merge_joinpref_attr (
3205       $rs_copy->{attrs}{join},
3206       delete $rs_copy->{attrs}{prefetch},
3207     );
3208
3209     $from = [{
3210       -rsrc   => $source,
3211       -alias  => $attrs->{alias},
3212       $attrs->{alias} => $rs_copy->as_query,
3213     }];
3214     delete @{$attrs}{@force_subq_attrs, qw/where bind/};
3215     $seen->{-relation_chain_depth} = 0;
3216   }
3217   elsif ($attrs->{from}) {  #shallow copy suffices
3218     $from = [ @{$attrs->{from}} ];
3219   }
3220   else {
3221     $from = [{
3222       -rsrc  => $source,
3223       -alias => $attrs->{alias},
3224       $attrs->{alias} => $source->from,
3225     }];
3226   }
3227
3228   my $jpath = ($seen->{-relation_chain_depth})
3229     ? $from->[-1][0]{-join_path}
3230     : [];
3231
3232   my @requested_joins = $source->_resolve_join(
3233     $join,
3234     $attrs->{alias},
3235     $seen,
3236     $jpath,
3237   );
3238
3239   push @$from, @requested_joins;
3240
3241   $seen->{-relation_chain_depth}++;
3242
3243   # if $self already had a join/prefetch specified on it, the requested
3244   # $rel might very well be already included. What we do in this case
3245   # is effectively a no-op (except that we bump up the chain_depth on
3246   # the join in question so we could tell it *is* the search_related)
3247   my $already_joined;
3248
3249   # we consider the last one thus reverse
3250   for my $j (reverse @requested_joins) {
3251     my ($last_j) = keys %{$j->[0]{-join_path}[-1]};
3252     if ($rel eq $last_j) {
3253       $j->[0]{-relation_chain_depth}++;
3254       $already_joined++;
3255       last;
3256     }
3257   }
3258
3259   unless ($already_joined) {
3260     push @$from, $source->_resolve_join(
3261       $rel,
3262       $attrs->{alias},
3263       $seen,
3264       $jpath,
3265     );
3266   }
3267
3268   $seen->{-relation_chain_depth}++;
3269
3270   return {%$attrs, from => $from, seen_join => $seen};
3271 }
3272
3273 # too many times we have to do $attrs = { %{$self->_resolved_attrs} }
3274 sub _resolved_attrs_copy {
3275   my $self = shift;
3276   return { %{$self->_resolved_attrs (@_)} };
3277 }
3278
3279 sub _resolved_attrs {
3280   my $self = shift;
3281   return $self->{_attrs} if $self->{_attrs};
3282
3283   my $attrs  = { %{ $self->{attrs} || {} } };
3284   my $source = $self->result_source;
3285   my $alias  = $attrs->{alias};
3286
3287   # default selection list
3288   $attrs->{columns} = [ $source->columns ]
3289     unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/;
3290
3291   # merge selectors together
3292   for (qw/columns select as/) {
3293     $attrs->{$_} = $self->_merge_attr($attrs->{$_}, delete $attrs->{"+$_"})
3294       if $attrs->{$_} or $attrs->{"+$_"};
3295   }
3296
3297   # disassemble columns
3298   my (@sel, @as);
3299   if (my $cols = delete $attrs->{columns}) {
3300     for my $c (ref $cols eq 'ARRAY' ? @$cols : $cols) {
3301       if (ref $c eq 'HASH') {
3302         for my $as (keys %$c) {
3303           push @sel, $c->{$as};
3304           push @as, $as;
3305         }
3306       }
3307       else {
3308         push @sel, $c;
3309         push @as, $c;
3310       }
3311     }
3312   }
3313
3314   # when trying to weed off duplicates later do not go past this point -
3315   # everything added from here on is unbalanced "anyone's guess" stuff
3316   my $dedup_stop_idx = $#as;
3317
3318   push @as, @{ ref $attrs->{as} eq 'ARRAY' ? $attrs->{as} : [ $attrs->{as} ] }
3319     if $attrs->{as};
3320   push @sel, @{ ref $attrs->{select} eq 'ARRAY' ? $attrs->{select} : [ $attrs->{select} ] }
3321     if $attrs->{select};
3322
3323   # assume all unqualified selectors to apply to the current alias (legacy stuff)
3324   $_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_" for @sel;
3325
3326   # disqualify all $alias.col as-bits (inflate-map mandated)
3327   $_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_ for @as;
3328
3329   # de-duplicate the result (remove *identical* select/as pairs)
3330   # and also die on duplicate {as} pointing to different {select}s
3331   # not using a c-style for as the condition is prone to shrinkage
3332   my $seen;
3333   my $i = 0;
3334   while ($i <= $dedup_stop_idx) {
3335     if ($seen->{"$sel[$i] \x00\x00 $as[$i]"}++) {
3336       splice @sel, $i, 1;
3337       splice @as, $i, 1;
3338       $dedup_stop_idx--;
3339     }
3340     elsif ($seen->{$as[$i]}++) {
3341       $self->throw_exception(
3342         "inflate_result() alias '$as[$i]' specified twice with different SQL-side {select}-ors"
3343       );
3344     }
3345     else {
3346       $i++;
3347     }
3348   }
3349
3350   $attrs->{select} = \@sel;
3351   $attrs->{as} = \@as;
3352
3353   $attrs->{from} ||= [{
3354     -rsrc   => $source,
3355     -alias  => $self->{attrs}{alias},
3356     $self->{attrs}{alias} => $source->from,
3357   }];
3358
3359   if ( $attrs->{join} || $attrs->{prefetch} ) {
3360
3361     $self->throw_exception ('join/prefetch can not be used with a custom {from}')
3362       if ref $attrs->{from} ne 'ARRAY';
3363
3364     my $join = (delete $attrs->{join}) || {};
3365
3366     if ( defined $attrs->{prefetch} ) {
3367       $join = $self->_merge_joinpref_attr( $join, $attrs->{prefetch} );
3368     }
3369
3370     $attrs->{from} =    # have to copy here to avoid corrupting the original
3371       [
3372         @{ $attrs->{from} },
3373         $source->_resolve_join(
3374           $join,
3375           $alias,
3376           { %{ $attrs->{seen_join} || {} } },
3377           ( $attrs->{seen_join} && keys %{$attrs->{seen_join}})
3378             ? $attrs->{from}[-1][0]{-join_path}
3379             : []
3380           ,
3381         )
3382       ];
3383   }
3384
3385   if ( defined $attrs->{order_by} ) {
3386     $attrs->{order_by} = (
3387       ref( $attrs->{order_by} ) eq 'ARRAY'
3388       ? [ @{ $attrs->{order_by} } ]
3389       : [ $attrs->{order_by} || () ]
3390     );
3391   }
3392
3393   if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') {
3394     $attrs->{group_by} = [ $attrs->{group_by} ];
3395   }
3396
3397   # generate the distinct induced group_by early, as prefetch will be carried via a
3398   # subquery (since a group_by is present)
3399   if (delete $attrs->{distinct}) {
3400     if ($attrs->{group_by}) {
3401       carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
3402     }
3403     else {
3404       # distinct affects only the main selection part, not what prefetch may
3405       # add below.
3406       $attrs->{group_by} = $source->storage->_group_over_selection (
3407         $attrs->{from},
3408         $attrs->{select},
3409         $attrs->{order_by},
3410       );
3411     }
3412   }
3413
3414   # generate selections based on the prefetch helper
3415   my $prefetch;
3416   $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} )
3417     if defined $attrs->{prefetch};
3418
3419   if ($prefetch) {
3420
3421     $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
3422       if $attrs->{_dark_selector};
3423
3424     $attrs->{collapse} = 1;
3425
3426     # this is a separate structure (we don't look in {from} directly)
3427     # as the resolver needs to shift things off the lists to work
3428     # properly (identical-prefetches on different branches)
3429     my $join_map = {};
3430     if (ref $attrs->{from} eq 'ARRAY') {
3431
3432       my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0;
3433
3434       for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
3435         next unless $j->[0]{-alias};
3436         next unless $j->[0]{-join_path};
3437         next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth;
3438
3439         my @jpath = map { keys %$_ } @{$j->[0]{-join_path}};
3440
3441         my $p = $join_map;
3442         $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries
3443         push @{$p->{-join_aliases} }, $j->[0]{-alias};
3444       }
3445     }
3446
3447     my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map );
3448
3449     # we need to somehow mark which columns came from prefetch
3450     if (@prefetch) {
3451       my $sel_end = $#{$attrs->{select}};
3452       $attrs->{_prefetch_selector_range} = [ $sel_end + 1, $sel_end + @prefetch ];
3453     }
3454
3455     push @{ $attrs->{select} }, (map { $_->[0] } @prefetch);
3456     push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
3457   }
3458
3459   $attrs->{_single_object_inflation} = ! List::Util::first { $_ =~ /\./ } @{$attrs->{as}};
3460
3461   # run through the resulting joinstructure (starting from our current slot)
3462   # and unset collapse if proven unnesessary
3463   if ($attrs->{collapse} && ref $attrs->{from} eq 'ARRAY') {
3464
3465     if (@{$attrs->{from}} > 1) {
3466
3467       # find where our table-spec starts and consider only things after us
3468       my @fromlist = @{$attrs->{from}};
3469       while (@fromlist) {
3470         my $t = shift @fromlist;
3471         $t = $t->[0] if ref $t eq 'ARRAY';  #me vs join from-spec mismatch
3472         last if ($t->{-alias} && $t->{-alias} eq $alias);
3473       }
3474
3475       for (@fromlist) {
3476         $attrs->{collapse} = ! $_->[0]{-is_single}
3477           and last;
3478       }
3479     }
3480     else {
3481       # no joins - no collapse
3482       $attrs->{collapse} = 0;
3483     }
3484   }
3485
3486   if (! $attrs->{order_by} and $attrs->{collapse}) {
3487     # default order for collapsing unless the user asked for something
3488     $attrs->{order_by} = [ map { "$alias.$_" } $source->primary_columns ];
3489     $attrs->{_ordered_for_collapse} = 1;
3490     $attrs->{_order_is_artificial} = 1;
3491   }
3492
3493   # if both page and offset are specified, produce a combined offset
3494   # even though it doesn't make much sense, this is what pre 081xx has
3495   # been doing
3496   if (my $page = delete $attrs->{page}) {
3497     $attrs->{offset} =
3498       ($attrs->{rows} * ($page - 1))
3499             +
3500       ($attrs->{offset} || 0)
3501     ;
3502   }
3503
3504   return $self->{_attrs} = $attrs;
3505 }
3506
3507 sub _rollout_attr {
3508   my ($self, $attr) = @_;
3509
3510   if (ref $attr eq 'HASH') {
3511     return $self->_rollout_hash($attr);
3512   } elsif (ref $attr eq 'ARRAY') {
3513     return $self->_rollout_array($attr);
3514   } else {
3515     return [$attr];
3516   }
3517 }
3518
3519 sub _rollout_array {
3520   my ($self, $attr) = @_;
3521
3522   my @rolled_array;
3523   foreach my $element (@{$attr}) {
3524     if (ref $element eq 'HASH') {
3525       push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
3526     } elsif (ref $element eq 'ARRAY') {
3527       #  XXX - should probably recurse here
3528       push( @rolled_array, @{$self->_rollout_array($element)} );
3529     } else {
3530       push( @rolled_array, $element );
3531     }
3532   }
3533   return \@rolled_array;
3534 }
3535
3536 sub _rollout_hash {
3537   my ($self, $attr) = @_;
3538
3539   my @rolled_array;
3540   foreach my $key (keys %{$attr}) {
3541     push( @rolled_array, { $key => $attr->{$key} } );
3542   }
3543   return \@rolled_array;
3544 }
3545
3546 sub _calculate_score {
3547   my ($self, $a, $b) = @_;
3548
3549   if (defined $a xor defined $b) {
3550     return 0;
3551   }
3552   elsif (not defined $a) {
3553     return 1;
3554   }
3555
3556   if (ref $b eq 'HASH') {
3557     my ($b_key) = keys %{$b};
3558     if (ref $a eq 'HASH') {
3559       my ($a_key) = keys %{$a};
3560       if ($a_key eq $b_key) {
3561         return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
3562       } else {
3563         return 0;
3564       }
3565     } else {
3566       return ($a eq $b_key) ? 1 : 0;
3567     }
3568   } else {
3569     if (ref $a eq 'HASH') {
3570       my ($a_key) = keys %{$a};
3571       return ($b eq $a_key) ? 1 : 0;
3572     } else {
3573       return ($b eq $a) ? 1 : 0;
3574     }
3575   }
3576 }
3577
3578 sub _merge_joinpref_attr {
3579   my ($self, $orig, $import) = @_;
3580
3581   return $import unless defined($orig);
3582   return $orig unless defined($import);
3583
3584   $orig = $self->_rollout_attr($orig);
3585   $import = $self->_rollout_attr($import);
3586
3587   my $seen_keys;
3588   foreach my $import_element ( @{$import} ) {
3589     # find best candidate from $orig to merge $b_element into
3590     my $best_candidate = { position => undef, score => 0 }; my $position = 0;
3591     foreach my $orig_element ( @{$orig} ) {
3592       my $score = $self->_calculate_score( $orig_element, $import_element );
3593       if ($score > $best_candidate->{score}) {
3594         $best_candidate->{position} = $position;
3595         $best_candidate->{score} = $score;
3596       }
3597       $position++;
3598     }
3599     my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
3600     $import_key = '' if not defined $import_key;
3601
3602     if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
3603       push( @{$orig}, $import_element );
3604     } else {
3605       my $orig_best = $orig->[$best_candidate->{position}];
3606       # merge orig_best and b_element together and replace original with merged
3607       if (ref $orig_best ne 'HASH') {
3608         $orig->[$best_candidate->{position}] = $import_element;
3609       } elsif (ref $import_element eq 'HASH') {
3610         my ($key) = keys %{$orig_best};
3611         $orig->[$best_candidate->{position}] = { $key => $self->_merge_joinpref_attr($orig_best->{$key}, $import_element->{$key}) };
3612       }
3613     }
3614     $seen_keys->{$import_key} = 1; # don't merge the same key twice
3615   }
3616
3617   return $orig;
3618 }
3619
3620 {
3621   my $hm;
3622
3623   sub _merge_attr {
3624     $hm ||= do {
3625       require Hash::Merge;
3626       my $hm = Hash::Merge->new;
3627
3628       $hm->specify_behavior({
3629         SCALAR => {
3630           SCALAR => sub {
3631             my ($defl, $defr) = map { defined $_ } (@_[0,1]);
3632
3633             if ($defl xor $defr) {
3634               return [ $defl ? $_[0] : $_[1] ];
3635             }
3636             elsif (! $defl) {
3637               return [];
3638             }
3639             elsif (__HM_DEDUP and $_[0] eq $_[1]) {
3640               return [ $_[0] ];
3641             }
3642             else {
3643               return [$_[0], $_[1]];
3644             }
3645           },
3646           ARRAY => sub {
3647             return $_[1] if !defined $_[0];
3648             return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
3649             return [$_[0], @{$_[1]}]
3650           },
3651           HASH  => sub {
3652             return [] if !defined $_[0] and !keys %{$_[1]};
3653             return [ $_[1] ] if !defined $_[0];
3654             return [ $_[0] ] if !keys %{$_[1]};
3655             return [$_[0], $_[1]]
3656           },
3657         },
3658         ARRAY => {
3659           SCALAR => sub {
3660             return $_[0] if !defined $_[1];
3661             return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
3662             return [@{$_[0]}, $_[1]]
3663           },
3664           ARRAY => sub {
3665             my @ret = @{$_[0]} or return $_[1];
3666             return [ @ret, @{$_[1]} ] unless __HM_DEDUP;
3667             my %idx = map { $_ => 1 } @ret;
3668             push @ret, grep { ! defined $idx{$_} } (@{$_[1]});
3669             \@ret;
3670           },
3671           HASH => sub {
3672             return [ $_[1] ] if ! @{$_[0]};
3673             return $_[0] if !keys %{$_[1]};
3674             return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
3675             return [ @{$_[0]}, $_[1] ];
3676           },
3677         },
3678         HASH => {
3679           SCALAR => sub {
3680             return [] if !keys %{$_[0]} and !defined $_[1];
3681             return [ $_[0] ] if !defined $_[1];
3682             return [ $_[1] ] if !keys %{$_[0]};
3683             return [$_[0], $_[1]]
3684           },
3685           ARRAY => sub {
3686             return [] if !keys %{$_[0]} and !@{$_[1]};
3687             return [ $_[0] ] if !@{$_[1]};
3688             return $_[1] if !keys %{$_[0]};
3689             return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
3690             return [ $_[0], @{$_[1]} ];
3691           },
3692           HASH => sub {
3693             return [] if !keys %{$_[0]} and !keys %{$_[1]};
3694             return [ $_[0] ] if !keys %{$_[1]};
3695             return [ $_[1] ] if !keys %{$_[0]};
3696             return [ $_[0] ] if $_[0] eq $_[1];
3697             return [ $_[0], $_[1] ];
3698           },
3699         }
3700       } => 'DBIC_RS_ATTR_MERGER');
3701       $hm;
3702     };
3703
3704     return $hm->merge ($_[1], $_[2]);
3705   }
3706 }
3707
3708 sub STORABLE_freeze {
3709   my ($self, $cloning) = @_;
3710   my $to_serialize = { %$self };
3711
3712   # A cursor in progress can't be serialized (and would make little sense anyway)
3713   # the parser can be regenerated (and can't be serialized)
3714   delete @{$to_serialize}{qw/cursor _row_parser/};
3715
3716   # nor is it sensical to store a not-yet-fired-count pager
3717   if ($to_serialize->{pager} and ref $to_serialize->{pager}{total_entries} eq 'CODE') {
3718     delete $to_serialize->{pager};
3719   }
3720
3721   Storable::nfreeze($to_serialize);
3722 }
3723
3724 # need this hook for symmetry
3725 sub STORABLE_thaw {
3726   my ($self, $cloning, $serialized) = @_;
3727
3728   %$self = %{ Storable::thaw($serialized) };
3729
3730   $self;
3731 }
3732
3733
3734 =head2 throw_exception
3735
3736 See L<DBIx::Class::Schema/throw_exception> for details.
3737
3738 =cut
3739
3740 sub throw_exception {
3741   my $self=shift;
3742
3743   if (ref $self and my $rsrc = $self->result_source) {
3744     $rsrc->throw_exception(@_)
3745   }
3746   else {
3747     DBIx::Class::Exception->throw(@_);
3748   }
3749 }
3750
3751 # XXX: FIXME: Attributes docs need clearing up
3752
3753 =head1 ATTRIBUTES
3754
3755 Attributes are used to refine a ResultSet in various ways when
3756 searching for data. They can be passed to any method which takes an
3757 C<\%attrs> argument. See L</search>, L</search_rs>, L</find>,
3758 L</count>.
3759
3760 These are in no particular order:
3761
3762 =head2 order_by
3763
3764 =over 4
3765
3766 =item Value: ( $order_by | \@order_by | \%order_by )
3767
3768 =back
3769
3770 Which column(s) to order the results by.
3771
3772 [The full list of suitable values is documented in
3773 L<SQL::Abstract/"ORDER BY CLAUSES">; the following is a summary of
3774 common options.]
3775
3776 If a single column name, or an arrayref of names is supplied, the
3777 argument is passed through directly to SQL. The hashref syntax allows
3778 for connection-agnostic specification of ordering direction:
3779
3780  For descending order:
3781
3782   order_by => { -desc => [qw/col1 col2 col3/] }
3783
3784  For explicit ascending order:
3785
3786   order_by => { -asc => 'col' }
3787
3788 The old scalarref syntax (i.e. order_by => \'year DESC') is still
3789 supported, although you are strongly encouraged to use the hashref
3790 syntax as outlined above.
3791
3792 =head2 columns
3793
3794 =over 4
3795
3796 =item Value: \@columns
3797
3798 =back
3799
3800 Shortcut to request a particular set of columns to be retrieved. Each
3801 column spec may be a string (a table column name), or a hash (in which
3802 case the key is the C<as> value, and the value is used as the C<select>
3803 expression). Adds C<me.> onto the start of any column without a C<.> in
3804 it and sets C<select> from that, then auto-populates C<as> from
3805 C<select> as normal. (You may also use the C<cols> attribute, as in
3806 earlier versions of DBIC.)
3807
3808 Essentially C<columns> does the same as L</select> and L</as>.
3809
3810     columns => [ 'foo', { bar => 'baz' } ]
3811
3812 is the same as
3813
3814     select => [qw/foo baz/],
3815     as => [qw/foo bar/]
3816
3817 =head2 +columns
3818
3819 =over 4
3820
3821 =item Value: \@columns
3822
3823 =back
3824
3825 Indicates additional columns to be selected from storage. Works the same
3826 as L</columns> but adds columns to the selection. (You may also use the
3827 C<include_columns> attribute, as in earlier versions of DBIC). For
3828 example:-
3829
3830   $schema->resultset('CD')->search(undef, {
3831     '+columns' => ['artist.name'],
3832     join => ['artist']
3833   });
3834
3835 would return all CDs and include a 'name' column to the information
3836 passed to object inflation. Note that the 'artist' is the name of the
3837 column (or relationship) accessor, and 'name' is the name of the column
3838 accessor in the related table.
3839
3840 B<NOTE:> You need to explicitly quote '+columns' when defining the attribute.
3841 Not doing so causes Perl to incorrectly interpret +columns as a bareword with a
3842 unary plus operator before it.
3843
3844 =head2 include_columns
3845
3846 =over 4
3847
3848 =item Value: \@columns
3849
3850 =back
3851
3852 Deprecated.  Acts as a synonym for L</+columns> for backward compatibility.
3853
3854 =head2 select
3855
3856 =over 4
3857
3858 =item Value: \@select_columns
3859
3860 =back
3861
3862 Indicates which columns should be selected from the storage. You can use
3863 column names, or in the case of RDBMS back ends, function or stored procedure
3864 names:
3865
3866   $rs = $schema->resultset('Employee')->search(undef, {
3867     select => [
3868       'name',
3869       { count => 'employeeid' },
3870       { max => { length => 'name' }, -as => 'longest_name' }
3871     ]
3872   });
3873
3874   # Equivalent SQL
3875   SELECT name, COUNT( employeeid ), MAX( LENGTH( name ) ) AS longest_name FROM employee
3876
3877 B<NOTE:> You will almost always need a corresponding L</as> attribute when you
3878 use L</select>, to instruct DBIx::Class how to store the result of the column.
3879 Also note that the L</as> attribute has nothing to do with the SQL-side 'AS'
3880 identifier aliasing. You can however alias a function, so you can use it in
3881 e.g. an C<ORDER BY> clause. This is done via the C<-as> B<select function
3882 attribute> supplied as shown in the example above.
3883
3884 B<NOTE:> You need to explicitly quote '+select'/'+as' when defining the attributes.
3885 Not doing so causes Perl to incorrectly interpret them as a bareword with a
3886 unary plus operator before it.
3887
3888 =head2 +select
3889
3890 =over 4
3891
3892 Indicates additional columns to be selected from storage.  Works the same as
3893 L</select> but adds columns to the default selection, instead of specifying
3894 an explicit list.
3895
3896 =back
3897
3898 =head2 +as
3899
3900 =over 4
3901
3902 Indicates additional column names for those added via L</+select>. See L</as>.
3903
3904 =back
3905
3906 =head2 as
3907
3908 =over 4
3909
3910 =item Value: \@inflation_names
3911
3912 =back
3913
3914 Indicates column names for object inflation. That is L</as> indicates the
3915 slot name in which the column value will be stored within the
3916 L<Row|DBIx::Class::Row> object. The value will then be accessible via this
3917 identifier by the C<get_column> method (or via the object accessor B<if one
3918 with the same name already exists>) as shown below. The L</as> attribute has
3919 B<nothing to do> with the SQL-side C<AS>. See L</select> for details.
3920
3921   $rs = $schema->resultset('Employee')->search(undef, {
3922     select => [
3923       'name',
3924       { count => 'employeeid' },
3925       { max => { length => 'name' }, -as => 'longest_name' }
3926     ],
3927     as => [qw/
3928       name
3929       employee_count
3930       max_name_length
3931     /],
3932   });
3933
3934 If the object against which the search is performed already has an accessor
3935 matching a column name specified in C<as>, the value can be retrieved using
3936 the accessor as normal:
3937
3938   my $name = $employee->name();
3939
3940 If on the other hand an accessor does not exist in the object, you need to
3941 use C<get_column> instead:
3942
3943   my $employee_count = $employee->get_column('employee_count');
3944
3945 You can create your own accessors if required - see
3946 L<DBIx::Class::Manual::Cookbook> for details.
3947
3948 =head2 join
3949
3950 =over 4
3951
3952 =item Value: ($rel_name | \@rel_names | \%rel_names)
3953
3954 =back
3955
3956 Contains a list of relationships that should be joined for this query.  For
3957 example:
3958
3959   # Get CDs by Nine Inch Nails
3960   my $rs = $schema->resultset('CD')->search(
3961     { 'artist.name' => 'Nine Inch Nails' },
3962     { join => 'artist' }
3963   );
3964
3965 Can also contain a hash reference to refer to the other relation's relations.
3966 For example:
3967
3968   package MyApp::Schema::Track;
3969   use base qw/DBIx::Class/;
3970   __PACKAGE__->table('track');
3971   __PACKAGE__->add_columns(qw/trackid cd position title/);
3972   __PACKAGE__->set_primary_key('trackid');
3973   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
3974   1;
3975
3976   # In your application
3977   my $rs = $schema->resultset('Artist')->search(
3978     { 'track.title' => 'Teardrop' },
3979     {
3980       join     => { cd => 'track' },
3981       order_by => 'artist.name',
3982     }
3983   );
3984
3985 You need to use the relationship (not the table) name in  conditions,
3986 because they are aliased as such. The current table is aliased as "me", so
3987 you need to use me.column_name in order to avoid ambiguity. For example:
3988
3989   # Get CDs from 1984 with a 'Foo' track
3990   my $rs = $schema->resultset('CD')->search(
3991     {
3992       'me.year' => 1984,
3993       'tracks.name' => 'Foo'
3994     },
3995     { join => 'tracks' }
3996   );
3997
3998 If the same join is supplied twice, it will be aliased to <rel>_2 (and
3999 similarly for a third time). For e.g.
4000
4001   my $rs = $schema->resultset('Artist')->search({
4002     'cds.title'   => 'Down to Earth',
4003     'cds_2.title' => 'Popular',
4004   }, {
4005     join => [ qw/cds cds/ ],
4006   });
4007
4008 will return a set of all artists that have both a cd with title 'Down
4009 to Earth' and a cd with title 'Popular'.
4010
4011 If you want to fetch related objects from other tables as well, see C<prefetch>
4012 below.
4013
4014 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
4015
4016 =head2 prefetch
4017
4018 =over 4
4019
4020 =item Value: ($rel_name | \@rel_names | \%rel_names)
4021
4022 =back
4023
4024 Contains one or more relationships that should be fetched along with
4025 the main query (when they are accessed afterwards the data will
4026 already be available, without extra queries to the database).  This is
4027 useful for when you know you will need the related objects, because it
4028 saves at least one query:
4029
4030   my $rs = $schema->resultset('Tag')->search(
4031     undef,
4032     {
4033       prefetch => {
4034         cd => 'artist'
4035       }
4036     }
4037   );
4038
4039 The initial search results in SQL like the following:
4040
4041   SELECT tag.*, cd.*, artist.* FROM tag
4042   JOIN cd ON tag.cd = cd.cdid
4043   JOIN artist ON cd.artist = artist.artistid
4044
4045 L<DBIx::Class> has no need to go back to the database when we access the
4046 C<cd> or C<artist> relationships, which saves us two SQL statements in this
4047 case.
4048
4049 Simple prefetches will be joined automatically, so there is no need
4050 for a C<join> attribute in the above search.
4051
4052 L</prefetch> can be used with the any of the relationship types and
4053 multiple prefetches can be specified together. Below is a more complex
4054 example that prefetches a CD's artist, its liner notes (if present),
4055 the cover image, the tracks on that cd, and the guests on those
4056 tracks.
4057
4058  # Assuming:
4059  My::Schema::CD->belongs_to( artist      => 'My::Schema::Artist'     );
4060  My::Schema::CD->might_have( liner_note  => 'My::Schema::LinerNotes' );
4061  My::Schema::CD->has_one(    cover_image => 'My::Schema::Artwork'    );
4062  My::Schema::CD->has_many(   tracks      => 'My::Schema::Track'      );
4063
4064  My::Schema::Artist->belongs_to( record_label => 'My::Schema::RecordLabel' );
4065
4066  My::Schema::Track->has_many( guests => 'My::Schema::Guest' );
4067
4068
4069  my $rs = $schema->resultset('CD')->search(
4070    undef,
4071    {
4072      prefetch => [
4073        { artist => 'record_label'},  # belongs_to => belongs_to
4074        'liner_note',                 # might_have
4075        'cover_image',                # has_one
4076        { tracks => 'guests' },       # has_many => has_many
4077      ]
4078    }
4079  );
4080
4081 This will produce SQL like the following:
4082
4083  SELECT cd.*, artist.*, record_label.*, liner_note.*, cover_image.*,
4084         tracks.*, guests.*
4085    FROM cd me
4086    JOIN artist artist
4087      ON artist.artistid = me.artistid
4088    JOIN record_label record_label
4089      ON record_label.labelid = artist.labelid
4090    LEFT JOIN track tracks
4091      ON tracks.cdid = me.cdid
4092    LEFT JOIN guest guests
4093      ON guests.trackid = track.trackid
4094    LEFT JOIN liner_notes liner_note
4095      ON liner_note.cdid = me.cdid
4096    JOIN cd_artwork cover_image
4097      ON cover_image.cdid = me.cdid
4098  ORDER BY tracks.cd
4099
4100 Now the C<artist>, C<record_label>, C<liner_note>, C<cover_image>,
4101 C<tracks>, and C<guests> of the CD will all be available through the
4102 relationship accessors without the need for additional queries to the
4103 database.
4104
4105 However, there is one caveat to be observed: it can be dangerous to
4106 prefetch more than one L<has_many|DBIx::Class::Relationship/has_many>
4107 relationship on a given level. e.g.:
4108
4109  my $rs = $schema->resultset('CD')->search(
4110    undef,
4111    {
4112      prefetch => [
4113        'tracks',                         # has_many
4114        { cd_to_producer => 'producer' }, # has_many => belongs_to (i.e. m2m)
4115      ]
4116    }
4117  );
4118
4119 In fact, C<DBIx::Class> will emit the following warning:
4120
4121  Prefetching multiple has_many rels tracks and cd_to_producer at top
4122  level will explode the number of row objects retrievable via ->next
4123  or ->all. Use at your own risk.
4124
4125 The collapser currently can't identify duplicate tuples for multiple
4126 L<has_many|DBIx::Class::Relationship/has_many> relationships and as a
4127 result the second L<has_many|DBIx::Class::Relationship/has_many>
4128 relation could contain redundant objects.
4129
4130 =head3 Using L</prefetch> with L</join>
4131
4132 L</prefetch> implies a L</join> with the equivalent argument, and is
4133 properly merged with any existing L</join> specification. So the
4134 following:
4135
4136   my $rs = $schema->resultset('CD')->search(
4137    {'record_label.name' => 'Music Product Ltd.'},
4138    {
4139      join     => {artist => 'record_label'},
4140      prefetch => 'artist',
4141    }
4142  );
4143
4144 ... will work, searching on the record label's name, but only
4145 prefetching the C<artist>.
4146
4147 =head3 Using L</prefetch> with L</select> / L</+select> / L</as> / L</+as>
4148
4149 L</prefetch> implies a L</+select>/L</+as> with the fields of the
4150 prefetched relations.  So given:
4151
4152   my $rs = $schema->resultset('CD')->search(
4153    undef,
4154    {
4155      select   => ['cd.title'],
4156      as       => ['cd_title'],
4157      prefetch => 'artist',
4158    }
4159  );
4160
4161 The L</select> becomes: C<'cd.title', 'artist.*'> and the L</as>
4162 becomes: C<'cd_title', 'artist.*'>.
4163
4164 =head3 CAVEATS
4165
4166 Prefetch does a lot of deep magic. As such, it may not behave exactly
4167 as you might expect.
4168
4169 =over 4
4170
4171 =item *
4172
4173 Prefetch uses the L</cache> to populate the prefetched relationships. This
4174 may or may not be what you want.
4175
4176 =item *
4177
4178 If you specify a condition on a prefetched relationship, ONLY those
4179 rows that match the prefetched condition will be fetched into that relationship.
4180 This means that adding prefetch to a search() B<may alter> what is returned by
4181 traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
4182
4183   my $artist_rs = $schema->resultset('Artist')->search({
4184       'cds.year' => 2008,
4185   }, {
4186       join => 'cds',
4187   });
4188
4189   my $count = $artist_rs->first->cds->count;
4190
4191   my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
4192
4193   my $prefetch_count = $artist_rs_prefetch->first->cds->count;
4194
4195   cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
4196
4197 that cmp_ok() may or may not pass depending on the datasets involved. This
4198 behavior may or may not survive the 0.09 transition.
4199
4200 =back
4201
4202 =head2 page
4203
4204 =over 4
4205
4206 =item Value: $page
4207
4208 =back
4209
4210 Makes the resultset paged and specifies the page to retrieve. Effectively
4211 identical to creating a non-pages resultset and then calling ->page($page)
4212 on it.
4213
4214 If L</rows> attribute is not specified it defaults to 10 rows per page.
4215
4216 When you have a paged resultset, L</count> will only return the number
4217 of rows in the page. To get the total, use the L</pager> and call
4218 C<total_entries> on it.
4219
4220 =head2 rows
4221
4222 =over 4
4223
4224 =item Value: $rows
4225
4226 =back
4227
4228 Specifies the maximum number of rows for direct retrieval or the number of
4229 rows per page if the page attribute or method is used.
4230
4231 =head2 offset
4232
4233 =over 4
4234
4235 =item Value: $offset
4236
4237 =back
4238
4239 Specifies the (zero-based) row number for the  first row to be returned, or the
4240 of the first row of the first page if paging is used.
4241
4242 =head2 software_limit
4243
4244 =over 4
4245
4246 =item Value: (0 | 1)
4247
4248 =back
4249
4250 When combined with L</rows> and/or L</offset> the generated SQL will not
4251 include any limit dialect stanzas. Instead the entire result will be selected
4252 as if no limits were specified, and DBIC will perform the limit locally, by
4253 artificially advancing and finishing the resulting L</cursor>.
4254
4255 This is the recommended way of performing resultset limiting when no sane RDBMS
4256 implementation is available (e.g.
4257 L<Sybase ASE|DBIx::Class::Storage::DBI::Sybase::ASE> using the
4258 L<Generic Sub Query|DBIx::Class::SQLMaker::LimitDialects/GenericSubQ> hack)
4259
4260 =head2 group_by
4261
4262 =over 4
4263
4264 =item Value: \@columns
4265
4266 =back
4267
4268 A arrayref of columns to group by. Can include columns of joined tables.
4269
4270   group_by => [qw/ column1 column2 ... /]
4271
4272 =head2 having
4273
4274 =over 4
4275
4276 =item Value: $condition
4277
4278 =back
4279
4280 HAVING is a select statement attribute that is applied between GROUP BY and
4281 ORDER BY. It is applied to the after the grouping calculations have been
4282 done.
4283
4284   having => { 'count_employee' => { '>=', 100 } }
4285
4286 or with an in-place function in which case literal SQL is required:
4287
4288   having => \[ 'count(employee) >= ?', [ count => 100 ] ]
4289
4290 =head2 distinct
4291
4292 =over 4
4293
4294 =item Value: (0 | 1)
4295
4296 =back
4297
4298 Set to 1 to group by all columns. If the resultset already has a group_by
4299 attribute, this setting is ignored and an appropriate warning is issued.
4300
4301 =head2 where
4302
4303 =over 4
4304
4305 Adds to the WHERE clause.
4306
4307   # only return rows WHERE deleted IS NULL for all searches
4308   __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
4309
4310 Can be overridden by passing C<< { where => undef } >> as an attribute
4311 to a resultset.
4312
4313 For more complicated where clauses see L<SQL::Abstract/WHERE CLAUSES>.
4314
4315 =back
4316
4317 =head2 cache
4318
4319 Set to 1 to cache search results. This prevents extra SQL queries if you
4320 revisit rows in your ResultSet:
4321
4322   my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
4323
4324   while( my $artist = $resultset->next ) {
4325     ... do stuff ...
4326   }
4327
4328   $rs->first; # without cache, this would issue a query
4329
4330 By default, searches are not cached.
4331
4332 For more examples of using these attributes, see
4333 L<DBIx::Class::Manual::Cookbook>.
4334
4335 =head2 for
4336
4337 =over 4
4338
4339 =item Value: ( 'update' | 'shared' )
4340
4341 =back
4342
4343 Set to 'update' for a SELECT ... FOR UPDATE or 'shared' for a SELECT
4344 ... FOR SHARED.
4345
4346 =cut
4347
4348 1;