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