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