X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FMethod%2FDestructor.pm;h=8c0305abee8c9984acee62c8d7b18375e4efc27e;hb=eae37c67268fb05d0f2bc5473c38710a4a726f11;hp=1629e942dc411cc5dd65b540a0bbea5834bac29b;hpb=695d1c68199f073bfe3cd07e64c27b3904efe258;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Method/Destructor.pm b/lib/Moose/Meta/Method/Destructor.pm index 1629e94..8c0305a 100644 --- a/lib/Moose/Meta/Method/Destructor.pm +++ b/lib/Moose/Meta/Method/Destructor.pm @@ -4,10 +4,10 @@ package Moose::Meta::Method::Destructor; use strict; use warnings; -use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.04'; +our $VERSION = '0.71'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method', @@ -17,26 +17,26 @@ sub new { my $class = shift; my %options = @_; - (exists $options{options} && ref $options{options} eq 'HASH') - || confess "You must pass a hash of options"; - + (ref $options{options} eq 'HASH') + || $class->throw_error("You must pass a hash of options", data => $options{options}); + ($options{package_name} && $options{name}) - || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"; - + || $class->throw_error("You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"); + my $self = bless { # from our superclass - '&!body' => undef, - '$!package_name' => $options{package_name}, - '$!name' => $options{name}, + 'body' => undef, + 'package_name' => $options{package_name}, + 'name' => $options{name}, # ... - '%!options' => $options{options}, - '$!associated_metaclass' => $options{metaclass}, + 'options' => $options{options}, + 'associated_metaclass' => $options{metaclass}, } => $class; # 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; @@ -45,8 +45,8 @@ sub new { ## accessors -sub options { (shift)->{'%!options'} } -sub associated_metaclass { (shift)->{'$!associated_metaclass'} } +sub options { (shift)->{'options'} } +sub associated_metaclass { (shift)->{'associated_metaclass'} } ## method @@ -56,10 +56,10 @@ sub is_needed { # then must pass in a class name unless (blessed $self) { (blessed $_[0] && $_[0]->isa('Class::MOP::Class')) - || confess "When calling is_needed as a class method you must pass a class name"; + || $self->throw_error("When calling is_needed as a class method you must pass a class name"); return $_[0]->meta->can('DEMOLISH'); } - defined $self->{'&!body'} ? 1 : 0 + defined $self->{'body'} ? 1 : 0 } sub initialize_body { @@ -88,12 +88,12 @@ sub initialize_body { $source .= ";\n" . '}'; warn $source if $self->options->{debug}; - my $code; - { - $code = eval $source; - confess "Could not eval the destructor :\n\n$source\n\nbecause :\n\n$@" if $@; - } - $self->{'&!body'} = $code; + my $code = $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->{'body'} = $code; } @@ -110,7 +110,7 @@ Moose::Meta::Method::Destructor - Method Meta Object for destructors =head1 DESCRIPTION This is a subclass of L which handles -constructing an approprate Destructor method. This is primarily +constructing an appropriate Destructor method. This is primarily used in the making of immutable metaclasses, otherwise it is not particularly useful. @@ -140,7 +140,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2009 by Infinity Interactive, Inc. L