X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FManyToMany.pm;h=137fb301f1597d62d41dec1f794fb1d2520be595;hb=a6b68a60b376e918a6058f37cb1115ba3163a59b;hp=f06b9d54e8f08869c3443e1aa502ba99ea97e429;hpb=b234e9d9a6148c8e4879954cb1de7476a437edb6;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm index f06b9d5..137fb30 100644 --- a/lib/DBIx/Class/Relationship/ManyToMany.pm +++ b/lib/DBIx/Class/Relationship/ManyToMany.pm @@ -7,6 +7,11 @@ use warnings; use Carp::Clan qw/^DBIx::Class/; use Sub::Name (); +our %_pod_inherit_config = + ( + class_map => { 'DBIx::Class::Relationship::ManyToMany' => 'DBIx::Class::Relationship' } + ); + sub many_to_many { my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_; @@ -29,7 +34,7 @@ sub many_to_many { for ($add_meth, $remove_meth, $set_meth, $rs_meth) { if ( $class->can ($_) ) { - carp (<<"EOW") unless $ENV{DBIC_METHOD_CLOBBER_OK}; + carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK}; *************************************************************************** The many-to-many relationship '$meth' is trying to create a utility method @@ -41,8 +46,8 @@ You almost certainly want to rename your method or the many-to-many relationship, as the functionality of the original method will not be accessible anymore. -To disable this warning set the environment variable DBIC_METHOD_CLOBBER_OK -to a true value +To disable this warning set to a true value the environment variable +DBIC_OVERWRITE_HELPER_METHODS_OK *************************************************************************** EOW @@ -59,15 +64,15 @@ EOW my $rs = $self->search_related($rel)->search_related( $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs } ); - return $rs; + return $rs; }; my $meth_name = join '::', $class, $meth; *$meth_name = Sub::Name::subname $meth_name, sub { - my $self = shift; - my $rs = $self->$rs_meth( @_ ); - return (wantarray ? $rs->all : $rs); - }; + my $self = shift; + my $rs = $self->$rs_meth( @_ ); + return (wantarray ? $rs->all : $rs); + }; my $add_meth_name = join '::', $class, $add_meth; *$add_meth_name = Sub::Name::subname $add_meth_name, sub { @@ -85,19 +90,19 @@ EOW my $obj; if (ref $_[0]) { if (ref $_[0] eq 'HASH') { - $obj = $f_rel_rs->create($_[0]); + $obj = $f_rel_rs->find_or_create($_[0]); } else { $obj = $_[0]; } } else { - $obj = $f_rel_rs->create({@_}); + $obj = $f_rel_rs->find_or_create({@_}); } my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; my $link = $self->search_related($rel)->new_result($link_vals); $link->set_from_related($f_rel, $obj); $link->insert(); - return $obj; + return $obj; }; my $set_meth_name = join '::', $class, $set_meth; @@ -107,7 +112,14 @@ EOW "{$set_meth} needs a list of objects or hashrefs" ); my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_); - $self->search_related($rel, {})->delete; + # if there is a where clause in the attributes, ensure we only delete + # rows that are within the where restriction + if ($rel_attrs && $rel_attrs->{where}) { + $self->search_related( $rel, $rel_attrs->{where},{join => $f_rel})->delete; + } else { + $self->search_related( $rel, {} )->delete; + } + # add in the set rel objects $self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set); }; @@ -119,7 +131,7 @@ EOW my $obj = shift; my $rel_source = $self->search_related($rel)->result_source; my $cond = $rel_source->relationship_info($f_rel)->{cond}; - my $link_cond = $rel_source->resolve_condition( + my $link_cond = $rel_source->_resolve_condition( $cond, $obj, $f_rel ); $self->search_related($rel, $link_cond)->delete;