Only ask for debugger bits when debugger detected

[p5sagit/namespace-clean.git] / lib / namespace / clean.pm

diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm
index 156bde0..f02bece 100644 (file)
--- a/lib/namespace/clean.pm
+++ b/lib/namespace/clean.pm
@@ -5,9 +5,7 @@ use warnings;
 use strict;
 
 use vars qw( $STORAGE_VAR );
-use Sub::Name 0.04 qw(subname);
-use Sub::Identify 0.04 qw(sub_fullname);
-use Package::Stash 0.03;
+use Package::Stash 0.22;
 use B::Hooks::EndOfScope 0.07;
 
 $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
@@ -138,35 +136,69 @@ it is your responsibility to make sure it runs at that time.
 
 =cut
 
-my $RemoveSubs = sub {
+my $sub_utils_loaded;
+my $DebuggerRename = sub {
+  my ($f, $sub, $cleanee_stash, $deleted_stash) = @_;
+
+  if (! defined $sub_utils_loaded ) {
+    $sub_utils_loaded = do {
+      my $sn_ver = 0.04;
+      eval { require Sub::Name; Sub::Name->VERSION($sn_ver) }
+        or die "Sub::Name $sn_ver required when running under -d or equivalent: $@";
 
+      my $si_ver = 0.04;
+      eval { require Sub::Identify; Sub::Identify->VERSION($si_ver) }
+        or die "Sub::Identify $si_ver required when running under -d or equivalent: $@";
+
+      1;
+    } ? 1 : 0;
+  }
+
+  if ( Sub::Identify::sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) {
+    my $new_fq = $deleted_stash->name . "::$f";
+    Sub::Name::subname($new_fq, $sub);
+    $deleted_stash->add_symbol("&$f", $sub);
+  }
+};
+
+my $RemoveSubs = sub {
     my $cleanee = shift;
     my $store   = shift;
     my $cleanee_stash = Package::Stash->new($cleanee);
-    my $deleted_stash = Package::Stash->new("namespace::clean::deleted::$cleanee");
+    my $deleted_stash;
+
   SYMBOL:
     for my $f (@_) {
-        my $variable = "&$f";
+
         # ignore already removed symbols
         next SYMBOL if $store->{exclude}{ $f };
 
-        next SYMBOL unless $cleanee_stash->has_package_symbol($variable);
+        my $sub = $cleanee_stash->get_symbol("&$f")
+          or next SYMBOL;
 
-        if (ref(\$cleanee_stash->namespace->{$f}) eq 'GLOB') {
+        if ($^P and ref(\$cleanee_stash->namespace->{$f}) eq 'GLOB') {
             # convince the Perl debugger to work
             # it assumes that sub_fullname($sub) can always be used to find the CV again
             # since we are deleting the glob where the subroutine was originally
             # defined, that assumption no longer holds, so we need to move it
             # elsewhere and point the CV's name to the new glob.
-            my $sub = $cleanee_stash->get_package_symbol($variable);
-            if ( sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) {
-                my $new_fq = $deleted_stash->name . "::$f";
-                subname($new_fq, $sub);
-                $deleted_stash->add_package_symbol($variable, $sub);
-            }
+            $DebuggerRename->(
+              $f,
+              $sub,
+              $cleanee_stash,
+              $deleted_stash ||= Package::Stash->new("namespace::clean::deleted::$cleanee"),
+            );
         }
 
-        $cleanee_stash->remove_package_symbol($variable);
+        my @symbols = map {
+            my $name = $_ . $f;
+            my $def = $cleanee_stash->get_symbol($name);
+            defined($def) ? [$name, $def] : ()
+        } '$', '@', '%', '';
+
+        $cleanee_stash->remove_glob($f);
+
+        $cleanee_stash->add_symbol(@$_) for @symbols;
     }
 };
 
@@ -224,7 +256,7 @@ sub import {
         # register symbols for removal, if they have a CODE entry
         for my $f (keys %$functions) {
             next if     $except{ $f };
-            next unless $stash->has_package_symbol("&$f");
+            next unless $stash->has_symbol("&$f");
             $store->{remove}{ $f } = 1;
         }
 
@@ -279,9 +311,9 @@ sub get_class_store {
     my ($pragma, $class) = @_;
     my $stash = Package::Stash->new($class);
     my $var = "%$STORAGE_VAR";
-    $stash->add_package_symbol($var, {})
-        unless $stash->has_package_symbol($var);
-    return $stash->get_package_symbol($var);
+    $stash->add_symbol($var, {})
+        unless $stash->has_symbol($var);
+    return $stash->get_symbol($var);
 }
 
 =method get_functions
@@ -297,8 +329,8 @@ sub get_functions {
 
     my $stash = Package::Stash->new($class);
     return {
-        map { $_ => $stash->get_package_symbol("&$_") }
-            $stash->list_all_package_symbols('CODE')
+        map { $_ => $stash->get_symbol("&$_") }
+            $stash->list_all_symbols('CODE')
     };
 }