X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FMethod%2FDestructor.pm;h=31dce9cbab4897348088205fcc1b4951d67effe0;hb=856e64d4108c5faf3ba9ead64d73dbf53022541d;hp=486f9b4dd22b10688798bb7b89126e01180d048a;hpb=0aca6c894339607ab07bc40a508ab47129f0f1ec;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Method/Destructor.pm b/lib/Moose/Meta/Method/Destructor.pm index 486f9b4..31dce9c 100644 --- a/lib/Moose/Meta/Method/Destructor.pm +++ b/lib/Moose/Meta/Method/Destructor.pm @@ -6,7 +6,7 @@ use warnings; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.74'; +our $VERSION = '0.80'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -16,7 +16,7 @@ use base 'Moose::Meta::Method', 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,7 +57,7 @@ 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 { @@ -69,29 +69,33 @@ sub 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}; - + warn $source if $self->options->{debug}; + my $code = $self->_compile_code( environment => {}, code => $source, @@ -107,7 +111,7 @@ __END__ =pod -=head1 NAME +=head1 NAME Moose::Meta::Method::Destructor - Method Meta Object for destructors @@ -170,7 +174,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