X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FMethod%2FDestructor.pm;h=a271b2514dd5307b4c069004c32d77953fab4715;hb=16f00af3b76d2ccc5153482117479b0934e07419;hp=4111b30716660c779ee96f2392e4066a5120c2fa;hpb=6302a7e870c9ed9bce511891a74e5bdd140fcc74;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Method/Destructor.pm b/lib/Moose/Meta/Method/Destructor.pm index 4111b30..a271b25 100644 --- a/lib/Moose/Meta/Method/Destructor.pm +++ b/lib/Moose/Meta/Method/Destructor.pm @@ -6,17 +6,17 @@ use warnings; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.73_02'; +our $VERSION = '0.83'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method', - 'Class::MOP::Method::Generated'; + 'Class::MOP::Method::Inlined'; sub new { my $class = shift; my %options = @_; - + (ref $options{options} eq 'HASH') || $class->throw_error("You must pass a hash of options", data => $options{options}); @@ -25,25 +25,25 @@ sub new { my $self = bless { # from our superclass - 'body' => undef, + 'body' => undef, 'package_name' => $options{package_name}, - 'name' => $options{name}, + 'name' => $options{name}, # ... - 'options' => $options{options}, + 'options' => $options{options}, 'associated_metaclass' => $options{metaclass}, } => $class; - # we don't want this creating - # a cycle in the code, if not + # we don't want this creating + # a cycle in the code, if not # needed - weaken($self->{'associated_metaclass'}); + weaken($self->{'associated_metaclass'}); $self->_initialize_body; - return $self; + return $self; } -## accessors +## accessors sub options { (shift)->{'options'} } @@ -57,45 +57,54 @@ sub is_needed { || $self->throw_error( "The is_needed method expected a metaclass object as its arugment"); - return $metaclass->find_method_by_name('DEMOLISH'); + return $metaclass->find_method_by_name("DEMOLISHALL"); } sub initialize_body { - warn 'The initialize_body method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"; + Carp::cluck('The initialize_body method has been made private.' + . " The public version is deprecated and will be removed in a future release.\n"); shift->_initialize_body; } sub _initialize_body { my $self = shift; # TODO: - # the %options should also include a both - # a call 'initializer' and call 'SUPER::' - # options, which should cover approx 90% - # of the possible use cases (even if it - # requires some adaption on the part of + # the %options should also include a both + # a call 'initializer' and call 'SUPER::' + # options, which should cover approx 90% + # of the possible use cases (even if it + # requires some adaption on the part of # the author, after all, nothing is free) - + my @DEMOLISH_methods = $self->associated_metaclass->find_all_methods_by_name('DEMOLISH'); - - return unless @DEMOLISH_methods; - - my $source = 'sub {'; - - my @DEMOLISH_calls; - foreach my $method (@DEMOLISH_methods) { - push @DEMOLISH_calls => '$_[0]->' . $method->{class} . '::DEMOLISH()'; + + my $source; + if ( @DEMOLISH_methods ) { + $source = 'sub {'; + + my @DEMOLISH_calls; + foreach my $method (@DEMOLISH_methods) { + push @DEMOLISH_calls => '$_[0]->' . $method->{class} . '::DEMOLISH()'; + } + + $source .= join ";\n" => @DEMOLISH_calls; + + $source .= ";\n" . '}'; + } else { + $source = 'sub { }'; } - - $source .= join ";\n" => @DEMOLISH_calls; - $source .= ";\n" . '}'; - warn $source if $self->options->{debug}; - - my $code = $self->_compile_code( + warn $source if $self->options->{debug}; + + my ( $code, $e ) = $self->_compile_code( environment => {}, code => $source, - ) or $self->throw_error("Could not eval the destructor :\n\n$source\n\nbecause :\n\n$@", error => $@, data => $source); + ); + + $self->throw_error( + "Could not eval the destructor :\n\n$source\n\nbecause :\n\n$e", + error => $e, data => $source ) + if $e; $self->{'body'} = $code; } @@ -107,7 +116,7 @@ __END__ =pod -=head1 NAME +=head1 NAME Moose::Meta::Method::Destructor - Method Meta Object for destructors @@ -170,7 +179,7 @@ Copyright 2006-2009 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +it under the same terms as Perl itself. =cut