1 package # hide from PAUSE
2 DBIx::Class::Relationship::ManyToMany;
8 use Sub::Name 'subname';
9 use Scalar::Util 'blessed';
10 use DBIx::Class::_Util 'fail_on_internal_wantarray';
13 our %_pod_inherit_config =
15 class_map => { 'DBIx::Class::Relationship::ManyToMany' => 'DBIx::Class::Relationship' }
19 my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_;
21 $class->throw_exception(
22 "missing relation in many-to-many"
25 $class->throw_exception(
26 "missing foreign relation in many-to-many"
31 no warnings 'redefine';
33 my $add_meth = "add_to_${meth}";
34 my $remove_meth = "remove_from_${meth}";
35 my $set_meth = "set_${meth}";
36 my $rs_meth = "${meth}_rs";
38 for ($add_meth, $remove_meth, $set_meth, $rs_meth) {
39 if ( $class->can ($_) ) {
40 carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK};
42 ***************************************************************************
43 The many-to-many relationship '$meth' is trying to create a utility method
45 This will completely overwrite one such already existing method on class
48 You almost certainly want to rename your method or the many-to-many
49 relationship, as the functionality of the original method will not be
52 To disable this warning set to a true value the environment variable
53 DBIC_OVERWRITE_HELPER_METHODS_OK
55 ***************************************************************************
60 $rel_attrs->{alias} ||= $f_rel;
63 my $rs_meth_name = join '::', $class, $rs_meth;
64 *$rs_meth_name = subname $rs_meth_name, sub {
66 # this little horror is there replicating a deprecation from
67 # within search_rs() itself
68 shift->search_related_rs($rel)
72 ( @_ > 1 and ref $_[-1] eq 'HASH' )
73 ? { %$rel_attrs, %{ pop @_ } }
81 my $meth_name = join '::', $class, $meth;
82 *$meth_name = subname $meth_name, sub {
84 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray;
86 my $rs = shift->$rs_meth( @_ );
88 wantarray ? $rs->all : $rs;
93 my $add_meth_name = join '::', $class, $add_meth;
94 *$add_meth_name = subname $add_meth_name, sub {
96 ( @_ >= 2 and @_ <= 3 ) or $_[0]->throw_exception(
97 "'$add_meth' expects an object or hashref to link to, and an optional hashref of link data"
100 $_[0]->throw_exception(
101 "The optional link data supplied to '$add_meth' is not a hashref (it was previously ignored)"
102 ) if $_[2] and ref $_[2] ne 'HASH';
104 my( $self, $far_obj ) = @_;
108 # the API needs is always expected to return the far object, possibly
109 # creating it in the process
110 if( not defined blessed $far_obj ) {
112 $guard = $self->result_source->schema->storage->txn_scope_guard;
114 # reify the hash into an actual object
115 $far_obj = $self->result_source
116 ->related_source( $rel )
117 ->related_source( $f_rel )
119 ->search_rs( undef, $rel_attrs )
120 ->find_or_create( $far_obj );
123 my $link = $self->new_related(
128 $link->set_from_related( $f_rel, $far_obj );
132 $guard->commit if $guard;
138 my $set_meth_name = join '::', $class, $set_meth;
139 *$set_meth_name = subname $set_meth_name, sub {
143 my $set_to = ( ref $_[0] eq 'ARRAY' )
147 "Calling '$set_meth' with a list of items to link to is deprecated, use an arrayref instead"
150 # gobble up everything from @_ into a new arrayref
155 # make sure folks are not invoking a bizarre mix of deprecated and curent syntax
156 $self->throw_exception(
157 "'$set_meth' expects an arrayref of objects or hashrefs to link to, and an optional hashref of link data"
161 ( @_ and ref $_[0] ne 'HASH' )
166 # there will only be a single delete() op, unless we have what to set to
167 $guard = $self->result_source->schema->storage->txn_scope_guard
170 # if there is a where clause in the attributes, ensure we only delete
171 # rows that are within the where restriction
172 $self->search_related(
174 ( $rel_attrs->{where}
175 ? ( $rel_attrs->{where}, { join => $f_rel } )
180 # add in the set rel objects
183 @_, # at this point @_ is either empty or contains a lone link-data hash
186 $guard->commit if $guard;
190 my $remove_meth_name = join '::', $class, $remove_meth;
191 *$remove_meth_name = subname $remove_meth_name, sub {
193 $_[0]->throw_exception("'$remove_meth' expects an object")
194 unless defined blessed $_[1];
196 $_[0]->search_related_rs( $rel )
197 ->search_rs( $_[1]->ident_condition( $f_rel ), { join => $f_rel } )