lib/DBIx/Class/ResultSet.pm

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