Commit | Line | Data |
acf10771 |
1 | |
2 | package Moose::Meta::Method::Destructor; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
b288593e |
7 | use Devel::GlobalDestruction (); |
acf10771 |
8 | use Scalar::Util 'blessed', 'weaken'; |
55c361dc |
9 | use Try::Tiny; |
acf10771 |
10 | |
badb7e89 |
11 | use base 'Moose::Meta::Method', |
f4aef447 |
12 | 'Class::MOP::Method::Inlined'; |
acf10771 |
13 | |
14 | sub new { |
15 | my $class = shift; |
16 | my %options = @_; |
d03bd989 |
17 | |
46cb090f |
18 | (ref $options{options} eq 'HASH') |
19 | || $class->throw_error("You must pass a hash of options", data => $options{options}); |
20 | |
1b2aea39 |
21 | ($options{package_name} && $options{name}) |
46cb090f |
22 | || $class->throw_error("You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"); |
23 | |
acf10771 |
24 | my $self = bless { |
25 | # from our superclass |
d03bd989 |
26 | 'body' => undef, |
e606ae5f |
27 | 'package_name' => $options{package_name}, |
d03bd989 |
28 | 'name' => $options{name}, |
acf10771 |
29 | # ... |
d03bd989 |
30 | 'options' => $options{options}, |
e606ae5f |
31 | 'associated_metaclass' => $options{metaclass}, |
acf10771 |
32 | } => $class; |
33 | |
d03bd989 |
34 | # we don't want this creating |
35 | # a cycle in the code, if not |
acf10771 |
36 | # needed |
d03bd989 |
37 | weaken($self->{'associated_metaclass'}); |
acf10771 |
38 | |
bfaa304c |
39 | $self->_initialize_body; |
acf10771 |
40 | |
d03bd989 |
41 | return $self; |
acf10771 |
42 | } |
43 | |
d03bd989 |
44 | ## accessors |
acf10771 |
45 | |
e606ae5f |
46 | sub options { (shift)->{'options'} } |
acf10771 |
47 | |
48 | ## method |
49 | |
a7b097bb |
50 | sub is_needed { |
51 | my $self = shift; |
52 | my $metaclass = shift; |
53 | |
54 | ( blessed $metaclass && $metaclass->isa('Class::MOP::Class') ) |
55 | || $self->throw_error( |
56 | "The is_needed method expected a metaclass object as its arugment"); |
57 | |
8c86556c |
58 | return $metaclass->find_method_by_name("DEMOLISHALL"); |
9d22affb |
59 | } |
acf10771 |
60 | |
415e6f85 |
61 | sub initialize_body { |
8b7cb9ab |
62 | Carp::cluck('The initialize_body method has been made private.' |
63 | . " The public version is deprecated and will be removed in a future release.\n"); |
bfaa304c |
64 | shift->_initialize_body; |
65 | } |
66 | |
67 | sub _initialize_body { |
acf10771 |
68 | my $self = shift; |
69 | # TODO: |
d03bd989 |
70 | # the %options should also include a both |
71 | # a call 'initializer' and call 'SUPER::' |
72 | # options, which should cover approx 90% |
73 | # of the possible use cases (even if it |
74 | # requires some adaption on the part of |
acf10771 |
75 | # the author, after all, nothing is free) |
d03bd989 |
76 | |
f0b2e567 |
77 | my $class = $self->associated_metaclass->name; |
78 | my @source = ( |
79 | 'sub {', |
80 | 'my $self = shift;', |
81 | 'return ' . $self->_generate_fallback_destructor('$self'), |
82 | 'if Scalar::Util::blessed($self) ne \'' . $class . '\';', |
83 | $self->_generate_DEMOLISHALL('$self'), |
84 | '}', |
85 | ); |
86 | warn join("\n", @source) if $self->options->{debug}; |
d03bd989 |
87 | |
55c361dc |
88 | my $code = try { |
f0b2e567 |
89 | $self->_compile_code(source => \@source); |
55c361dc |
90 | } |
91 | catch { |
f0b2e567 |
92 | my $source = join("\n", @source); |
55c361dc |
93 | $self->throw_error( |
94 | "Could not eval the destructor :\n\n$source\n\nbecause :\n\n$_", |
95 | error => $_, |
96 | data => $source, |
97 | ); |
98 | }; |
497442e8 |
99 | |
e606ae5f |
100 | $self->{'body'} = $code; |
acf10771 |
101 | } |
102 | |
f0b2e567 |
103 | sub _generate_fallback_destructor { |
104 | my $self = shift; |
105 | my ($inv) = @_; |
106 | |
107 | return $inv . '->Moose::Object::DESTROY(@_)'; |
108 | } |
109 | |
110 | sub _generate_DEMOLISHALL { |
111 | my $self = shift; |
112 | my ($inv) = @_; |
113 | |
114 | my @methods = $self->associated_metaclass->find_all_methods_by_name('DEMOLISH'); |
115 | return unless @methods; |
116 | |
117 | return ( |
118 | 'local $?;', |
119 | 'my $igd = Devel::GlobalDestruction::in_global_destruction;', |
120 | 'Try::Tiny::try {', |
121 | (map { $inv . '->' . $_->{class} . '::DEMOLISH($igd);' } @methods), |
122 | '}', |
123 | 'Try::Tiny::catch {', |
124 | 'no warnings \'misc\';', |
125 | 'die $_;', |
126 | '};', |
127 | 'return;', |
128 | ); |
129 | } |
130 | |
acf10771 |
131 | |
132 | 1; |
133 | |
ad46f524 |
134 | # ABSTRACT: Method Meta Object for destructors |
135 | |
acf10771 |
136 | __END__ |
137 | |
138 | =pod |
139 | |
587ae0d2 |
140 | =head1 DESCRIPTION |
141 | |
bcb81995 |
142 | This class is a subclass of L<Class::MOP::Class::Generated> that |
143 | provides Moose-specific functionality for inlining destructors. |
144 | |
145 | To understand this class, you should read the the |
146 | L<Class::MOP::Class::Generated> documentation as well. |
147 | |
148 | =head1 INHERITANCE |
149 | |
150 | C<Moose::Meta::Method::Destructor> is a subclass of |
151 | L<Moose::Meta::Method> I<and> L<Class::MOP::Method::Generated>. |
d44714be |
152 | |
587ae0d2 |
153 | =head1 METHODS |
154 | |
155 | =over 4 |
156 | |
bcac984a |
157 | =item B<< Moose::Meta::Method::Destructor->new(%options) >> |
bcb81995 |
158 | |
159 | This constructs a new object. It accepts the following options: |
160 | |
161 | =over 8 |
587ae0d2 |
162 | |
bcb81995 |
163 | =item * package_name |
587ae0d2 |
164 | |
bcb81995 |
165 | The package for the class in which the destructor is being |
166 | inlined. This option is required. |
587ae0d2 |
167 | |
bcb81995 |
168 | =item * name |
587ae0d2 |
169 | |
bcb81995 |
170 | The name of the destructor method. This option is required. |
171 | |
172 | =item * metaclass |
173 | |
174 | The metaclass for the class this destructor belongs to. This is |
175 | optional, as it can be set later by calling C<< |
176 | $metamethod->attach_to_class >>. |
177 | |
178 | =back |
587ae0d2 |
179 | |
bcb81995 |
180 | =item B<< Moose::Meta;:Method::Destructor->is_needed($metaclass) >> |
587ae0d2 |
181 | |
bcb81995 |
182 | Given a L<Moose::Meta::Class> object, this method returns a boolean |
183 | indicating whether the class needs a destructor. If the class or any |
184 | of its parents defines a C<DEMOLISH> method, it needs a destructor. |
587ae0d2 |
185 | |
186 | =back |
187 | |
c5fc2c21 |
188 | =head1 BUGS |
189 | |
190 | See L<Moose/BUGS> for details on reporting bugs. |
191 | |
587ae0d2 |
192 | =cut |
193 | |