File Coverage

blib/lib/Mouse/Meta/Method/Destructor.pm
Criterion Covered Total %
statement 6 23 26.0
branch 1 8 12.5
condition n/a
subroutine 2 3 66.6
pod n/a
total 9 34 26.4


line stmt bran cond sub pod time code
1             package Mouse::Meta::Method::Destructor;
2 1     1   8 use Mouse::Util qw(:meta); # enables strict and warnings
  1         3  
  1         7  
3              
4 1 50   1   6 use constant _MOUSE_DEBUG => $ENV{MOUSE_DEBUG} ? 1 : 0;
  1         2  
  1         245  
5              
6             sub _generate_destructor{
7 0     0     my (undef, $metaclass) = @_;
8              
9 0           my $demolishall = '';
10 0           for my $class ($metaclass->linearized_isa) {
11 0 0         if (Mouse::Util::get_code_ref($class, 'DEMOLISH')) {
12 0           $demolishall .= ' ' . $class
13             . '::DEMOLISH($self, Mouse::Util::in_global_destruction());'
14             . "\n",
15             }
16             }
17              
18 0 0         if($demolishall) {
19 0           $demolishall = sprintf <<'EOT', $demolishall;
20             my $e = do{
21             local $?;
22             local $@;
23             eval{
24             %s;
25             };
26             $@;
27             };
28             no warnings 'misc';
29             die $e if $e; # rethrow
30             EOT
31             }
32              
33 0           my $name = $metaclass->name;
34 0           my $source = sprintf(<<'EOT', __FILE__, $name, $demolishall);
35             #line 1 "%s"
36             package %s;
37             sub {
38             my($self) = @_;
39             return $self->Mouse::Object::DESTROY()
40             if ref($self) ne __PACKAGE__;
41             # DEMOLISHALL
42             %s;
43             return;
44             }
45             EOT
46              
47 0           warn $source if _MOUSE_DEBUG;
48              
49 0           my $code;
50 0           my $e = do{
51 0           local $@;
52 0           $code = eval $source;
53 0           $@;
54             };
55 0 0         die $e if $e;
56 0           return $code;
57             }
58              
59             1;
60             __END__