From: Stevan Little Date: Wed, 28 May 2008 03:17:36 +0000 (+0000) Subject: fixing the destructor, so it wont be created unless needed X-Git-Tag: 0_64~45 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cc05f61c329d0f20eee7a9fb4d7ce2af47eb988a;p=gitmo%2FClass-MOP.git fixing the destructor, so it wont be created unless needed --- diff --git a/lib/Class/MOP/Immutable.pm b/lib/Class/MOP/Immutable.pm index 289a2d5..6665df8 100644 --- a/lib/Class/MOP/Immutable.pm +++ b/lib/Class/MOP/Immutable.pm @@ -114,20 +114,27 @@ sub make_metaclass_immutable { my $destructor_class = $options{destructor_class}; - my $destructor = $destructor_class->new( - options => \%options, - metaclass => $metaclass, - package_name => $metaclass->name, - name => 'DESTROY' - ); - - $metaclass->add_method('DESTROY' => $destructor) - # NOTE: - # we allow the destructor to determine - # if it is needed or not, it can perform - # all sorts of checks because it has the - # metaclass instance - if $destructor->is_needed; + # NOTE: + # we allow the destructor to determine + # if it is needed or not before we actually + # create the destructor too + # - SL + if ($destructor_class->is_needed($metaclass)) { + my $destructor = $destructor_class->new( + options => \%options, + metaclass => $metaclass, + package_name => $metaclass->name, + name => 'DESTROY' + ); + + $metaclass->add_method('DESTROY' => $destructor) + # NOTE: + # we allow the destructor to determine + # if it is needed or not, it can perform + # all sorts of checks because it has the + # metaclass instance + if $destructor->is_needed; + } } my $memoized_methods = $self->options->{memoize}; diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 8d3a014..8edf5a7 100644 --- a/lib/Class/MOP/Package.pm +++ b/lib/Class/MOP/Package.pm @@ -39,7 +39,7 @@ sub initialize { # all these attribute readers will be bootstrapped # away in the Class::MOP bootstrap section -sub name { $_[0]->{'$!package'} } +sub name { $_[0]->{'$!package'} } sub namespace { # NOTE: # because of issues with the Perl API @@ -49,7 +49,7 @@ sub namespace { # we could just store a ref and it would # Just Work, but oh well :\ no strict 'refs'; - \%{$_[0]->name . '::'} + \%{$_[0]->{'$!package'} . '::'} } # utility methods @@ -91,7 +91,7 @@ sub add_package_symbol { no strict 'refs'; no warnings 'redefine', 'misc'; - *{$self->name . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value; + *{$self->{'$!package'} . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value; } sub remove_package_glob {