File Coverage

blib/lib/Class/Unload.pm
Criterion Covered Total %
statement 73 96 76.0
branch 17 32 53.1
condition n/a
subroutine 13 13 100.0
pod 1 1 100.0
total 104 142 73.2


line stmt bran cond sub pod time code
1             package Class::Unload;
2             # ABSTRACT: Unload a class
3             $Class::Unload::VERSION = '0.11_02'; # TRIAL
4              
5 2     2   104669 $Class::Unload::VERSION = '0.1102';use warnings;
  2     2   11  
  2         51  
  2         60390  
  2         17  
  2         52  
6 2     2   8 use strict;
  2     2   4  
  2         33  
  2         8  
  2         4  
  2         33  
7 2     2   6 no strict 'refs'; # we're fiddling with the symbol table
  2     2   4  
  2         35  
  2         7  
  2         4  
  2         63  
8              
9 2     2   799 use Class::Inspector;
  2     2   5717  
  2         48  
  2         10  
  2         4  
  2         44  
10 2     2   86 BEGIN { eval "use Hash::Util"; } # since 5.8.0
  2     2   903  
  2     2   4462  
  2         9  
  2         118  
  2         902  
  2         4525  
  2         17  
11              
12              
13             sub unload {
14 2     2 1 1928 my ($self, $class) = @_;
  10     10   5436  
15              
16 2 50       10 return unless Class::Inspector->loaded( $class );
  10 100       29  
17              
18 2 50       85 if ($class =~ /\A(main|CORE|Internals|utf8|UNIVERSAL|PerlIO|re)\z/) {
  8 50       202  
19 0         0 require Carp;
  0         0  
20 0         0 Carp::carp("Cannot unload $class");
  0         0  
21 0         0 return;
  0         0  
22             }
23              
24 2         4 my $symtab = $class.'::';
  8         15  
25 2         5 my ($was_locked, $was_readonly);
  8         10  
26 2 50       3 if (defined $Hash::Util::VERSION) {
  8 0       17  
    50          
    0          
27 2 50       3 if (Hash::Util::hash_locked %{$symtab}) {
  2 100       8  
  8         10  
  8         24  
28 0         0 Hash::Util::unlock_hash %{$symtab};
  0         0  
  3         19  
  3         9  
29 0         0 $was_locked++;
  3         40  
30             }
31             }
32 0         0 elsif (Internals::SvREADONLY(%{$symtab})) {
  0         0  
33 0         0 Internals::SvREADONLY(%{$symtab}, 0);
  0         0  
  0         0  
  0         0  
34 0         0 $was_readonly++;
  0         0  
35             }
36              
37             # Flush inheritance caches
38 2 50       17 if (Internals::SvREADONLY(@{"$class\::ISA"})) {
  2 50       9  
  8         38  
  8         42  
39 0         0 Internals::SvREADONLY(@{"$class\::ISA"}, 0);
  0         0  
  0         0  
  0         0  
40             }
41 2         3 @{$class . '::ISA'} = ();
  2         52  
  8         11  
  8         133  
42              
43             # Delete all symbols except other namespaces
44 2         12 for my $symbol (keys %$symtab) {
  8         37  
45 9 50       17 next if $symbol =~ /\A[^:]+::\z/;
  27 100       61  
46 9         36 delete $symtab->{$symbol};
  23         88  
47             }
48              
49             # Policy: could be restricted further, but perl5 cannot properly handle
50             # restricted stashes yet. Avoid AUTOLOAD/DESTROY surprises and keep em unlocked.
51             #if ($was_locked) {
52             # Hash::Util::lock_hash %{$symtab};
53             #}
54             #elsif ($was_readonly) {
55             # Internals::SvREADONLY(%{$symtab}, 1);
56             #}
57              
58 2         16 my $inc_file = join( '/', split /(?:'|::)/, $class ) . '.pm';
  8         57  
59 2         5 delete $INC{ $inc_file };
  8         16  
60              
61 2 50       6 if (Class::Inspector->loaded('Class::MOP')) {
  8 50       22  
62 0         0 Class::MOP::remove_metaclass_by_name($class);
  0         0  
63             }
64              
65 2         153 return 1;
  8         434  
66             }
67              
68              
69             1; # End of Class::Unload
70              
71             __END__