Merge 'trunk' into 'sybase'
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Relationship / ManyToMany.pm
CommitLineData
75d07914 1package # hide from PAUSE
c0e7b4e5 2 DBIx::Class::Relationship::ManyToMany;
8973b6f1 3
4use strict;
5use warnings;
b234e9d9 6
7use Carp::Clan qw/^DBIx::Class/;
ddc0a6c8 8use Sub::Name ();
8973b6f1 9
044e70c7 10our %_pod_inherit_config =
11 (
12 class_map => { 'DBIx::Class::Relationship::ManyToMany' => 'DBIx::Class::Relationship' }
13 );
14
8973b6f1 15sub many_to_many {
78af1010 16 my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_;
d0ed3b55 17
18 $class->throw_exception(
19 "missing relation in many-to-many"
20 ) unless $rel;
21
22 $class->throw_exception(
23 "missing foreign relation in many-to-many"
24 ) unless $f_rel;
25
8973b6f1 26 {
27 no strict 'refs';
28 no warnings 'redefine';
4b3ab474 29
b3f358b5 30 my $add_meth = "add_to_${meth}";
31 my $remove_meth = "remove_from_${meth}";
32 my $set_meth = "set_${meth}";
18788bf2 33 my $rs_meth = "${meth}_rs";
303cf522 34
35210a5d 35 for ($add_meth, $remove_meth, $set_meth, $rs_meth) {
d81b2771 36 if ( $class->can ($_) ) {
b7d1831a 37 carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK};
b234e9d9 38
35678f0b 39***************************************************************************
b234e9d9 40The many-to-many relationship '$meth' is trying to create a utility method
41called $_.
42This will completely overwrite one such already existing method on class
43$class.
d81b2771 44
b234e9d9 45You almost certainly want to rename your method or the many-to-many
46relationship, as the functionality of the original method will not be
47accessible anymore.
d81b2771 48
b7d1831a 49To disable this warning set to a true value the environment variable
50DBIC_OVERWRITE_HELPER_METHODS_OK
35678f0b 51
35678f0b 52***************************************************************************
53EOW
d81b2771 54 }
35210a5d 55 }
56
7141bdfc 57 $rel_attrs->{alias} ||= $f_rel;
58
ddc0a6c8 59 my $rs_meth_name = join '::', $class, $rs_meth;
60 *$rs_meth_name = Sub::Name::subname $rs_meth_name, sub {
0f6ac8bb 61 my $self = shift;
62 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {};
78060df8 63 my @args = ($f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs });
18788bf2 64 my $rs = $self->search_related($rel)->search_related(
3a868fb2 65 $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs }
66 );
18788bf2 67 return $rs;
78af1010 68 };
4b3ab474 69
ddc0a6c8 70 my $meth_name = join '::', $class, $meth;
71 *$meth_name = Sub::Name::subname $meth_name, sub {
18788bf2 72 my $self = shift;
73 my $rs = $self->$rs_meth( @_ );
74 return (wantarray ? $rs->all : $rs);
75 };
76
ddc0a6c8 77 my $add_meth_name = join '::', $class, $add_meth;
78 *$add_meth_name = Sub::Name::subname $add_meth_name, sub {
303cf522 79 my $self = shift;
80 @_ > 0 or $self->throw_exception(
b3f358b5 81 "${add_meth} needs an object or hashref"
303cf522 82 );
83 my $source = $self->result_source;
84 my $schema = $source->schema;
85 my $rel_source_name = $source->relationship_info($rel)->{source};
86 my $rel_source = $schema->resultset($rel_source_name)->result_source;
87 my $f_rel_source_name = $rel_source->relationship_info($f_rel)->{source};
78060df8 88 my $f_rel_rs = $schema->resultset($f_rel_source_name)->search({}, $rel_attrs||{});
89
90 my $obj;
91 if (ref $_[0]) {
92 if (ref $_[0] eq 'HASH') {
577ef680 93 $obj = $f_rel_rs->find_or_create($_[0]);
78060df8 94 } else {
95 $obj = $_[0];
96 }
97 } else {
577ef680 98 $obj = $f_rel_rs->find_or_create({@_});
78060df8 99 }
100
3bd6e3e0 101 my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {};
6cc5b382 102 my $link = $self->search_related($rel)->new_result($link_vals);
303cf522 103 $link->set_from_related($f_rel, $obj);
104 $link->insert();
716c16a0 105 return $obj;
4b3ab474 106 };
107
ddc0a6c8 108 my $set_meth_name = join '::', $class, $set_meth;
109 *$set_meth_name = Sub::Name::subname $set_meth_name, sub {
b3f358b5 110 my $self = shift;
111 @_ > 0 or $self->throw_exception(
112 "{$set_meth} needs a list of objects or hashrefs"
113 );
f72f9361 114 my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_);
f1f9ee17 115 # if there is a where clause in the attributes, ensure we only delete
116 # rows that are within the where restriction
117 if ($rel_attrs && $rel_attrs->{where}) {
118 $self->search_related( $rel, $rel_attrs->{where},{join => $f_rel})->delete;
119 } else {
120 $self->search_related( $rel, {} )->delete;
121 }
122 # add in the set rel objects
ac36a402 123 $self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set);
b3f358b5 124 };
125
ddc0a6c8 126 my $remove_meth_name = join '::', $class, $remove_meth;
127 *$remove_meth_name = Sub::Name::subname $remove_meth_name, sub {
303cf522 128 my $self = shift;
129 @_ > 0 && ref $_[0] ne 'HASH'
b3f358b5 130 or $self->throw_exception("${remove_meth} needs an object");
303cf522 131 my $obj = shift;
132 my $rel_source = $self->search_related($rel)->result_source;
133 my $cond = $rel_source->relationship_info($f_rel)->{cond};
6d0ee587 134 my $link_cond = $rel_source->_resolve_condition(
303cf522 135 $cond, $obj, $f_rel
136 );
137 $self->search_related($rel, $link_cond)->delete;
4b3ab474 138 };
139
8973b6f1 140 }
141}
142
1431;