implemented -cleanee option plus an external callable remove_subroutines class method...

diff --git a/Changes b/Changes
index 9eb54a7..06cffc3 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+    [0.11] ...
+        - Added -cleanee option to specify the package to clean.
+
     [0.10] Fri Feb 20 14:31:36 CET 2009
         - Depend on B::Hooks::EndOfScope 0.07 to avoid segfaults and lost error
           messages when something goes wrong.

diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm
index 5bd0b9a..93ecb9f 100644 (file)
--- a/lib/namespace/clean.pm
+++ b/lib/namespace/clean.pm
@@ -15,11 +15,11 @@ use B::Hooks::EndOfScope;
 
 =head1 VERSION
 
-0.10
+0.11
 
 =cut
 
-$VERSION         = '0.10';
+$VERSION         = '0.11';
 $STORAGE_VAR     = '__NAMESPACE_CLEAN_STORAGE';
 
 =head1 SYNOPSIS
@@ -114,6 +114,27 @@ the installed C<meta> method. So your classes should look like:
 
 Same goes for L<Moose::Role>.
 
+=head2 Cleaning other packages
+
+You can tell C<namespace::clean> that you want to clean up another package
+instead of the one importing. To do this you have to pass in the C<-cleanee>
+option like this:
+
+  package My::MooseX::namespace::clean;
+  use strict;
+
+  use namespace::clean (); # no cleanup, just load
+
+  sub import {
+      namespace::clean->import(
+        -cleanee => scalar(caller),
+        -except  => 'meta',
+      );
+  }
+
+If you don't care about C<namespace::clean>s discover-and-C<-except> logic, and
+just want to remove subroutines, try L</clean_subroutines>.
+
 =head1 METHODS
 
 You shouldn't need to call any of these. Just C<use> the package at the
@@ -121,14 +142,21 @@ appropriate place.
 
 =cut
 
-=head2 import
+=head2 clean_subroutines
 
-Makes a snapshot of the current defined functions and installs a
-L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
+This exposes the actual subroutine-removal logic.
+
+  namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
+
+will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
+subroutines B<immediately> and not wait for scope end. If you want to have this
+effect at a specific time (e.g. C<namespace::clean> acts on scope compile end)
+it is your responsibility to make sure it runs at that time.
 
 =cut
 
 my $RemoveSubs = sub {
+
     my $cleanee = shift;
     my $store   = shift;
   SYMBOL:
@@ -153,19 +181,38 @@ my $RemoveSubs = sub {
     }
 };
 
