X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FManyToMany.pm;h=a0edd92b1878661eeec23ed5655f3493c2cb0f03;hb=d2d82857c6643eee65dd3642f0109c064766c90a;hp=d0fdd0cee499b694f8fb5ad1560ba2c3b302ad1d;hpb=35678f0bd09cba7d69e6dd0ed75850bf6f6fbccc;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm index d0fdd0c..a0edd92 100644 --- a/lib/DBIx/Class/Relationship/ManyToMany.pm +++ b/lib/DBIx/Class/Relationship/ManyToMany.pm @@ -3,7 +3,8 @@ package # hide from PAUSE use strict; use warnings; -use warnings::register; + +use Carp::Clan qw/^DBIx::Class/; use Sub::Name (); sub many_to_many { @@ -27,18 +28,25 @@ sub many_to_many { my $rs_meth = "${meth}_rs"; for ($add_meth, $remove_meth, $set_meth, $rs_meth) { - warnings::warn(<<"EOW") + if ( $class->can ($_) ) { + carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK}; + *************************************************************************** -The many-to-many relationship $meth is trying to create a utility method called -$_. This will overwrite the existing method on $class. You almost certainly -want to rename your method or the many-to-many relationship, as your method -will not be callable (it will use the one from the relationship instead.) +The many-to-many relationship '$meth' is trying to create a utility method +called $_. +This will completely overwrite one such already existing method on class +$class. + +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 to a true value the environment variable +DBIC_OVERWRITE_HELPER_METHODS_OK -no warnings 'DBIx::Class::Relationship::ManyToMany'; in -$class to disable. *************************************************************************** EOW - if warnings::enabled() && $class->can($_); + } } $rel_attrs->{alias} ||= $f_rel; @@ -77,12 +85,12 @@ 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(@_) : {}; @@ -99,8 +107,8 @@ EOW "{$set_meth} needs a list of objects or hashrefs" ); my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_); - $self->search_related($rel, {})->delete; - $self->$add_meth($_) for (@to_set); + $self->search_related( $rel, ($rel_attrs||{})->{where},($rel_attrs||{})->{where}?{join => $f_rel}:{} )->delete; + $self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set); }; my $remove_meth_name = join '::', $class, $remove_meth; @@ -111,7 +119,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;