More _generate_class_type_for()
[gitmo/Mouse.git] / lib / Mouse / Meta / Method / Destructor.pm
1 package Mouse::Meta::Method::Destructor;
2 use Mouse::Util qw(get_code_ref); # enables strict and warnings
3
4 sub _empty_DESTROY{ }
5
6 sub _generate_destructor{
7     my (undef, $metaclass) = @_;
8
9     if(!$metaclass->name->can('DEMOLISH')){
10         return \&_empty_DESTROY;
11     }
12
13     my $demolishall = '';
14     for my $class ($metaclass->linearized_isa) {
15         if (get_code_ref($class, 'DEMOLISH')) {
16             $demolishall .= "${class}::DEMOLISH(\$self);\n";
17         }
18     }
19
20     my $source = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"...";
21     sub {
22         my \$self = shift;
23         local \$?;
24
25         my \$e = do{
26             local \$@;
27             eval{
28                 $demolishall;
29             };
30             \$@;
31         };
32         no warnings 'misc';
33         die \$e if \$e; # rethrow
34     }
35 ...
36
37     my $code;
38     my $e = do{
39         local $@;
40         $code = eval $source;
41         $@;
42     };
43     die $e if $e;
44     return $code;
45 }
46
47 1;
48 __END__
49
50 =head1 NAME
51
52 Mouse::Meta::Method::Destructor - A Mouse method generator for destructors
53
54 =head1 VERSION
55
56 This document describes Mouse version 0.40_01
57
58 =head1 SEE ALSO
59
60 L<Moose::Meta::Method::Destructor>
61
62 =cut