From: Yuval Kogman <nothingmuch@woobling.org>
Date: Thu, 17 Sep 2009 20:42:50 +0000 (+0300)
Subject: Add warn_on_symbol_pollution to Class::MOP::Class
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1f46d41ee9352dd140bcc1acb396145c7ce9f77a;p=gitmo%2FClass-MOP.git

Add warn_on_symbol_pollution to Class::MOP::Class

Checks that there are no non method CODE symbols in the package of the
class.
---

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 7892636..7d7561a 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -902,6 +902,30 @@ sub _immutable_options {
     );
 }
 
+sub list_non_method_package_symbols {
+    my $self = shift;
+
+    my %method_names = map { $_ => 1 } $self->get_all_method_names;
+
+    # this is injected for classes that use overloading
+    $method_names{'()'} = 1;
+
+    my @all_symbols = $self->list_all_package_symbols("CODE");
+
+    return grep { not exists $method_names{$_} } @all_symbols;
+}
+
+sub warn_on_symbol_pollution {
+    my $self = shift;
+
+    if ( my @pollution = $self->list_non_method_package_symbols ) {
+        Carp::carp( "Polluting symbols found in "
+              . $self->name . ": "
+              . join( ", ", @pollution )
+              . ". Consider unimporting or using namespace::autoclean" );
+    }
+}
+
 sub make_immutable {
     my ( $self, @args ) = @_;
 
@@ -1524,6 +1548,15 @@ of the inlining features than Class::MOP itself does.
 
 =over 4
 
+=item B<< $metaclass->list_non_method_package_symbols >>
+
+Compares the list of all C<CODE> symbols to the output of
+C<get_all_method_names> and returns the non method ones.
+
+=item B<< $metaclass->warn_on_symbol_pollution >>
+
+Issues a warning if C<list_non_method_package_symbols> returns anything.
+
 =item B<< $metaclass->make_immutable(%options) >>
 
 This method will create an immutable transformer and use it to make
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 5d891d5..adcfef0 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 304;
+use Test::More tests => 308;
 use Test::Exception;
 
 use Class::MOP;
@@ -102,6 +102,8 @@ my @class_mop_class_methods = qw(
     immutable_trait immutable_options
     constructor_name constructor_class destructor_class
 
+    list_non_method_package_symbols warn_on_symbol_pollution
+
     DESTROY
 );
 
diff --git a/t/316_pollution_warning.t b/t/316_pollution_warning.t
new file mode 100644
index 0000000..3d0213c
--- /dev/null
+++ b/t/316_pollution_warning.t
@@ -0,0 +1,36 @@
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+{
+    package Foo;
+    use metaclass;
+
+    use Scalar::Util qw(blessed);
+
+    no warnings 'once';
+    *a_glob_assignment = \&Scalar::Util::blessed;
+
+    sub a_declared_method { }
+
+    Class::MOP::Class->initialize(__PACKAGE__)->add_method("an_added_method" => sub {});
+}
+
+my @warnings;
+
+{
+    local $SIG{__WARN__} = sub { push @warnings, $_[0] };
+    Class::MOP::Class->initialize("Foo")->warn_on_symbol_pollution();
+}
+
+is( scalar(@warnings), 1, "warning generated" );
+
+my $warning = $warnings[0];
+
+like( $warning, qr/blessed/, "mentions import" );
+like( $warning, qr/a_glob_assignment/, "mentions glob assignment" );
+unlike( $warning, qr/a_declared_method/, "doesn't mention normal method" );
+unlike( $warning, qr/an_added_method/, "doesn't mention a manually installed method" );
+
+