lib/DBIx/Class/ResultSet.pm

   1 package DBIx::Class::ResultSet;
   2
   3 use strict;
   4 use warnings;
   5 use overload
   6         '0+'     => 'count',
   7         'bool'   => sub { 1; },
   8         fallback => 1;
   9 use Data::Page;
  10 use Storable;
  11
  12 use base qw/DBIx::Class/;
  13 __PACKAGE__->load_components(qw/AccessorGroup/);
  14 __PACKAGE__->mk_group_accessors('simple' => 'result_source');
  15
  16 =head1 NAME
  17
  18 DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
  19
  20 =head1 SYNOPSIS
  21
  22   my $rs   = $schema->resultset('User')->search(registered => 1);
  23   my @rows = $schema->resultset('Foo')->search(bar => 'baz');
  24
  25 =head1 DESCRIPTION
  26
  27 The resultset is also known as an iterator. It is responsible for handling
  28 queries that may return an arbitrary number of rows, e.g. via L</search>
  29 or a C<has_many> relationship.
  30
  31 In the examples below, the following table classes are used:
  32
  33   package MyApp::Schema::Artist;
  34   use base qw/DBIx::Class/;
  35   __PACKAGE__->table('artist');
  36   __PACKAGE__->add_columns(qw/artistid name/);
  37   __PACKAGE__->set_primary_key('artistid');
  38   __PACKAGE__->has_many(cds => 'MyApp::Schema::CD');
  39   1;
  40
  41   package MyApp::Schema::CD;
  42   use base qw/DBIx::Class/;
  43   __PACKAGE__->table('artist');
  44   __PACKAGE__->add_columns(qw/cdid artist title year/);
  45   __PACKAGE__->set_primary_key('cdid');
  46   __PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
  47   1;
  48
  49 =head1 METHODS
  50
  51 =head2 new
  52
  53 =head3 Arguments: ($source, \%$attrs)
  54
  55 The resultset constructor. Takes a source object (usually a
  56 L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see L</ATRRIBUTES>
  57 below).  Does not perform any queries -- these are executed as needed by the
  58 other methods.
  59
  60 Generally you won't need to construct a resultset manually.  You'll
  61 automatically get one from e.g. a L</search> called in scalar context:
  62
  63   my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
  64
  65 =cut
  66
  67 sub new {
  68   my $class = shift;
  69   return $class->new_result(@_) if ref $class;
  70   my ($source, $attrs) = @_;
  71   #use Data::Dumper; warn Dumper($attrs);
  72   $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
  73   my %seen;
  74   my $alias = ($attrs->{alias} ||= 'me');
  75   if ($attrs->{cols} || !$attrs->{select}) {
  76     delete $attrs->{as} if $attrs->{cols};
  77     my @cols = ($attrs->{cols}
  78                  ? @{delete $attrs->{cols}}
  79                  : $source->columns);
  80     $attrs->{select} = [ map { m/\./ ? $_ : "${alias}.$_" } @cols ];
  81   }
  82   $attrs->{as} ||= [ map { m/^$alias\.(.*)$/ ? $1 : $_ } @{$attrs->{select}} ];
  83   if (my $include = delete $attrs->{include_columns}) {
  84     push(@{$attrs->{select}}, @$include);
  85     push(@{$attrs->{as}}, map { m/([^\.]+)$/; $1; } @$include);
  86   }
  87   #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
  88   $attrs->{from} ||= [ { $alias => $source->from } ];
  89   $attrs->{seen_join} ||= {};
  90   if (my $join = delete $attrs->{join}) {
  91     foreach my $j (ref $join eq 'ARRAY'
  92               ? (@{$join}) : ($join)) {
  93       if (ref $j eq 'HASH') {
  94         $seen{$_} = 1 foreach keys %$j;
  95       } else {
  96         $seen{$j} = 1;
  97       }
  98     }
  99     push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join}));
 100   }
 101   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
 102
 103   if (my $prefetch = delete $attrs->{prefetch}) {
 104     foreach my $p (ref $prefetch eq 'ARRAY'
 105               ? (@{$prefetch}) : ($prefetch)) {
 106       if( ref $p eq 'HASH' ) {
 107         foreach my $key (keys %$p) {
 108           push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
 109             unless $seen{$key};
 110         }
 111       }
 112       else {
 113         push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
 114             unless $seen{$p};
 115       }
 116       my @prefetch = $source->resolve_prefetch($p, $attrs->{alias});
 117       #die Dumper \@cols;
 118       push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
 119       push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
 120     }
 121   }
 122
 123   if ($attrs->{page}) {
 124     $attrs->{rows} ||= 10;
 125     $attrs->{offset} ||= 0;
 126     $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
 127   }
 128   my $new = {
 129     result_source => $source,
 130     cond => $attrs->{where},
 131     from => $attrs->{from},
 132     count => undef,
 133     page => delete $attrs->{page},
 134     pager => undef,
 135     attrs => $attrs };
 136   bless ($new, $class);
 137   return $new;
 138 }
 139
 140 =head2 search
 141
 142   my @obj    = $rs->search({ foo => 3 }); # "... WHERE foo = 3"
 143   my $new_rs = $rs->search({ foo => 3 });
 144
 145 If you need to pass in additional attributes but no additional condition,
 146 call it as C<search({}, \%attrs);>.
 147
 148   # "SELECT foo, bar FROM $class_table"
 149   my @all = $class->search({}, { cols => [qw/foo bar/] });
 150
 151 =cut
 152
 153 sub search {
 154   my $self = shift;
 155
 156   #use Data::Dumper;warn Dumper(@_);
 157   my $rs;
 158   if( @_ ) {
 159
 160     my $attrs = { %{$self->{attrs}} };
 161     if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 162      $attrs = { %$attrs, %{ pop(@_) } };
 163     }
 164
 165     my $where = (@_ ? ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_}) : undef());
 166     if (defined $where) {
 167       $where = (defined $attrs->{where}
 168                 ? { '-and' =>
 169                     [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
 170                         $where, $attrs->{where} ] }
 171                 : $where);
 172       $attrs->{where} = $where;
 173     }
 174
 175     $rs = (ref $self)->new($self->result_source, $attrs);
 176   }
 177   else {
 178     $rs = $self;
 179     $rs->reset();
 180   }
 181   return (wantarray ? $rs->all : $rs);
 182 }
 183
 184 =head2 search_literal
 185
 186   my @obj    = $rs->search_literal($literal_where_cond, @bind);
 187   my $new_rs = $rs->search_literal($literal_where_cond, @bind);
 188
 189 Pass a literal chunk of SQL to be added to the conditional part of the
 190 resultset.
 191
 192 =cut
 193
 194 sub search_literal {
 195   my ($self, $cond, @vals) = @_;
 196   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
 197   $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ];
 198   return $self->search(\$cond, $attrs);
 199 }
 200
 201 =head2 find
 202
 203 =head3 Arguments: (@colvalues) | (\%cols, \%attrs?)
 204
 205 Finds a row based on its primary key or unique constraint. For example:
 206
 207   my $cd = $schema->resultset('CD')->find(5);
 208
 209 Also takes an optional C<key> attribute, to search by a specific key or unique
 210 constraint. For example:
 211
 212   my $cd = $schema->resultset('CD')->find_or_create(
 213     {
 214       artist => 'Massive Attack',
 215       title  => 'Mezzanine',
 216     },
 217     { key => 'artist_title' }
 218   );
 219
 220 See also L</find_or_create> and L</update_or_create>.
 221
 222 =cut
 223
 224 sub find {
 225   my ($self, @vals) = @_;
 226   my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
 227
 228   my @cols = $self->result_source->primary_columns;
 229   if (exists $attrs->{key}) {
 230     my %uniq = $self->result_source->unique_constraints;
 231     $self->( "Unknown key " . $attrs->{key} . " on " . $self->name )
 232       unless exists $uniq{$attrs->{key}};
 233     @cols = @{ $uniq{$attrs->{key}} };
 234   }
 235   #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
 236   $self->throw_exception( "Can't find unless a primary key or unique constraint is defined" )
 237     unless @cols;
 238
 239   my $query;
 240   if (ref $vals[0] eq 'HASH') {
 241     $query = { %{$vals[0]} };
 242   } elsif (@cols == @vals) {
 243     $query = {};
 244     @{$query}{@cols} = @vals;
 245   } else {
 246     $query = {@vals};
 247   }
 248   foreach (keys %$query) {
 249     next if m/\./;
 250     $query->{$self->{attrs}{alias}.'.'.$_} = delete $query->{$_};
 251   }
 252   #warn Dumper($query);
 253   return (keys %$attrs
 254            ? $self->search($query,$attrs)->single
 255            : $self->single($query));
 256 }
 257
 258 =head2 search_related
 259
 260   $rs->search_related('relname', $cond?, $attrs?);
 261
 262 Search the specified relationship. Optionally specify a condition for matching
 263 records.
 264
 265 =cut
 266
 267 sub search_related {
 268   return shift->related_resultset(shift)->search(@_);
 269 }
 270
 271 =head2 cursor
 272
 273 Returns a storage-driven cursor to the given resultset.
 274
 275 =cut
 276
 277 sub cursor {
 278   my ($self) = @_;
 279   my ($attrs) = $self->{attrs};
 280   $attrs = { %$attrs };
 281   return $self->{cursor}
 282     ||= $self->result_source->storage->select($self->{from}, $attrs->{select},
 283           $attrs->{where},$attrs);
 284 }
 285
 286 =head2 single
 287
 288 Inflates the first result without creating a cursor
 289
 290 =cut
 291
 292 sub single {
 293   my ($self, $extra) = @_;
 294   my ($attrs) = $self->{attrs};
 295   $attrs = { %$attrs };
 296   if ($extra) {
 297     if (defined $attrs->{where}) {
 298       $attrs->{where} = {
 299         '-and'
 300           => [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
 301                delete $attrs->{where}, $extra ]
 302       };
 303     } else {
 304       $attrs->{where} = $extra;
 305     }
 306   }
 307   my @data = $self->result_source->storage->select_single(
 308           $self->{from}, $attrs->{select},
 309           $attrs->{where},$attrs);
 310   return (@data ? $self->_construct_object(@data) : ());
 311 }
 312
 313
 314 =head2 search_like
 315
 316 Perform a search, but use C<LIKE> instead of equality as the condition. Note
 317 that this is simply a convenience method; you most likely want to use
 318 L</search> with specific operators.
 319
 320 For more information, see L<DBIx::Class::Manual::Cookbook>.
 321
 322 =cut
 323
 324 sub search_like {
 325   my $class    = shift;
 326   my $attrs = { };
 327   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 328     $attrs = pop(@_);
 329   }
 330   my $query    = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
 331   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
 332   return $class->search($query, { %$attrs });
 333 }
 334
 335 =head2 slice
 336
 337 =head3 Arguments: ($first, $last)
 338
 339 Returns a subset of elements from the resultset.
 340
 341 =cut
 342
 343 sub slice {
 344   my ($self, $min, $max) = @_;
 345   my $attrs = { %{ $self->{attrs} || {} } };
 346   $attrs->{offset} ||= 0;
 347   $attrs->{offset} += $min;
 348   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
 349   my $slice = (ref $self)->new($self->result_source, $attrs);
 350   return (wantarray ? $slice->all : $slice);
 351 }
 352
 353 =head2 next
 354
 355 Returns the next element in the resultset (C<undef> is there is none).
 356
 357 Can be used to efficiently iterate over records in the resultset:
 358
 359   my $rs = $schema->resultset('CD')->search({});
 360   while (my $cd = $rs->next) {
 361     print $cd->title;
 362   }
 363
 364 =cut
 365
 366 sub next {
 367   my ($self) = @_;
 368   my $cache = $self->get_cache;
 369   if( @$cache ) {
 370     $self->{all_cache_position} ||= 0;
 371     my $obj = $cache->[$self->{all_cache_position}];
 372     $self->{all_cache_position}++;
 373     return $obj;
 374   }
 375   my @row = $self->cursor->next;
 376 #  warn Dumper(\@row); use Data::Dumper;
 377   return unless (@row);
 378   return $self->_construct_object(@row);
 379 }
 380
 381 sub _construct_object {
 382   my ($self, @row) = @_;
 383   my @row_orig = @row; # copy @row for key comparison later, because @row will change
 384   my @as = @{ $self->{attrs}{as} };
 385 #use Data::Dumper; warn Dumper \@as;
 386   #warn "@cols -> @row";
 387   my $info = [ {}, {} ];
 388   foreach my $as (@as) {
 389     my $rs = $self;
 390     my $target = $info;
 391     my @parts = split(/\./, $as);
 392     my $col = pop(@parts);
 393     foreach my $p (@parts) {
 394       $target = $target->[1]->{$p} ||= [];
 395
 396       $rs = $rs->related_resultset($p) if $rs->{attrs}->{cache};
 397     }
 398
 399     $target->[0]->{$col} = shift @row
 400       if ref($target->[0]) ne 'ARRAY'; # arrayref is pre-inflated objects, do not overwrite
 401   }
 402   #use Data::Dumper; warn Dumper(\@as, $info);
 403   my $new = $self->result_source->result_class->inflate_result(
 404               $self->result_source, @$info);
 405   $new = $self->{attrs}{record_filter}->($new)
 406     if exists $self->{attrs}{record_filter};
 407
 408   if( $self->{attrs}->{cache} ) {
 409     while( my( $rel, $rs ) = each( %{$self->{related_resultsets}} ) ) {
 410       $rs->all;
 411       #warn "$rel:", @{$rs->get_cache};
 412     }
 413     $self->build_rr( $self, $new );
 414   }
 415
 416   return $new;
 417 }
 418
 419 sub build_rr {
 420   # build related resultsets for supplied object
 421   my ( $self, $context, $obj ) = @_;
 422
 423   my $re = qr/^\w+\./;
 424   while( my ($rel, $rs) = each( %{$context->{related_resultsets}} ) ) {
 425     #warn "context:", $context->result_source->name, ", rel:$rel, rs:", $rs->result_source->name;
 426     my @objs = ();
 427     my $map = {};
 428     my $cond = $context->result_source->relationship_info($rel)->{cond};
 429     keys %$cond;
 430     while( my( $rel_key, $pk ) = each(%$cond) ) {
 431       $rel_key =~ s/$re//;
 432       $pk =~ s/$re//;
 433       $map->{$rel_key} = $pk;
 434     }
 435
 436     $rs->reset();
 437     while( my $rel_obj = $rs->next ) {
 438       while( my( $rel_key, $pk ) = each(%$map) ) {
 439         if( $rel_obj->get_column($rel_key) eq $obj->get_column($pk) ) {
 440           push @objs, $rel_obj;
 441         }
 442       }
 443     }
 444
 445     my $rel_rs = $obj->related_resultset($rel);
 446     $rel_rs->{attrs}->{cache} = 1;
 447     $rel_rs->set_cache( \@objs );
 448
 449     while( my $rel_obj = $rel_rs->next ) {
 450       $self->build_rr( $rs, $rel_obj );
 451     }
 452
 453   }
 454
 455 }
 456
 457 =head2 result_source
 458
 459 Returns a reference to the result source for this recordset.
 460
 461 =cut
 462
 463
 464 =head2 count
 465
 466 Performs an SQL C<COUNT> with the same query as the resultset was built
 467 with to find the number of elements. If passed arguments, does a search
 468 on the resultset and counts the results of that.
 469
 470 Note: When using C<count> with C<group_by>, L<DBIX::Class> emulates C<GROUP BY>
 471 using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
 472 not support C<DISTINCT> with multiple columns. If you are using such a
 473 database, you should only use columns from the main table in your C<group_by>
 474 clause.
 475
 476 =cut
 477
 478 sub count {
 479   my $self = shift;
 480   return $self->search(@_)->count if @_ && defined $_[0];
 481   unless (defined $self->{count}) {
 482     return scalar @{ $self->get_cache }
 483       if @{ $self->get_cache };
 484     my $group_by;
 485     my $select = { 'count' => '*' };
 486     if( $group_by = delete $self->{attrs}{group_by} ) {
 487       my @distinct = (ref $group_by ?  @$group_by : ($group_by));
 488       # todo: try CONCAT for multi-column pk
 489       my @pk = $self->result_source->primary_columns;
 490       if( scalar(@pk) == 1 ) {
 491         my $pk = shift(@pk);
 492         my $alias = $self->{attrs}{alias};
 493         my $re = qr/^($alias\.)?$pk$/;
 494         foreach my $column ( @distinct) {
 495           if( $column =~ $re ) {
 496             @distinct = ( $column );
 497             last;
 498           }
 499         }
 500       }
 501
 502       $select = { count => { 'distinct' => \@distinct } };
 503       #use Data::Dumper; die Dumper $select;
 504     }
 505
 506     my $attrs = { %{ $self->{attrs} },
 507                   select => $select,
 508                   as => [ 'count' ] };
 509     # offset, order by and page are not needed to count. record_filter is cdbi
 510     delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
 511
 512     ($self->{count}) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
 513     $self->{attrs}{group_by} = $group_by;
 514   }
 515   return 0 unless $self->{count};
 516   my $count = $self->{count};
 517   $count -= $self->{attrs}{offset} if $self->{attrs}{offset};
 518   $count = $self->{attrs}{rows} if
 519     ($self->{attrs}{rows} && $self->{attrs}{rows} < $count);
 520   return $count;
 521 }
 522
 523 =head2 count_literal
 524
 525 Calls L</search_literal> with the passed arguments, then L</count>.
 526
 527 =cut
 528
 529 sub count_literal { shift->search_literal(@_)->count; }
 530
 531 =head2 all
 532
 533 Returns all elements in the resultset. Called implictly if the resultset
 534 is returned in list context.
 535
 536 =cut
 537
 538 sub all {
 539   my ($self) = @_;
 540   return @{ $self->get_cache }
 541     if @{ $self->get_cache };
 542   if( $self->{attrs}->{cache} ) {
 543     my @obj = map { $self->_construct_object(@$_); }
 544             $self->cursor->all;
 545     $self->set_cache( \@obj );
 546     return @{ $self->get_cache };
 547   }
 548   return map { $self->_construct_object(@$_); }
 549            $self->cursor->all;
 550 }
 551
 552 =head2 reset
 553
 554 Resets the resultset's cursor, so you can iterate through the elements again.
 555
 556 =cut
 557
 558 sub reset {
 559   my ($self) = @_;
 560   $self->{all_cache_position} = 0;
 561   $self->cursor->reset;
 562   return $self;
 563 }
 564
 565 =head2 first
 566
 567 Resets the resultset and returns the first element.
 568
 569 =cut
 570
 571 sub first {
 572   return $_[0]->reset->next;
 573 }
 574
 575 =head2 update
 576
 577 =head3 Arguments: (\%values)
 578
 579 Sets the specified columns in the resultset to the supplied values.
 580
 581 =cut
 582
 583 sub update {
 584   my ($self, $values) = @_;
 585   $self->throw_exception("Values for update must be a hash") unless ref $values eq 'HASH';
 586   return $self->result_source->storage->update(
 587            $self->result_source->from, $values, $self->{cond});
 588 }
 589
 590 =head2 update_all
 591
 592 =head3 Arguments: (\%values)
 593
 594 Fetches all objects and updates them one at a time.  Note that C<update_all>
 595 will run cascade triggers while L</update> will not.
 596
 597 =cut
 598
 599 sub update_all {
 600   my ($self, $values) = @_;
 601   $self->throw_exception("Values for update must be a hash") unless ref $values eq 'HASH';
 602   foreach my $obj ($self->all) {
 603     $obj->set_columns($values)->update;
 604   }
 605   return 1;
 606 }
 607
 608 =head2 delete
 609
 610 Deletes the contents of the resultset from its result source.
 611
 612 =cut
 613
 614 sub delete {
 615   my ($self) = @_;
 616   my $del = {};
 617   $self->throw_exception("Can't delete on resultset with condition unless hash or array")
 618     unless (ref($self->{cond}) eq 'HASH' || ref($self->{cond}) eq 'ARRAY');
 619   if (ref $self->{cond} eq 'ARRAY') {
 620     $del = [ map { my %hash;
 621       foreach my $key (keys %{$_}) {
 622         $key =~ /([^\.]+)$/;
 623         $hash{$1} = $_->{$key};
 624       }; \%hash; } @{$self->{cond}} ];
 625   } elsif ((keys %{$self->{cond}})[0] eq '-and') {
 626     $del->{-and} = [ map { my %hash;
 627       foreach my $key (keys %{$_}) {
 628         $key =~ /([^\.]+)$/;
 629         $hash{$1} = $_->{$key};
 630       }; \%hash; } @{$self->{cond}{-and}} ];
 631   } else {
 632     foreach my $key (keys %{$self->{cond}}) {
 633       $key =~ /([^\.]+)$/;
 634       $del->{$1} = $self->{cond}{$key};
 635     }
 636   }
 637   $self->result_source->storage->delete($self->result_source->from, $del);
 638   return 1;
 639 }
 640
 641 =head2 delete_all
 642
 643 Fetches all objects and deletes them one at a time.  Note that C<delete_all>
 644 will run cascade triggers while L</delete> will not.
 645
 646 =cut
 647
 648 sub delete_all {
 649   my ($self) = @_;
 650   $_->delete for $self->all;
 651   return 1;
 652 }
 653
 654 =head2 pager
 655
 656 Returns a L<Data::Page> object for the current resultset. Only makes
 657 sense for queries with a C<page> attribute.
 658
 659 =cut
 660
 661 sub pager {
 662   my ($self) = @_;
 663   my $attrs = $self->{attrs};
 664   $self->throw_exception("Can't create pager for non-paged rs") unless $self->{page};
 665   $attrs->{rows} ||= 10;
 666   $self->count;
 667   return $self->{pager} ||= Data::Page->new(
 668     $self->{count}, $attrs->{rows}, $self->{page});
 669 }
 670
 671 =head2 page
 672
 673 =head3 Arguments: ($page_num)
 674
 675 Returns a new resultset for the specified page.
 676
 677 =cut
 678
 679 sub page {
 680   my ($self, $page) = @_;
 681   my $attrs = { %{$self->{attrs}} };
 682   $attrs->{page} = $page;
 683   return (ref $self)->new($self->result_source, $attrs);
 684 }
 685
 686 =head2 new_result
 687
 688 =head3 Arguments: (\%vals)
 689
 690 Creates a result in the resultset's result class.
 691
 692 =cut
 693
 694 sub new_result {
 695   my ($self, $values) = @_;
 696   $self->throw_exception( "new_result needs a hash" )
 697     unless (ref $values eq 'HASH');
 698   $self->throw_exception( "Can't abstract implicit construct, condition not a hash" )
 699     if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
 700   my %new = %$values;
 701   my $alias = $self->{attrs}{alias};
 702   foreach my $key (keys %{$self->{cond}||{}}) {
 703     $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:$alias\.)?([^\.]+)$/);
 704   }
 705   my $obj = $self->result_source->result_class->new(\%new);
 706   $obj->result_source($self->result_source) if $obj->can('result_source');
 707   $obj;
 708 }
 709
 710 =head2 create
 711
 712 =head3 Arguments: (\%vals)
 713
 714 Inserts a record into the resultset and returns the object.
 715
 716 Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
 717
 718 =cut
 719
 720 sub create {
 721   my ($self, $attrs) = @_;
 722   $self->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
 723   return $self->new_result($attrs)->insert;
 724 }
 725
 726 =head2 find_or_create
 727
 728 =head3 Arguments: (\%vals, \%attrs?)
 729
 730   $class->find_or_create({ key => $val, ... });
 731
 732 Searches for a record matching the search condition; if it doesn't find one,
 733 creates one and returns that instead.
 734
 735   my $cd = $schema->resultset('CD')->find_or_create({
 736     cdid   => 5,
 737     artist => 'Massive Attack',
 738     title  => 'Mezzanine',
 739     year   => 2005,
 740   });
 741
 742 Also takes an optional C<key> attribute, to search by a specific key or unique
 743 constraint. For example:
 744
 745   my $cd = $schema->resultset('CD')->find_or_create(
 746     {
 747       artist => 'Massive Attack',
 748       title  => 'Mezzanine',
 749     },
 750     { key => 'artist_title' }
 751   );
 752
 753 See also L</find> and L</update_or_create>.
 754
 755 =cut
 756
 757 sub find_or_create {
 758   my $self     = shift;
 759   my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 760   my $hash     = ref $_[0] eq "HASH" ? shift : {@_};
 761   my $exists   = $self->find($hash, $attrs);
 762   return defined($exists) ? $exists : $self->create($hash);
 763 }
 764
 765 =head2 update_or_create
 766
 767   $class->update_or_create({ key => $val, ... });
 768
 769 First, search for an existing row matching one of the unique constraints
 770 (including the primary key) on the source of this resultset.  If a row is
 771 found, update it with the other given column values.  Otherwise, create a new
 772 row.
 773
 774 Takes an optional C<key> attribute to search on a specific unique constraint.
 775 For example:
 776
 777   # In your application
 778   my $cd = $schema->resultset('CD')->update_or_create(
 779     {
 780       artist => 'Massive Attack',
 781       title  => 'Mezzanine',
 782       year   => 1998,
 783     },
 784     { key => 'artist_title' }
 785   );
 786
 787 If no C<key> is specified, it searches on all unique constraints defined on the
 788 source, including the primary key.
 789
 790 If the C<key> is specified as C<primary>, search only on the primary key.
 791
 792 See also L</find> and L</find_or_create>.
 793
 794 =cut
 795
 796 sub update_or_create {
 797   my $self = shift;
 798
 799   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 800   my $hash  = ref $_[0] eq "HASH" ? shift : {@_};
 801
 802   my %unique_constraints = $self->result_source->unique_constraints;
 803   my @constraint_names   = (exists $attrs->{key}
 804                             ? ($attrs->{key})
 805                             : keys %unique_constraints);
 806
 807   my @unique_hashes;
 808   foreach my $name (@constraint_names) {
 809     my @unique_cols = @{ $unique_constraints{$name} };
 810     my %unique_hash =
 811       map  { $_ => $hash->{$_} }
 812       grep { exists $hash->{$_} }
 813       @unique_cols;
 814
 815     push @unique_hashes, \%unique_hash
 816       if (scalar keys %unique_hash == scalar @unique_cols);
 817   }
 818
 819   my $row;
 820   if (@unique_hashes) {
 821     $row = $self->search(\@unique_hashes, { rows => 1 })->first;
 822     if ($row) {
 823       $row->set_columns($hash);
 824       $row->update;
 825     }
 826   }
 827
 828   unless ($row) {
 829     $row = $self->create($hash);
 830   }
 831
 832   return $row;
 833 }
 834
 835 =head2 get_cache
 836
 837 Gets the contents of the cache for the resultset.
 838
 839 =cut
 840
 841 sub get_cache {
 842   my $self = shift;
 843   return $self->{all_cache} || [];
 844 }
 845
 846 =head2 set_cache
 847
 848 Sets the contents of the cache for the resultset. Expects an arrayref of objects of the same class as those produced by the resultset.
 849
 850 =cut
 851
 852 sub set_cache {
 853   my ( $self, $data ) = @_;
 854   $self->throw_exception("set_cache requires an arrayref")
 855     if ref $data ne 'ARRAY';
 856   my $result_class = $self->result_source->result_class;
 857   foreach( @$data ) {
 858     $self->throw_exception("cannot cache object of type '$_', expected '$result_class'")
 859       if ref $_ ne $result_class;
 860   }
 861   $self->{all_cache} = $data;
 862 }
 863
 864 =head2 clear_cache
 865
 866 Clears the cache for the resultset.
 867
 868 =cut
 869
 870 sub clear_cache {
 871   my $self = shift;
 872   $self->set_cache([]);
 873 }
 874
 875 =head2 related_resultset
 876
 877 Returns a related resultset for the supplied relationship name.
 878
 879   $rs = $rs->related_resultset('foo');
 880
 881 =cut
 882
 883 sub related_resultset {
 884   my ( $self, $rel, @rest ) = @_;
 885   $self->{related_resultsets} ||= {};
 886   my $resultsets = $self->{related_resultsets};
 887   if( !exists $resultsets->{$rel} ) {
 888     #warn "fetching related resultset for rel '$rel'";
 889     my $rel_obj = $self->result_source->relationship_info($rel);
 890     $self->throw_exception(
 891       "search_related: result source '" . $self->result_source->name .
 892       "' has no such relationship ${rel}")
 893       unless $rel_obj; #die Dumper $self->{attrs};
 894     my $rs;
 895     if( $self->{attrs}->{cache} ) {
 896       $rs = $self->search(undef);
 897     }
 898     else {
 899       $rs = $self->search(undef, { join => $rel });
 900     }
 901     #use Data::Dumper; die Dumper $rs->{attrs};#$rs = $self->search( undef );
 902     #use Data::Dumper; warn Dumper $self->{attrs}, Dumper $rs->{attrs};
 903     my $alias = (defined $rs->{attrs}{seen_join}{$rel}
 904                   && $rs->{attrs}{seen_join}{$rel} > 1
 905                 ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
 906                 : $rel);
 907     $resultsets->{$rel} =
 908       $self->result_source->schema->resultset($rel_obj->{class}
 909            )->search( undef,
 910              { %{$rs->{attrs}},
 911                alias => $alias,
 912                select => undef(),
 913                as => undef() }
 914            )->search(@rest);
 915   }
 916   return $resultsets->{$rel};
 917 }
 918
 919 =head2 throw_exception
 920
 921 See Schema's throw_exception
 922
 923 =cut
 924
 925 sub throw_exception {
 926   my $self=shift;
 927   $self->result_source->schema->throw_exception(@_);
 928 }
 929
 930 =head1 ATTRIBUTES
 931
 932 The resultset takes various attributes that modify its behavior. Here's an
 933 overview of them:
 934
 935 =head2 order_by
 936
 937 Which column(s) to order the results by. This is currently passed through
 938 directly to SQL, so you can give e.g. C<foo DESC> for a descending order.
 939
 940 =head2 cols
 941
 942 =head3 Arguments: (arrayref)
 943
 944 Shortcut to request a particular set of columns to be retrieved.  Adds
 945 C<me.> onto the start of any column without a C<.> in it and sets C<select>
 946 from that, then auto-populates C<as> from C<select> as normal.
 947
 948 =head2 include_columns
 949
 950 =head3 Arguments: (arrayref)
 951
 952 Shortcut to include additional columns in the returned results - for example
 953
 954   { include_columns => ['foo.name'], join => ['foo'] }
 955
 956 would add a 'name' column to the information passed to object inflation
 957
 958 =head2 select
 959
 960 =head3 Arguments: (arrayref)
 961
 962 Indicates which columns should be selected from the storage. You can use
 963 column names, or in the case of RDBMS back ends, function or stored procedure
 964 names:
 965
 966   $rs = $schema->resultset('Foo')->search(
 967     {},
 968     {
 969       select => [
 970         'column_name',
 971         { count => 'column_to_count' },
 972         { sum => 'column_to_sum' }
 973       ]
 974     }
 975   );
 976
 977 When you use function/stored procedure names and do not supply an C<as>
 978 attribute, the column names returned are storage-dependent. E.g. MySQL would
 979 return a column named C<count(column_to_count)> in the above example.
 980
 981 =head2 as
 982
 983 =head3 Arguments: (arrayref)
 984
 985 Indicates column names for object inflation. This is used in conjunction with
 986 C<select>, usually when C<select> contains one or more function or stored
 987 procedure names:
 988
 989   $rs = $schema->resultset('Foo')->search(
 990     {},
 991     {
 992       select => [
 993         'column1',
 994         { count => 'column2' }
 995       ],
 996       as => [qw/ column1 column2_count /]
 997     }
 998   );
 999
