view release on metacpan or  search on metacpan

lib/DBIx/Class/Relationship/Base.pm  view on Meta::CPAN

package DBIx::Class::Relationship::Base;

use strict;
use warnings;

use base qw/DBIx::Class/;

use Scalar::Util qw/weaken blessed/;
use Try::Tiny;
use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
use namespace::clean;

=head1 NAME

DBIx::Class::Relationship::Base - Inter-table relationships

=head1 SYNOPSIS

  __PACKAGE__->add_relationship(
    spiders => 'My::DB::Result::Creatures',
    sub {
      my $args = shift;
      return {
        "$args->{foreign_alias}.id"   => { -ident => "$args->{self_alias}.id" },
        "$args->{foreign_alias}.type" => 'arachnid'
      };
    },
  );

=head1 DESCRIPTION

This class provides methods to describe the relationships between the
tables in your database model. These are the "bare bones" relationships
methods, for predefined ones, look in L<DBIx::Class::Relationship>.

=head1 METHODS

=head2 add_relationship

=over 4

=item Arguments: $rel_name, $foreign_class, $condition, $attrs

=back

  __PACKAGE__->add_relationship('rel_name',
                                'Foreign::Class',
                                $condition, $attrs);

Create a custom relationship between one result source and another
source, indicated by its class name.

=head3 condition

The condition argument describes the C<ON> clause of the C<JOIN>
expression used to connect the two sources when creating SQL queries.

=head4 Simple equality

To create simple equality joins, supply a hashref containing the remote
table column name as the key(s) prefixed by C<'foreign.'>, and the
corresponding local table column name as the value(s) prefixed by C<'self.'>.
Both C<foreign> and C<self> are pseudo aliases and must be entered
literally. They will be replaced with the actual correct table alias
when the SQL is produced.

For example given:

lib/DBIx/Class/Relationship/Base.pm  view on Meta::CPAN

  return $self->{related_resultsets}{$rel} = do {

    my $rsrc = $self->result_source;

    my $rel_info = $rsrc->relationship_info($rel)
      or $self->throw_exception( "No such relationship '$rel'" );

    my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
    $attrs = { %{$rel_info->{attrs} || {}}, %$attrs };

    $self->throw_exception( "Invalid query: @_" )
      if (@_ > 1 && (@_ % 2 == 1));
    my $query = ((@_ > 1) ? {@_} : shift);

    # condition resolution may fail if an incomplete master-object prefetch
    # is encountered - that is ok during prefetch construction (not yet in_storage)
    my ($cond, $is_crosstable) = try {
      $rsrc->_resolve_condition( $rel_info->{cond}, $rel, $self, $rel )
    }
    catch {
      $self->throw_exception ($_) if $self->in_storage;
      UNRESOLVABLE_CONDITION;  # RV, no return()
    };

    # keep in mind that the following if() block is part of a do{} - no return()s!!!
    if ($is_crosstable and ref $rel_info->{cond} eq 'CODE') {

      # A WHOREIFFIC hack to reinvoke the entire condition resolution
      # with the correct alias. Another way of doing this involves a
      # lot of state passing around, and the @_ positions are already
      # mapped out, making this crap a less icky option.
      #
      # The point of this exercise is to retain the spirit of the original
      # $obj->search_related($rel) where the resulting rset will have the
      # root alias as 'me', instead of $rel (as opposed to invoking
      # $rs->search_related)

      # make the fake 'me' rel
      local $rsrc->{_relationships}{me} = {
        %{ $rsrc->{_relationships}{$rel} },
        _original_name => $rel,
      };

      my $obj_table_alias = lc($rsrc->source_name) . '__row';
      $obj_table_alias =~ s/\W+/_/g;

      $rsrc->resultset->search(
        $self->ident_condition($obj_table_alias),
        { alias => $obj_table_alias },
      )->search_related('me', $query, $attrs)
    }
    else {
      # FIXME - this conditional doesn't seem correct - got to figure out
      # at some point what it does. Also the entire UNRESOLVABLE_CONDITION
      # business seems shady - we could simply not query *at all*
      if ($cond eq UNRESOLVABLE_CONDITION) {
        my $reverse = $rsrc->reverse_relationship_info($rel);
        foreach my $rev_rel (keys %$reverse) {
          if ($reverse->{$rev_rel}{attrs}{accessor} && $reverse->{$rev_rel}{attrs}{accessor} eq 'multi') {
            weaken($attrs->{related_objects}{$rev_rel}[0] = $self);
          } else {
            weaken($attrs->{related_objects}{$rev_rel} = $self);
          }
        }
      }
      elsif (ref $cond eq 'ARRAY') {
        $cond = [ map {
          if (ref $_ eq 'HASH') {
            my $hash;
            foreach my $key (keys %$_) {
              my $newkey = $key !~ /\./ ? "me.$key" : $key;
              $hash->{$newkey} = $_->{$key};
            }
            $hash;
          } else {
            $_;
          }
        } @$cond ];
      }
      elsif (ref $cond eq 'HASH') {
       foreach my $key (grep { ! /\./ } keys %$cond) {
          $cond->{"me.$key"} = delete $cond->{$key};
        }
      }

      $query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
      $rsrc->related_source($rel)->resultset->search(
        $query, $attrs
      );
    }
  };
}

=head2 search_related

=over 4

=item Arguments: $rel_name, $cond?, L<\%attrs?|DBIx::Class::ResultSet/ATTRIBUTES>

=item Return Value: L<$resultset|DBIx::Class::ResultSet> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)

=back

Run a search on a related resultset. The search will be restricted to the
results represented by the L<DBIx::Class::ResultSet> it was called
upon.

See L<DBIx::Class::ResultSet/search_related> for more information.

=cut

sub search_related {
  return shift->related_resultset(shift)->search(@_);
}

=head2 search_related_rs

This method works exactly the same as search_related, except that
it guarantees a resultset, even in list context.

=cut