use strict;
use warnings;
-sub generate_destructor_method_inline {
- my ($class, $meta) = @_;
+sub _empty_destroy{ }
+
+sub _generate_destructor_method {
+ my ($class, $metaclass) = @_;
my $demolishall = do {
- if ($meta->name->can('DEMOLISH')) {
+ if ($metaclass->name->can('DEMOLISH')) {
my @code = ();
- no strict 'refs';
- for my $klass ($meta->linearized_isa) {
- if (*{$klass . '::DEMOLISH'}{CODE}) {
- push @code, "${klass}::DEMOLISH(\$self);";
+ for my $class ($metaclass->linearized_isa) {
+ no strict 'refs';
+ if (*{$class . '::DEMOLISH'}{CODE}) {
+ push @code, "${class}::DEMOLISH(\$self);";
}
}
join "\n", @code;
} else {
- return; # no demolish =)
+ $metaclass->add_method(DESTROY => \&_empty_destroy);
+ return;
}
};
- my $code = <<"...";
- sub {
+ my $destructor_name = $metaclass->name . '::DESTROY';
+ my $source = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"...";
+ sub $destructor_name \{
my \$self = shift;
$demolishall;
}
...
- warn $code if $ENV{DEBUG};
- local $@;
- my $res = eval $code;
- die $@ if $@;
- return $res;
+ my $e = do{
+ local $@;
+ eval $source;
+ $@;
+ };
+ die $e if $e;
+ return;
}
1;