1000   my $foo = $rs->first(); # get the first Foo
1001
1002 If the object against which the search is performed already has an accessor
1003 matching a column name specified in C<as>, the value can be retrieved using
1004 the accessor as normal:
1005
1006   my $column1 = $foo->column1();
1007
1008 If on the other hand an accessor does not exist in the object, you need to
1009 use C<get_column> instead:
1010
1011   my $column2_count = $foo->get_column('column2_count');
1012
1013 You can create your own accessors if required - see
1014 L<DBIx::Class::Manual::Cookbook> for details.
1015
1016 =head2 join
1017
1018 Contains a list of relationships that should be joined for this query.  For
1019 example:
1020
1021   # Get CDs by Nine Inch Nails
1022   my $rs = $schema->resultset('CD')->search(
1023     { 'artist.name' => 'Nine Inch Nails' },
1024     { join => 'artist' }
1025   );
1026
1027 Can also contain a hash reference to refer to the other relation's relations.
1028 For example:
1029
1030   package MyApp::Schema::Track;
1031   use base qw/DBIx::Class/;
1032   __PACKAGE__->table('track');
1033   __PACKAGE__->add_columns(qw/trackid cd position title/);
1034   __PACKAGE__->set_primary_key('trackid');
1035   __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
1036   1;
1037
1038   # In your application
1039   my $rs = $schema->resultset('Artist')->search(
1040     { 'track.title' => 'Teardrop' },
1041     {
1042       join     => { cd => 'track' },
1043       order_by => 'artist.name',
1044     }
1045   );
1046
1047 If the same join is supplied twice, it will be aliased to <rel>_2 (and
1048 similarly for a third time). For e.g.
1049
1050   my $rs = $schema->resultset('Artist')->search(
1051     { 'cds.title'   => 'Foo',
1052       'cds_2.title' => 'Bar' },
1053     { join => [ qw/cds cds/ ] });
1054
1055 will return a set of all artists that have both a cd with title Foo and a cd
1056 with title Bar.
1057
1058 If you want to fetch related objects from other tables as well, see C<prefetch>
1059 below.
1060
1061 =head2 prefetch
1062
1063 =head3 Arguments: arrayref/hashref
1064
1065 Contains one or more relationships that should be fetched along with the main
1066 query (when they are accessed afterwards they will have already been
1067 "prefetched").  This is useful for when you know you will need the related
1068 objects, because it saves at least one query:
1069
1070   my $rs = $schema->resultset('Tag')->search(
1071     {},
1072     {
1073       prefetch => {
1074         cd => 'artist'
1075       }
1076     }
1077   );
1078
1079 The initial search results in SQL like the following:
1080
1081   SELECT tag.*, cd.*, artist.* FROM tag
1082   JOIN cd ON tag.cd = cd.cdid
1083   JOIN artist ON cd.artist = artist.artistid
1084
1085 L<DBIx::Class> has no need to go back to the database when we access the
1086 C<cd> or C<artist> relationships, which saves us two SQL statements in this
1087 case.
1088
1089 Simple prefetches will be joined automatically, so there is no need
1090 for a C<join> attribute in the above search. If you're prefetching to
1091 depth (e.g. { cd => { artist => 'label' } or similar), you'll need to
1092 specify the join as well.
1093
1094 C<prefetch> can be used with the following relationship types: C<belongs_to>,
1095 C<has_one> (or if you're using C<add_relationship>, any relationship declared
1096 with an accessor type of 'single' or 'filter').
1097
1098 =head2 from
1099
1100 =head3 Arguments: (arrayref)
1101
1102 The C<from> attribute gives you manual control over the C<FROM> clause of SQL
1103 statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
1104 clauses.
1105
1106 NOTE: Use this on your own risk.  This allows you to shoot off your foot!
1107 C<join> will usually do what you need and it is strongly recommended that you
1108 avoid using C<from> unless you cannot achieve the desired result using C<join>.
1109
1110 In simple terms, C<from> works as follows:
1111
1112     [
1113         { <alias> => <table>, -join-type => 'inner|left|right' }
1114         [] # nested JOIN (optional)
1115         { <table.column> = <foreign_table.foreign_key> }
1116     ]
1117
1118     JOIN
1119         <alias> <table>
1120         [JOIN ...]
1121     ON <table.column> = <foreign_table.foreign_key>
1122
1123 An easy way to follow the examples below is to remember the following:
1124
1125     Anything inside "[]" is a JOIN
1126     Anything inside "{}" is a condition for the enclosing JOIN
1127
1128 The following examples utilize a "person" table in a family tree application.
1129 In order to express parent->child relationships, this table is self-joined:
1130
1131     # Person->belongs_to('father' => 'Person');
1132     # Person->belongs_to('mother' => 'Person');
1133
1134 C<from> can be used to nest joins. Here we return all children with a father,
1135 then search against all mothers of those children:
1136
1137   $rs = $schema->resultset('Person')->search(
1138       {},
1139       {
1140           alias => 'mother', # alias columns in accordance with "from"
1141           from => [
1142               { mother => 'person' },
1143               [
1144                   [
1145                       { child => 'person' },
1146                       [
1147                           { father => 'person' },
1148                           { 'father.person_id' => 'child.father_id' }
1149                       ]
1150                   ],
1151                   { 'mother.person_id' => 'child.mother_id' }
1152               ],
1153           ]
1154       },
1155   );
1156
1157   # Equivalent SQL:
1158   # SELECT mother.* FROM person mother
1159   # JOIN (
1160   #   person child
1161   #   JOIN person father
1162   #   ON ( father.person_id = child.father_id )
1163   # )
1164   # ON ( mother.person_id = child.mother_id )
1165
1166 The type of any join can be controlled manually. To search against only people
1167 with a father in the person table, we could explicitly use C<INNER JOIN>:
1168
1169     $rs = $schema->resultset('Person')->search(
1170         {},
1171         {
1172             alias => 'child', # alias columns in accordance with "from"
1173             from => [
1174                 { child => 'person' },
1175                 [
1176                     { father => 'person', -join-type => 'inner' },
1177                     { 'father.id' => 'child.father_id' }
1178                 ],
1179             ]
1180         },
1181     );
1182
1183     # Equivalent SQL:
1184     # SELECT child.* FROM person child
1185     # INNER JOIN person father ON child.father_id = father.id
1186
1187 =head2 page
1188
1189 For a paged resultset, specifies which page to retrieve.  Leave unset
1190 for an unpaged resultset.
1191
1192 =head2 rows
1193
1194 For a paged resultset, how many rows per page:
1195
1196   rows => 10
1197
1198 Can also be used to simulate an SQL C<LIMIT>.
1199
1200 =head2 group_by
1201
1202 =head3 Arguments: (arrayref)
1203
1204 A arrayref of columns to group by. Can include columns of joined tables.
1205
1206   group_by => [qw/ column1 column2 ... /]
1207
1208 =head2 distinct
1209
1210 Set to 1 to group by all columns.
1211
1212 For more examples of using these attributes, see
1213 L<DBIx::Class::Manual::Cookbook>.
1214
1215 =cut
1216
1217 1;