From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sun, 10 May 2009 19:35:03 +0000 (+0000)
Subject: Switch the m2m method warnings from warnings::register to $ENV{DBIC_METHOD_CLOBBER_OK... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b234e9d9a6148c8e4879954cb1de7476a437edb6;p=dbsrgits%2FDBIx-Class-Historic.git

Switch the m2m method warnings from warnings::register to $ENV{DBIC_METHOD_CLOBBER_OK} = 1
---

diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm
index a99f7d5..f06b9d5 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 {
@@ -28,16 +29,20 @@ sub many_to_many {
 
     for ($add_meth, $remove_meth, $set_meth, $rs_meth) {
       if ( $class->can ($_) ) {
-        warnings::warnif(<<"EOW")
+        carp (<<"EOW") unless $ENV{DBIC_METHOD_CLOBBER_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.
 
-To disable this warning add the following to $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.
 
-  no warnings 'DBIx::Class::Relationship::ManyToMany';
+To disable this warning set the environment variable DBIC_METHOD_CLOBBER_OK
+to a true value
 
 ***************************************************************************
 EOW
diff --git a/t/103many_to_many_warning.t b/t/103many_to_many_warning.t
index a8f790a..06ac61e 100644
--- a/t/103many_to_many_warning.t
+++ b/t/103many_to_many_warning.t
@@ -5,42 +5,38 @@ use Test::More;
 use lib qw(t/lib);
 use Data::Dumper;
 
-plan ( ($] >= 5.009000 and $] < 5.010001)
-  ? (skip_all => 'warnings::register broken under 5.10: http://rt.perl.org/rt3/Public/Bug/Display.html?id=62522')
-  : (tests => 4)
-);
+plan tests => 4;
+my $exp_warn = qr/The many-to-many relationship 'bars' is trying to create/;
 
 {
   my @w; 
-  local $SIG{__WARN__} = sub { push @w, @_ };
+  local $SIG{__WARN__} = sub { $_[0] =~ $exp_warn ? push @w, $_[0] : warn $_[0] };
   my $code = gen_code ( suffix => 1 );
   eval "$code";
   ok (! $@, 'Eval code without warnings suppression')
     || diag $@;
 
-  ok ( (grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "Warning triggered without relevant 'no warnings'");
+  ok (@w, "Warning triggered without DBIC_METHOD_CLOBBER_OK");
 }
 
 {
   my @w; 
-  local $SIG{__WARN__} = sub { push @w, @_ };
+  local $SIG{__WARN__} = sub { $_[0] =~ $exp_warn ? push @w, $_[0] : warn $_[0] };
 
-  my $code = gen_code ( suffix => 2, no_warn => 1 );
+  my $code = gen_code ( suffix => 2 );
+
+  local $ENV{DBIC_METHOD_CLOBBER_OK} = 1;
   eval "$code";
   ok (! $@, 'Eval code with warnings suppression')
     || diag $@;
 
-  ok ( (not grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "No warning triggered with relevant 'no warnings'");
+  ok (! @w, "No warning triggered with DBIC_METHOD_CLOBBER_OK");
 }
 
 sub gen_code {
 
   my $args = { @_ };
   my $suffix = $args->{suffix};
-  my $no_warn = ( $args->{no_warn}
-    ? "no warnings 'DBIx::Class::Relationship::ManyToMany';"
-    : '',
-  );
 
   return <<EOF;
 use strict;
@@ -95,7 +91,6 @@ use warnings;
     },
   );
 
-  ${no_warn}
   __PACKAGE__->set_primary_key('barid');
   __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar${suffix}' => 'foo');