X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FManyToMany.pm;h=451e43501b18ba99678e0b1685f00f6c64dd9455;hb=434ffe5f4cd4d2bfb6cadb6c6100096ecdadbb60;hp=e294a8cc6ad964bdd3d5a8942e45bf3416d53aca;hpb=f72f9361dabf3ea6d0a7becb6166319c778dcf4f;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm index e294a8c..451e435 100644 --- a/lib/DBIx/Class/Relationship/ManyToMany.pm +++ b/lib/DBIx/Class/Relationship/ManyToMany.pm @@ -6,6 +6,15 @@ use warnings; sub many_to_many { my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_; + + $class->throw_exception( + "missing relation in many-to-many" + ) unless $rel; + + $class->throw_exception( + "missing foreign relation in many-to-many" + ) unless $f_rel; + { no strict 'refs'; no warnings 'redefine'; @@ -13,18 +22,33 @@ sub many_to_many { my $add_meth = "add_to_${meth}"; my $remove_meth = "remove_from_${meth}"; my $set_meth = "set_${meth}"; + my $rs_meth = "${meth}_rs"; + + for ($add_meth, $remove_meth, $set_meth, $rs_meth) { + warn "***************************************************************************\n". + "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.) YOU HAVE BEEN WARNED\n". + "***************************************************************************\n" + if $class->can($_); + } $rel_attrs->{alias} ||= $f_rel; - *{"${class}::${meth}"} = sub { + *{"${class}::${meth}_rs"} = sub { my $self = shift; my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; my @args = ($f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs }); - $self->search_related($rel)->search_related( + my $rs = $self->search_related($rel)->search_related( $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs } ); + return $rs; }; + *{"${class}::${meth}"} = sub { + my $self = shift; + my $rs = $self->$rs_meth( @_ ); + return (wantarray ? $rs->all : $rs); + }; + *{"${class}::${add_meth}"} = sub { my $self = shift; @_ > 0 or $self->throw_exception( @@ -49,10 +73,10 @@ sub many_to_many { } my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; - my $link = $self->search_related($rel)->new_result({}); + my $link = $self->search_related($rel)->new_result($link_vals); $link->set_from_related($f_rel, $obj); - $link->set_columns($link_vals); $link->insert(); + return $obj; }; *{"${class}::${set_meth}"} = sub {