lib/DBIx/Class/Relationship/ManyToMany.pm

   1 package # hide from PAUSE
   2     DBIx::Class::Relationship::ManyToMany;
   3
   4 use strict;
   5 use warnings;
   6
   7 sub many_to_many {
   8   my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_;
   9   {
  10     no strict 'refs';
  11     no warnings 'redefine';
  12
  13     my $add_meth = "add_to_${meth}";
  14     my $remove_meth = "remove_from_${meth}";
  15     my $set_meth = "set_${meth}";
  16
  17     *{"${class}::${meth}"} = sub {
  18       my $self = shift;
  19       my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {};
  20       my @args = ($f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs });
  21       $self->search_related($rel)->search_related(
  22         $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs }
  23       );
  24     };
  25
  26     *{"${class}::${add_meth}"} = sub {
  27       my $self = shift;
  28       @_ > 0 or $self->throw_exception(
  29         "${add_meth} needs an object or hashref"
  30       );
  31       my $source = $self->result_source;
  32       my $schema = $source->schema;
  33       my $rel_source_name = $source->relationship_info($rel)->{source};
  34       my $rel_source = $schema->resultset($rel_source_name)->result_source;
  35       my $f_rel_source_name = $rel_source->relationship_info($f_rel)->{source};
  36       my $f_rel_rs = $schema->resultset($f_rel_source_name)->search({}, $rel_attrs||{});
  37
  38       my $obj;
  39       if (ref $_[0]) {
  40         if (ref $_[0] eq 'HASH') {
  41           $obj = $f_rel_rs->create($_[0]);
  42         } else {
  43           $obj = $_[0];
  44         }
  45       } else {
  46         $obj = $f_rel_rs->create({@_});
  47       }
  48
  49       my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {};
  50       my $link = $self->search_related($rel)->new_result({});
  51       $link->set_from_related($f_rel, $obj);
  52       $link->set_columns($link_vals);
  53       $link->insert();
  54     };
  55
  56     *{"${class}::${set_meth}"} = sub {
  57       my $self = shift;
  58       @_ > 0 or $self->throw_exception(
  59         "{$set_meth} needs a list of objects or hashrefs"
  60       );
  61       $self->search_related($rel, {})->delete;
  62       $self->$add_meth(shift) while (defined $_[0]);
  63     };
  64
  65     *{"${class}::${remove_meth}"} = sub {
  66       my $self = shift;
  67       @_ > 0 && ref $_[0] ne 'HASH'
  68         or $self->throw_exception("${remove_meth} needs an object");
  69       my $obj = shift;
  70       my $rel_source = $self->search_related($rel)->result_source;
  71       my $cond = $rel_source->relationship_info($f_rel)->{cond};
  72       my $link_cond = $rel_source->resolve_condition(
  73         $cond, $obj, $f_rel
  74       );
  75       $self->search_related($rel, $link_cond)->delete;
  76     };
  77
  78   }
  79 }
  80
  81 1;