1 package # hide from PAUSE
2 DBIx::Class::Relationship::ManyToMany;
8 use DBIx::Class::_Util qw(fail_on_internal_wantarray quote_sub);
10 # FIXME - this souldn't be needed
12 BEGIN { $cu = \&carp_unique }
16 our %_pod_inherit_config =
18 class_map => { 'DBIx::Class::Relationship::ManyToMany' => 'DBIx::Class::Relationship' }
22 my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_;
24 $class->throw_exception(
25 "missing relation in many-to-many"
28 $class->throw_exception(
29 "missing foreign relation in many-to-many"
32 my $add_meth = "add_to_${meth}";
33 my $remove_meth = "remove_from_${meth}";
34 my $set_meth = "set_${meth}";
35 my $rs_meth = "${meth}_rs";
37 for ($add_meth, $remove_meth, $set_meth, $rs_meth) {
38 if ( $class->can ($_) ) {
39 carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK};
41 ***************************************************************************
42 The many-to-many relationship '$meth' is trying to create a utility method
44 This will completely overwrite one such already existing method on class
47 You almost certainly want to rename your method or the many-to-many
48 relationship, as the functionality of the original method will not be
51 To disable this warning set to a true value the environment variable
52 DBIC_OVERWRITE_HELPER_METHODS_OK
54 ***************************************************************************
60 '$rel_attrs' => \{ alias => $f_rel, %{ $rel_attrs||{} } },
61 '$carp_unique' => \$cu,
64 quote_sub "${class}::${rs_meth}", sprintf( <<'EOC', $rel, $f_rel ), $qsub_attrs;
66 # this little horror is there replicating a deprecation from
67 # within search_rs() itself
68 shift->related_resultset( q{%1$s} )
69 ->related_resultset( q{%2$s} )
72 ( @_ > 1 and ref $_[-1] eq 'HASH' )
73 ? { %%$rel_attrs, %%{ pop @_ } }
80 quote_sub "${class}::${meth}", sprintf( <<'EOC', $rs_meth );
82 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = DBIx::Class::_Util::fail_on_internal_wantarray;
84 my $rs = shift->%s( @_ );
86 wantarray ? $rs->all : $rs;
90 quote_sub "${class}::${add_meth}", sprintf( <<'EOC', $add_meth, $rel, $f_rel ), $qsub_attrs;
92 ( @_ >= 2 and @_ <= 3 ) or $_[0]->throw_exception(
93 "'%1$s' expects an object or hashref to link to, and an optional hashref of link data"
96 $_[0]->throw_exception(
97 "The optional link data supplied to '%1$s' is not a hashref (it was previously ignored)"
98 ) if $_[2] and ref $_[2] ne 'HASH';
100 my( $self, $far_obj ) = @_;
104 # the API needs is always expected to return the far object, possibly
105 # creating it in the process
106 if( not defined Scalar::Util::blessed( $far_obj ) ) {
108 $guard = $self->result_source->schema->storage->txn_scope_guard;
110 # reify the hash into an actual object
111 $far_obj = $self->result_source
112 ->related_source( q{%2$s} )
113 ->related_source( q{%3$s} )
115 ->search_rs( undef, $rel_attrs )
116 ->find_or_create( $far_obj );
119 my $link = $self->new_related(
124 $link->set_from_related( q{%3$s}, $far_obj );
128 $guard->commit if $guard;
134 quote_sub "${class}::${set_meth}", sprintf( <<'EOC', $set_meth, $add_meth, $rel, $f_rel ), $qsub_attrs;
138 my $set_to = ( ref $_[0] eq 'ARRAY' )
142 "Calling '%1$s' with a list of items to link to is deprecated, use an arrayref instead"
145 # gobble up everything from @_ into a new arrayref
150 # make sure folks are not invoking a bizarre mix of deprecated and curent syntax
151 $self->throw_exception(
152 "'%1$s' expects an arrayref of objects or hashrefs to link to, and an optional hashref of link data"
156 ( @_ and ref $_[0] ne 'HASH' )
161 # there will only be a single delete() op, unless we have what to set to
162 $guard = $self->result_source->schema->storage->txn_scope_guard
165 # if there is a where clause in the attributes, ensure we only delete
166 # rows that are within the where restriction
167 $self->related_resultset( q{%3$s} )
169 ( $rel_attrs->{where}
170 ? ( $rel_attrs->{where}, { join => q{%4$s} } )
175 # add in the set rel objects
178 @_, # at this point @_ is either empty or contains a lone link-data hash
181 $guard->commit if $guard;
185 quote_sub "${class}::${remove_meth}", sprintf( <<'EOC', $remove_meth, $rel, $f_rel );
187 $_[0]->throw_exception("'%1$s' expects an object")
188 unless defined Scalar::Util::blessed( $_[1] );
190 $_[0]->related_resultset( q{%2$s} )
191 ->search_rs( $_[1]->ident_condition( q{%3$s} ), { join => q{%3$s} } )