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