+sub clean_subroutines {
+    my ($nc, $cleanee, @subs) = @_;
+    $RemoveSubs->($cleanee, {}, @subs);
+}
+
+=head2 import
+
+Makes a snapshot of the current defined functions and installs a
+L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
+
+=cut
+
 sub import {
     my ($pragma, @args) = @_;
 
     my (%args, $is_explicit);
-    if (@args and $args[0] =~ /^\-/) {
-        %args = @args;
-        @args = ();
-    }
-    elsif (@args) {
-        $is_explicit++;
+
+  ARG:
+    while (@args) {
+
+        if ($args[0] =~ /^\-/) {
+            my $key = shift @args;
+            my $value = shift @args;
+            $args{ $key } = $value;
+        }
+        else {
+            $is_explicit++;
+            last ARG;
+        }
     }
 
-    my $cleanee = caller;
+    my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
     if ($is_explicit) {
         on_scope_end {
             $RemoveSubs->($cleanee, {}, @args);
@@ -215,10 +262,10 @@ It will start a new section of code that defines functions to clean up.
 =cut
 
 sub unimport {
-    my ($pragma) = @_;
+    my ($pragma, %args) = @_;
 
     # the calling class, the current functions and our storage
-    my $cleanee   = caller;
+    my $cleanee   = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
     my $functions = $pragma->get_functions($cleanee);
     my $store     = $pragma->get_class_store($cleanee);
 

diff --git a/t/05-explicit-cleanee.t b/t/05-explicit-cleanee.t
new file mode 100644 (file)
index 0000000..3556a5d
--- /dev/null
+++ b/t/05-explicit-cleanee.t
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 19;
+
+use_ok('CleaneeTarget');
+
+ok  CleaneeTarget->can('IGNORED'),  'symbol in exception list still there';
+ok  CleaneeTarget->can('NOTAWAY'),  'symbol after import call still there';
+ok !CleaneeTarget->can('AWAY'),     'normal symbol has disappeared';
+
+ok !CleaneeTarget->can('x_foo'),    'explicitely removed disappeared (1/2)';
+ok  CleaneeTarget->can('x_bar'),    'not in explicit removal and still there';
+ok !CleaneeTarget->can('x_baz'),    'explicitely removed disappeared (2/2)';
+
+ok !CleaneeTarget->can('d_foo'),    'directly removed disappeared (1/2)';
+ok  CleaneeTarget->can('d_bar'),    'not in direct removal and still there';
+ok !CleaneeTarget->can('d_baz'),    'directly removed disappeared (2/2)';
+
+my @values = qw( 23 27 17 XFOO XBAR XBAZ 7 8 9 );
+is(CleaneeTarget->summary->[ $_ ], $values[ $_ ], sprintf('testing sub in cleanee (%d/%d)', $_ + 1, scalar @values))
+    for 0 .. $#values;

diff --git a/t/lib/CleaneeBridge.pm b/t/lib/CleaneeBridge.pm
new file mode 100644 (file)
index 0000000..2e4c5b6
--- /dev/null
+++ b/t/lib/CleaneeBridge.pm
@@ -0,0 +1,14 @@
+package CleaneeBridge;
+use strict;
+use warnings;
+
+use namespace::clean ();
+
+sub import {
+    namespace::clean->import(
+        -cleanee => scalar(caller),
+        -except  => 'IGNORED',
+    );
+}
+
+1;

diff --git a/t/lib/CleaneeBridgeDirect.pm b/t/lib/CleaneeBridgeDirect.pm
new file mode 100644 (file)
index 0000000..221ec7a
--- /dev/null
+++ b/t/lib/CleaneeBridgeDirect.pm
@@ -0,0 +1,10 @@
+package CleaneeBridgeDirect;
+use strict;
+
+use namespace::clean ();
+
+sub import {
+    namespace::clean->clean_subroutines(scalar(caller), qw( d_foo d_baz ));
+}
+
+1;

diff --git a/t/lib/CleaneeBridgeExplicit.pm b/t/lib/CleaneeBridgeExplicit.pm
new file mode 100644 (file)
index 0000000..efb3b50
--- /dev/null
+++ b/t/lib/CleaneeBridgeExplicit.pm
@@ -0,0 +1,14 @@
+package CleaneeBridgeExplicit;
+use strict;
+use warnings;
+
+use namespace::clean ();
+
+sub import {
+    namespace::clean->import(
+        -cleanee => scalar(caller),
+        qw( x_foo x_baz ),
+    );
+}
+
+1;

diff --git a/t/lib/CleaneeTarget.pm b/t/lib/CleaneeTarget.pm
new file mode 100644 (file)
index 0000000..0a9e9f8
--- /dev/null
+++ b/t/lib/CleaneeTarget.pm
@@ -0,0 +1,26 @@
+package CleaneeTarget;
+use strict;
+use warnings;
+
+sub AWAY    { 23 };
+sub IGNORED { 27 };
+
+use CleaneeBridge;
+
+sub NOTAWAY { 17 };
+
+sub x_foo { 'XFOO' }
+sub x_bar { 'XBAR' }
+sub x_baz { 'XBAZ' }
+
+use CleaneeBridgeExplicit;
+
+sub d_foo { 7 }
+sub d_bar { 8 }
+sub d_baz { 9 }
+
+sub summary { [AWAY, IGNORED, NOTAWAY, x_foo, x_bar, x_baz, d_foo, d_bar, d_baz] }
+
+use CleaneeBridgeDirect;
+
+1;