lib/DBIx/Class/ResultSet.pm

   1 package DBIx::Class::ResultSet;
   2
   3 use strict;
   4 use warnings;
   5 use overload
   6         '0+'     => 'count',
   7         fallback => 1;
   8 use Data::Page;
   9 use Storable;
  10
  11 =head1 NAME
  12
  13 DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
  14
  15 =head1 SYNOPSIS
  16
  17 my $rs = MyApp::DB::Class->search(registered => 1);
  18 my @rows = MyApp::DB::Class->search(foo => 'bar');
  19
  20 =head1 DESCRIPTION
  21
  22 The resultset is also known as an iterator. It is responsible for handling
  23 queries that may return an arbitrary number of rows, e.g. via C<search>
  24 or a C<has_many> relationship.
  25
  26 =head1 METHODS
  27
  28 =head2 new($source, \%$attrs)
  29
  30 The resultset constructor. Takes a source object (usually a DBIx::Class::Table)
  31 and an attribute hash (see below for more information on attributes). Does
  32 not perform any queries -- these are executed as needed by the other methods.
  33
  34 =cut
  35
  36 sub new {
  37   my $class = shift;
  38   return $class->new_result(@_) if ref $class;
  39   my ($source, $attrs) = @_;
  40   #use Data::Dumper; warn Dumper($attrs);
  41   $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
  42   my %seen;
  43
  44   # wrong! we cannot delete select/as because it will interfere with the count() method. need to just set alias correctly in the first instance
  45 =pod
  46   if( $attrs->{from} && $attrs->{alias} eq 'me' ) {
  47     my @keys = keys( %{$attrs->{from}->[0]} );
  48     $attrs->{alias} = $keys[0];
  49     delete $attrs->{select};
  50     delete $attrs->{as};
  51     #die Dumper $attrs;
  52   }
  53 =cut
  54 # alias should be set in accordance with from if alias is not defined or = "me"
  55 # could also alter the line below instead, i.e. use alias if defined, then get from "from", then class->table, then "me" as a last resort.
  56
  57   my $alias = ($attrs->{alias} ||= 'me');
  58   if (!$attrs->{select}) {
  59     my @cols = ($attrs->{cols}
  60                  ? @{delete $attrs->{cols}}
  61                  : $source->result_class->_select_columns);
  62     $attrs->{select} = [ map { m/\./ ? $_ : "${alias}.$_" } @cols ];
  63   }
  64   $attrs->{as} ||= [ map { m/^$alias\.(.*)$/ ? $1 : $_ } @{$attrs->{select}} ];
  65   #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
  66   $attrs->{from} ||= [ { $alias => $source->from } ];
  67   if (my $join = delete $attrs->{join}) {
  68     foreach my $j (ref $join eq 'ARRAY'
  69               ? (@{$join}) : ($join)) {
  70       if (ref $j eq 'HASH') {
  71         $seen{$_} = 1 foreach keys %$j;
  72       } else {
  73         $seen{$j} = 1;
  74       }
  75     }
  76     push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}));
  77   }
  78   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
  79   foreach my $pre (@{delete $attrs->{prefetch} || []}) {
  80     push(@{$attrs->{from}}, $source->resolve_join($pre, $attrs->{alias}))
  81       unless $seen{$pre};
  82     my @pre =
  83       map { "$pre.$_" }
  84       $source->related_source($pre)->columns;
  85     push(@{$attrs->{select}}, @pre);
  86     push(@{$attrs->{as}}, @pre);
  87   }
  88   if ($attrs->{page}) {
  89     $attrs->{rows} ||= 10;
  90     $attrs->{offset} ||= 0;
  91     $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
  92   }
  93   my $new = {
  94     source => $source,
  95     cond => $attrs->{where},
  96     from => $attrs->{from},
  97     count => undef,
  98     page => delete $attrs->{page},
  99     pager => undef,
 100     attrs => $attrs };
 101   bless ($new, $class);
 102   return $new;
 103 }
 104
 105 =head2 search
 106
 107   my @obj    = $rs->search({ foo => 3 }); # "... WHERE foo = 3"
 108   my $new_rs = $rs->search({ foo => 3 });
 109
 110 If you need to pass in additional attributes but no additional condition,
 111 call it as ->search(undef, \%attrs);
 112
 113   my @all = $class->search({}, { cols => [qw/foo bar/] }); # "SELECT foo, bar FROM $class_table"
 114
 115 =cut
 116
 117 sub search {
 118   my $self = shift;
 119
 120   #use Data::Dumper;warn Dumper(@_);
 121
 122   my $attrs = { %{$self->{attrs}} };
 123   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 124     $attrs = { %$attrs, %{ pop(@_) } };
 125   }
 126
 127   my $where = (@_ ? ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_}) : undef());
 128   if (defined $where) {
 129     $where = (defined $attrs->{where}
 130                 ? { '-and' =>
 131                     [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
 132                         $where, $attrs->{where} ] }
 133                 : $where);
 134     $attrs->{where} = $where;
 135   }
 136
 137   my $rs = (ref $self)->new($self->{source}, $attrs);
 138
 139   return (wantarray ? $rs->all : $rs);
 140 }
 141
 142 =head2 search_literal
 143   my @obj    = $rs->search_literal($literal_where_cond, @bind);
 144   my $new_rs = $rs->search_literal($literal_where_cond, @bind);
 145
 146 Pass a literal chunk of SQL to be added to the conditional part of the
 147 resultset
 148
 149 =cut
 150
 151 sub search_literal {
 152   my ($self, $cond, @vals) = @_;
 153   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
 154   $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ];
 155   return $self->search(\$cond, $attrs);
 156 }
 157
 158 =head2 find(@colvalues), find(\%cols)
 159
 160 Finds a row based on its primary key(s).
 161
 162 =cut
 163
 164 sub find {
 165   my ($self, @vals) = @_;
 166   my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
 167   my @pk = $self->{source}->primary_columns;
 168   #use Data::Dumper; warn Dumper($attrs, @vals, @pk);
 169   $self->{source}->result_class->throw( "Can't find unless primary columns are defined" )
 170     unless @pk;
 171   my $query;
 172   if (ref $vals[0] eq 'HASH') {
 173     $query = $vals[0];
 174   } elsif (@pk == @vals) {
 175     $query = {};
 176     @{$query}{@pk} = @vals;
 177   } else {
 178     $query = {@vals};
 179   }
 180   #warn Dumper($query);
 181   # Useless -> disabled
 182   #$self->{source}->result_class->throw( "Can't find unless all primary keys are specified" )
 183   #  unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
 184                                   # column names etc. Not sure what to do yet
 185   return $self->search($query)->next;
 186 }
 187
 188 =head2 search_related
 189
 190   $rs->search_related('relname', $cond?, $attrs?);
 191
 192 =cut
 193
 194 sub search_related {
 195   my ($self, $rel, @rest) = @_;
 196   my $rel_obj = $self->{source}->relationship_info($rel);
 197   $self->{source}->result_class->throw(
 198     "No such relationship ${rel} in search_related")
 199       unless $rel_obj;
 200   my $rs = $self->search(undef, { join => $rel });
 201   return $self->{source}->schema->resultset($rel_obj->{class}
 202            )->search( undef,
 203              { %{$rs->{attrs}},
 204                alias => $rel,
 205                select => undef(),
 206                as => undef() }
 207            )->search(@rest);
 208 }
 209
 210 =head2 cursor
 211
 212 Returns a storage-driven cursor to the given resultset.
 213
 214 =cut
 215
 216 sub cursor {
 217   my ($self) = @_;
 218   my ($source, $attrs) = @{$self}{qw/source attrs/};
 219   $attrs = { %$attrs };
 220   return $self->{cursor}
 221     ||= $source->storage->select($self->{from}, $attrs->{select},
 222           $attrs->{where},$attrs);
 223 }
 224
 225 =head2 search_like
 226
 227 Identical to search except defaults to 'LIKE' instead of '=' in condition
 228
 229 =cut
 230
 231 sub search_like {
 232   my $class    = shift;
 233   my $attrs = { };
 234   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 235     $attrs = pop(@_);
 236   }
 237   my $query    = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
 238   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
 239   return $class->search($query, { %$attrs });
 240 }
 241
 242 =head2 slice($first, $last)
 243
 244 Returns a subset of elements from the resultset.
 245
 246 =cut
 247
 248 sub slice {
 249   my ($self, $min, $max) = @_;
 250   my $attrs = { %{ $self->{attrs} || {} } };
 251   $attrs->{offset} ||= 0;
 252   $attrs->{offset} += $min;
 253   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
 254   my $slice = (ref $self)->new($self->{source}, $attrs);
 255   return (wantarray ? $slice->all : $slice);
 256 }
 257
 258 =head2 next
 259
 260 Returns the next element in the resultset (undef is there is none).
 261
 262 =cut
 263
 264 sub next {
 265   my ($self) = @_;
 266   my @row = $self->cursor->next;
 267   return unless (@row);
 268   return $self->_construct_object(@row);
 269 }
 270
 271 sub _construct_object {
 272   my ($self, @row) = @_;
 273   my @cols = @{ $self->{attrs}{as} };
 274   #warn "@cols -> @row";
 275   my (%me, %pre);
 276   foreach my $col (@cols) {
 277     if ($col =~ /([^\.]+)\.([^\.]+)/) {
 278       $pre{$1}[0]{$2} = shift @row;
 279     } else {
 280       $me{$col} = shift @row;
 281     }
 282   }
 283   my $new = $self->{source}->result_class->inflate_result(
 284               $self->{source}, \%me, \%pre);
 285   $new = $self->{attrs}{record_filter}->($new)
 286     if exists $self->{attrs}{record_filter};
 287   return $new;
 288 }
 289
 290 =head2 count
 291
 292 Performs an SQL C<COUNT> with the same query as the resultset was built
 293 with to find the number of elements. If passed arguments, does a search
 294 on the resultset and counts the results of that.
 295
 296 =cut
 297
 298 sub count {
 299   my $self = shift;
 300   return $self->search(@_)->count if @_ && defined $_[0];
 301   die "Unable to ->count with a GROUP BY" if defined $self->{attrs}{group_by};
 302   unless (defined $self->{count}) {
 303     my $attrs = { %{ $self->{attrs} },
 304                   select => { 'count' => '*' },
 305                   as => [ 'count' ] };
 306     # offset, order by and page are not needed to count. record_filter is cdbi
 307     delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
 308
 309     ($self->{count}) = (ref $self)->new($self->{source}, $attrs)->cursor->next;
 310   }
 311   return 0 unless $self->{count};
 312   my $count = $self->{count};
 313   $count -= $self->{attrs}{offset} if $self->{attrs}{offset};
 314   $count = $self->{attrs}{rows} if
 315     ($self->{attrs}{rows} && $self->{attrs}{rows} < $count);
 316   return $count;
 317 }
 318
 319 =head2 count_literal
 320
 321 Calls search_literal with the passed arguments, then count.
 322
 323 =cut
 324
 325 sub count_literal { shift->search_literal(@_)->count; }
 326
 327 =head2 all
 328
 329 Returns all elements in the resultset. Called implictly if the resultset
 330 is returned in list context.
 331
 332 =cut
 333
 334 sub all {
 335   my ($self) = @_;
 336   return map { $self->_construct_object(@$_); }
 337            $self->cursor->all;
 338 }
 339
 340 =head2 reset
 341
 342 Resets the resultset's cursor, so you can iterate through the elements again.
 343
 344 =cut
 345
 346 sub reset {
 347   my ($self) = @_;
 348   $self->cursor->reset;
 349   return $self;
 350 }
 351
 352 =head2 first
 353
 354 Resets the resultset and returns the first element.
 355
 356 =cut
 357
 358 sub first {
 359   return $_[0]->reset->next;
 360 }
 361
 362 =head2 update(\%values)
 363
 364 Sets the specified columns in the resultset to the supplied values
 365
 366 =cut
 367
 368 sub update {
 369   my ($self, $values) = @_;
 370   die "Values for update must be a hash" unless ref $values eq 'HASH';
 371   return $self->{source}->storage->update(
 372            $self->{source}->from, $values, $self->{cond});
 373 }
 374
 375 =head2 update_all(\%values)
 376
 377 Fetches all objects and updates them one at a time. ->update_all will run
 378 cascade triggers, ->update will not.
 379
 380 =cut
 381
 382 sub update_all {
 383   my ($self, $values) = @_;
 384   die "Values for update must be a hash" unless ref $values eq 'HASH';
 385   foreach my $obj ($self->all) {
 386     $obj->set_columns($values)->update;
 387   }
 388   return 1;
 389 }
 390
 391 =head2 delete
 392
 393 Deletes the contents of the resultset from its result source.
 394
 395 =cut
 396
 397 sub delete {
 398   my ($self) = @_;
 399   $self->{source}->storage->delete($self->{source}->from, $self->{cond});
 400   return 1;
 401 }
 402
 403 =head2 delete_all
 404
 405 Fetches all objects and deletes them one at a time. ->delete_all will run
 406 cascade triggers, ->delete will not.
 407
 408 =cut
 409
 410 sub delete_all {
 411   my ($self) = @_;
 412   $_->delete for $self->all;
 413   return 1;
 414 }
 415
 416 =head2 pager
 417
 418 Returns a L<Data::Page> object for the current resultset. Only makes
 419 sense for queries with page turned on.
 420
 421 =cut
 422
 423 sub pager {
 424   my ($self) = @_;
 425   my $attrs = $self->{attrs};
 426   die "Can't create pager for non-paged rs" unless $self->{page};
 427   $attrs->{rows} ||= 10;
 428   $self->count;
 429   return $self->{pager} ||= Data::Page->new(
 430     $self->{count}, $attrs->{rows}, $self->{page});
 431 }
 432
 433 =head2 page($page_num)
 434
 435 Returns a new resultset for the specified page.
 436
 437 =cut
 438
 439 sub page {
 440   my ($self, $page) = @_;
 441   my $attrs = { %{$self->{attrs}} };
 442   $attrs->{page} = $page;
 443   return (ref $self)->new($self->{source}, $attrs);
 444 }
 445
 446 =head2 new_result(\%vals)
 447
 448 Creates a result in the resultset's result class
 449
 450 =cut
 451
 452 sub new_result {
 453   my ($self, $values) = @_;
 454   $self->{source}->result_class->throw( "new_result needs a hash" )
 455     unless (ref $values eq 'HASH');
 456   $self->{source}->result_class->throw( "Can't abstract implicit construct, condition not a hash" )
 457     if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
 458   my %new = %$values;
 459   my $alias = $self->{attrs}{alias};
 460   foreach my $key (keys %{$self->{cond}||{}}) {
 461     $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:$alias\.)?([^\.]+)$/);
 462   }
 463   my $obj = $self->{source}->result_class->new(\%new);
 464   $obj->result_source($self->{source}) if $obj->can('result_source');
 465   $obj;
 466 }
 467
 468 =head2 create(\%vals)
 469
 470 Inserts a record into the resultset and returns the object
 471
 472 Effectively a shortcut for ->new_result(\%vals)->insert
 473
 474 =cut
 475
 476 sub create {
 477   my ($self, $attrs) = @_;
 478   $self->{source}->result_class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
 479   return $self->new_result($attrs)->insert;
 480 }
 481
 482 =head2 find_or_create(\%vals)
 483
 484   $class->find_or_create({ key => $val, ... });
 485
 486 Searches for a record matching the search condition; if it doesn't find one,
 487 creates one and returns that instead.
 488
 489 =cut
 490
 491 sub find_or_create {
 492   my $self     = shift;
 493   my $hash     = ref $_[0] eq "HASH" ? shift: {@_};
 494   my $exists   = $self->find($hash);
 495   return defined($exists) ? $exists : $self->create($hash);
 496 }
 497
 498 =head1 ATTRIBUTES
 499
 500 The resultset takes various attributes that modify its behavior.
 501 Here's an overview of them:
 502
 503 =head2 order_by
 504
 505 Which column(s) to order the results by. This is currently passed
 506 through directly to SQL, so you can give e.g. C<foo DESC> for a
 507 descending order.
 508
 509 =head2 cols (arrayref)
 510
 511 Shortcut to request a particular set of columns to be retrieved - adds
 512 'me.' onto the start of any column without a '.' in it and sets 'select'
 513 from that, then auto-populates 'as' from 'select' as normal
 514
 515 =head2 select (arrayref)
 516
 517 Indicates which columns should be selected from the storage
 518
 519 =head2 as (arrayref)
 520
 521 Indicates column names for object inflation
 522
 523 =head2 join
 524
 525 Contains a list of relationships that should be joined for this query. Can also
 526 contain a hash reference to refer to that relation's relations. So, if one column
 527 in your class C<belongs_to> foo and another C<belongs_to> bar, you can do
 528 C<< join => [qw/ foo bar /] >> to join both (and e.g. use them for C<order_by>).
 529 If a foo contains many margles and you want to join those too, you can do
 530 C<< join => { foo => 'margle' } >>. If you want to fetch the columns from the
 531 related table as well, see C<prefetch> below.
 532
 533 =head2 prefetch
 534
 535 Contains a list of relationships that should be fetched along with the main
 536 query (when they are accessed afterwards they will have already been
 537 "prefetched"). This is useful for when you know you will need the related
 538 object(s), because it saves a query. Currently limited to prefetching
 539 one relationship deep, so unlike C<join>, prefetch must be an arrayref.
 540
 541 =head2 from
 542
 543 This attribute can contain a arrayref of elements. Each element can be another
 544 arrayref, to nest joins, or it can be a hash which represents the two sides
 545 of the join.
 546
 547 NOTE: Use this on your own risk. This allows you to shoot your foot off!
 548
 549 =head2 page
 550
 551 For a paged resultset, specifies which page to retrieve. Leave unset
 552 for an unpaged resultset.
 553
 554 =head2 rows
 555
 556 For a paged resultset, how many rows per page
 557
 558 =head2 group_by (listref)
 559
 560 A listref of columns to group by (note that 'count' doesn't work on grouped
 561 resultsets)
 562
 563   group_by => [qw/ column1 column2 ... /]
 564
 565 =head2 distinct
 566
 567 Set to 1 to group by all columns
 568
 569 =cut
 570
 571 1;