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