From: Ash Berlin Date: Wed, 3 Dec 2008 17:23:00 +0000 (+0000) Subject: Make the many-to-many warning use warnings::register; X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=35678f0bd09cba7d69e6dd0ed75850bf6f6fbccc;p=dbsrgits%2FDBIx-Class-Historic.git Make the many-to-many warning use warnings::register; --- diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm index 76042c0..d0fdd0c 100644 --- a/lib/DBIx/Class/Relationship/ManyToMany.pm +++ b/lib/DBIx/Class/Relationship/ManyToMany.pm @@ -3,6 +3,7 @@ package # hide from PAUSE use strict; use warnings; +use warnings::register; use Sub::Name (); sub many_to_many { @@ -26,10 +27,18 @@ sub many_to_many { 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($_); + warnings::warn(<<"EOW") +*************************************************************************** +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.) + +no warnings 'DBIx::Class::Relationship::ManyToMany'; in +$class to disable. +*************************************************************************** +EOW + if warnings::enabled() && $class->can($_); } $rel_attrs->{alias} ||= $f_rel; diff --git a/t/103many_to_many_warning.t b/t/103many_to_many_warning.t new file mode 100644 index 0000000..ff48590 --- /dev/null +++ b/t/103many_to_many_warning.t @@ -0,0 +1,91 @@ +use strict; +use warnings; +use Test::More; + +use lib qw(t/lib); + + +our $no_warn = ""; + +plan tests => 2; +{ + local $@; + local $SIG{__WARN__} = sub { die @_ }; + eval "@{[code()]}"; + ok($@, "Warning triggered without relevant 'no warnings'"); +} + +{ + # Clean up the packages + delete $INC{'DBICTest/ManyToManyWarning.pm'}; + delete $DBICTest::{"Schema::"}; + + $no_warn = "no warnings 'DBIx::Class::Relationship::ManyToMany';"; + local $SIG{__WARN__} = sub { die @_ }; + eval "@{[code()]}"; + ok(!$@, "No Warning triggered with relevant 'no warnings'"); +} + +sub code { +my $file = << "EOF"; +use strict; +use warnings; + +{ + package # + DBICTest::Schema::Foo; + use base 'DBIx::Class::Core'; + __PACKAGE__->table('foo'); + __PACKAGE__->add_columns( + 'fooid' => { + data_type => 'integer', + is_auto_increment => 1, + }, + ); + __PACKAGE__->set_primary_key('fooid'); + + + __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar' => 'bar'); + __PACKAGE__->many_to_many( foos => foo_to_bar => 'bar' ); + +} +{ + package # + DBICTest::Schema::FooToBar; + + use base 'DBIx::Class::Core'; + __PACKAGE__->table('foo_to_bar'); + __PACKAGE__->add_columns( + 'foo' => { + data_type => 'integer', + }, + 'bar' => { + data_type => 'integer', + }, + ); + __PACKAGE__->belongs_to('foo' => 'DBICTest::Schema::Foo'); + __PACKAGE__->belongs_to('bar' => 'DBICTest::Schema::Foo'); +} +{ + package # + DBICTest::Schema::Bar; + use base 'DBIx::Class::Core'; + __PACKAGE__->table('bar'); + __PACKAGE__->add_columns( + 'barid' => { + data_type => 'integer', + is_auto_increment => 1, + }, + ); + + use DBIx::Class::Relationship::ManyToMany; + $main::no_warn + __PACKAGE__->set_primary_key('barid'); + __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar' => 'foo'); + __PACKAGE__->many_to_many( bars => foo_to_bar => 'foo' ); + + sub add_to_bars {} +} +EOF + return $file; +}