2 package Moose::Meta::Method::Destructor;
7 use Devel::GlobalDestruction ();
8 use Scalar::Util 'blessed', 'weaken';
11 our $VERSION = '1.02';
12 $VERSION = eval $VERSION;
13 our $AUTHORITY = 'cpan:STEVAN';
15 use base 'Moose::Meta::Method',
16 'Class::MOP::Method::Inlined';
22 (ref $options{options} eq 'HASH')
23 || $class->throw_error("You must pass a hash of options", data => $options{options});
25 ($options{package_name} && $options{name})
26 || $class->throw_error("You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT");
31 'package_name' => $options{package_name},
32 'name' => $options{name},
34 'options' => $options{options},
35 'associated_metaclass' => $options{metaclass},
38 # we don't want this creating
39 # a cycle in the code, if not
41 weaken($self->{'associated_metaclass'});
43 $self->_initialize_body;
50 sub options { (shift)->{'options'} }
56 my $metaclass = shift;
58 ( blessed $metaclass && $metaclass->isa('Class::MOP::Class') )
59 || $self->throw_error(
60 "The is_needed method expected a metaclass object as its arugment");
62 return $metaclass->find_method_by_name("DEMOLISHALL");
66 Carp::cluck('The initialize_body method has been made private.'
67 . " The public version is deprecated and will be removed in a future release.\n");
68 shift->_initialize_body;
71 sub _initialize_body {
74 # the %options should also include a both
75 # a call 'initializer' and call 'SUPER::'
76 # options, which should cover approx 90%
77 # of the possible use cases (even if it
78 # requires some adaption on the part of
79 # the author, after all, nothing is free)
81 my @DEMOLISH_methods = $self->associated_metaclass->find_all_methods_by_name('DEMOLISH');
84 $source = 'sub {' . "\n";
85 $source .= 'my $self = shift;' . "\n";
86 $source .= 'return $self->Moose::Object::DESTROY(@_)' . "\n";
87 $source .= ' if Scalar::Util::blessed($self) ne ';
88 $source .= "'" . $self->associated_metaclass->name . "'";
89 $source .= ';' . "\n";
91 if ( @DEMOLISH_methods ) {
92 $source .= 'local $?;' . "\n";
94 $source .= 'my $in_global_destruction = Devel::GlobalDestruction::in_global_destruction;' . "\n";
96 $source .= 'Try::Tiny::try {' . "\n";
98 $source .= '$self->' . $_->{class} . '::DEMOLISH($in_global_destruction);' . "\n"
99 for @DEMOLISH_methods;
102 $source .= q[ Try::Tiny::catch { no warnings 'misc'; die $_ };] . "\n";
103 $source .= 'return;' . "\n";
109 warn $source if $self->options->{debug};
111 my ( $code, $e ) = $self->_compile_code(
117 "Could not eval the destructor :\n\n$source\n\nbecause :\n\n$e",
118 error => $e, data => $source )
121 $self->{'body'} = $code;
133 Moose::Meta::Method::Destructor - Method Meta Object for destructors
137 This class is a subclass of L<Class::MOP::Class::Generated> that
138 provides Moose-specific functionality for inlining destructors.
140 To understand this class, you should read the the
141 L<Class::MOP::Class::Generated> documentation as well.
145 C<Moose::Meta::Method::Destructor> is a subclass of
146 L<Moose::Meta::Method> I<and> L<Class::MOP::Method::Generated>.
152 =item B<< Moose::Meta;:Method::Destructor->new(%options) >>
154 This constructs a new object. It accepts the following options:
160 The package for the class in which the destructor is being
161 inlined. This option is required.
165 The name of the destructor method. This option is required.
169 The metaclass for the class this destructor belongs to. This is
170 optional, as it can be set later by calling C<<
171 $metamethod->attach_to_class >>.
175 =item B<< Moose::Meta;:Method::Destructor->is_needed($metaclass) >>
177 Given a L<Moose::Meta::Class> object, this method returns a boolean
178 indicating whether the class needs a destructor. If the class or any
179 of its parents defines a C<DEMOLISH> method, it needs a destructor.
185 See L<Moose/BUGS> for details on reporting bugs.
189 Stevan Little E<lt>stevan@iinteractive.comE<gt>
191 =head1 COPYRIGHT AND LICENSE
193 Copyright 2006-2010 by Infinity Interactive, Inc.
195 L<http://www.iinteractive.com>
197 This library is free software; you can redistribute it and/or modify
198 it under the same terms as Perl itself.