0.10: add support for restricted stashes and ISAs

classes can be locked and closed. handle all cases.
protect internal core stashes from being deleted.

Changes

@@ -2,6 +2,11 @@ Revision history for Class-Unload
 
 {{$NEXT}}
 
+0.10      2017-02-18 19:17:59 Europe/Berlin
+
+        - Support internal classes, restricted stashes and
+          protected ISA's. (rurban)
+
 0.09      2015-07-03 11:11:32+01:00 Europe/London
 
         - Add META.json and resources metadata (RT#105634)

lib/Class/Unload.pm

@@ -6,6 +6,7 @@ use strict;
 no strict 'refs'; # we're fiddling with the symbol table
 
 use Class::Inspector;
+BEGIN { eval "use Hash::Util"; } # since 5.8.0
 
 =encoding UTF-8
 
@@ -26,23 +27,56 @@ use Class::Inspector;
 Unloads the given class by clearing out its symbol table and removing it
 from %INC.
 
+Avoids unloading internal core classes, like main, CORE, Internals,
+utf8, UNIVERSAL, PerlIO, re.
+
+Handles restricted class (protected stashes) and ISA's.
+
 =cut
 
 sub unload {
     my ($self, $class) = @_;
 
     return unless Class::Inspector->loaded( $class );
 
+    if ($class =~ /^(main|CORE|Internals|utf8|UNIVERSAL|PerlIO|re)$/) {
+        require Carp;
+        Carp::carp("Cannot unload $class");
+        return;
+    }
+
+    my $symtab = $class.'::';
+    my ($was_locked, $was_readonly);
+    if (defined $Hash::Util::VERSION) {
+        if (Hash::Util::hash_locked %{$symtab}) {
+            Hash::Util::unlock_hash %{$symtab};
+            $was_locked++;
+        }
+    }
+    elsif (Internals::SvREADONLY(%{$symtab})) {
+        Internals::SvREADONLY(%{$symtab}, 0);
+        $was_readonly++;
+    }
+
     # Flush inheritance caches
+    if (Internals::SvREADONLY(@{"$class\::ISA"})) {
+        Internals::SvREADONLY(@{"$class\::ISA"}, 0);
+    }
     @{$class . '::ISA'} = ();
 
-    my $symtab = $class.'::';
     # Delete all symbols except other namespaces
     for my $symbol (keys %$symtab) {
         next if $symbol =~ /\A[^:]+::\z/;
         delete $symtab->{$symbol};
     }
 
+    #if ($was_locked) {
+    #    Hash::Util::lock_hash %{$symtab};
+    #}
+    #elsif ($was_readonly) {
+    #    Internals::SvREADONLY(%{$symtab}, 1);
+    #}
+
     my $inc_file = join( '/', split /(?:'|::)/, $class ) . '.pm';
     delete $INC{ $inc_file };
 

t/03-locked.t

@@ -0,0 +1,38 @@
+#!perl -T
+
+use Class::Inspector;
+use Class::Unload;
+use lib 't/lib';
+BEGIN { eval "use Hash::Util"; } # since 5.8.0
+
+use Test::More tests => 12;
+
+for my $class ( qw/ MyClass::Sub::Sub MyClass::Sub MyClass / ) {
+    no strict 'refs';
+    eval "require $class" or diag $@;
+    if (defined $Hash::Util::VERSION) {
+        Hash::Util::lock_keys(%{$class."::"});
+    } else {
+        Internals::SvREADONLY(%{$class."::"}, 1);
+    }
+}
+
+ok( Class::Unload->unload( 'MyClass' ), 'Unloading MyClass' );
+ok( ! Class::Inspector->loaded( 'MyClass' ), 'MyClass is not loaded' );
+ok( ! exists(${'MyClass::'}{'::ISA::CACHE::'}), 'Stash cruft deleted' );
+ok( Class::Inspector->loaded( 'MyClass::Sub' ), 'MyClass::Sub is still loaded' );
+
+ok( Class::Unload->unload( 'MyClass::Sub' ), 'Unloading MyClass::Sub' );
+ok( ! Class::Inspector->loaded( 'MyClass::Sub' ), 'MyClass::Sub is not loaded');
+
+ok( Class::Unload->unload( 'MyClass::Sub::Sub' ), 'Unloading MyClass::Sub::Sub' );
+ok( ! Class::Inspector->loaded( 'MyClass::Sub::Sub' ), 'MyClass::Sub::Sub is not loaded');
+
+ok( ! Class::Unload->unload('MyClass'), 'Unloading not-loaded class');
+
+ok( Class::Unload->unload( 'Class::Unload' ), 'Unloading Class::Unload' );
+ok( ! Class::Inspector->loaded( 'Class::Unload' ), 'Class::Unload is not loaded' );
+
+eval { Class::Unload->unload( 'dummy' ) };
+like( $@, qr /Can't locate object method "unload" via package "Class::Unload"/,
+      "Can't call method on unloaded class" );