Perl: DBIx::Class Beginner - Subsetting Relationships and Prefetching

Question

Okay, I'm new to DBIx::Class. I have a one-to-many relationship set up, like so:

User -> has_many -> Addresses

Okay, good. I can do a query, and call it prefetching JOINed tables, like so:

Foo::DBIC->storage->debug(1);    # output SQL to STDOUT

my $user = Foo::DBIC->resultset('Users')->search({}, {
  prefetch => [ 'addresses' ],
  join     => [ 'addresses' ],
  rows     => 1
})->single;

for my $address ($user->addresses->all) {
  say $address->zip_code;
}

Two tables, one SQL query (verified via debug). All is well.

Now, however, let's say I want to write an overload method or two in Foo::DBIC::Result::Users that returns a subset of addresses, based on certain criteria. Here's what I've added to the Users class:

sub home_addresses {
  my $self = shift;

  return $self->search_related('addresses', { address_type => 'home' });
}

sub business_addresses {
  my $self = shift;

  return $self->search_related('addresses', { address_type => 'business' });
}

I can call these overloads like so, and they work:

for my $address ($user->home_addresses->all) {
  say $address->zip_code;
}

However, this ignores the fact that I've prefetched my join, and it performs ADDITIONAL QUERIES (as if I've not prefetched and joined anything).

So, my question is this: how do I define an overload method that returns a subset of a related table, but uses the already prefetched join? (just appending a WHERE clause to the prefetch)...

My problem is that if I have a lot of the overloaded methods returning related table subsets, my query count can blow up; especially if I'm calling them from within a loop.

I have reasons for doing this that are, of course, ugly. My real life schema is a lot, lot, lot messier than Users and Addresses, and I'm trying to abstract away ugly as best I can.

Thanks!

Answer 1

something like this for home_addresses might work:

sub home_addresses {
  my $self = shift;
  my $addresses = $self->addresses;
  my $home_addresses;
  while (my $row = $addresses->next()) {
    push @$home_addresses, $row if $row->address_type() eq 'home';
  }
  my $home_rs = $addresses->result_source->resultset;
  $home_rs->set_cache( $home_addresses );
  $home_rs;
}

Alternatively, if there a lot of address types something like this:

sub addresses_by_type {
  my $self = shift;
  my $addresses = $self->addresses;
  my $type;
  my $rs_type;
  while (my $row = $addresses->next()) {
    push @{$type->{"".$row->address_type}},
        $row;
  }
  for (keys %$type) {
    my $new_rs = $addresses->result_source->resultset;
    $new_rs->set_cache( $type->{$_} );
    $rs_type->{$_} = $new_rs
  }
  return $rs_type  
}

which you could access the 'home' addresses from like this:

while (my $r = $user->next) {
  use Data::Dumper;
  local $Data::Dumper::Maxdepth = 2;
  print $r->username,"\n";
  my $d = $r->addresses_by_type();
  my $a = $d->{home};
  while (defined $a and my $ar = $a->next) {
    print $ar->address,"\n";
  }
}

Answer 2

Could you try something like this:

sub home_addresses {
  my $self = shift;
  my $return = [];
  my @addresses = $self->addresses->all();
  foreach my $row (@addresses) {
    push @$return, $row if $row->address_type() eq 'home';
  }

  return $return;
}