File Coverage

blib/lib/Perl/Critic/Policy/Moose/ProhibitDESTROYMethod.pm
Criterion Covered Total %
statement 36 37 97.3
branch 8 8 100.0
condition n/a
subroutine 12 13 92.3
pod 5 6 83.3
total 61 64 95.3


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Moose::ProhibitDESTROYMethod;
2              
3 1     1   316467 use strict;
  1         3  
  1         48  
4 1     1   7 use warnings;
  1         3  
  1         54  
5              
6             our $VERSION = '1.03';
7              
8 1     1   4 use Readonly ();
  1         2  
  1         15  
9              
10 1     1   3 use Perl::Critic::Utils qw< :booleans :severities $EMPTY >;
  1         1  
  1         138  
11              
12 1     1   173 use base 'Perl::Critic::Policy';
  1         1  
  1         557  
13              
14             Readonly::Scalar my $DESCRIPTION =>
15             q<"DESTROY" method/subroutine declared in a Moose class.>;
16             Readonly::Scalar my $EXPLANATION => q<Use DEMOLISH for your destructors.>;
17              
18             sub supported_parameters {
19             return (
20             {
21 6     6 0 47993 name => 'equivalent_modules',
22             description =>
23             q<The additional modules to treat as equivalent to "Moose", "Moose::Role", or "MooseX::Role::Parameterized".>,
24             behavior => 'string list',
25             list_always_present_values => [qw< Moose Moose::Role MooseX::Role::Parameterized >],
26             },
27             );
28             }
29              
30 3     3 1 44 sub default_severity { return $SEVERITY_MEDIUM; }
31 0     0 1 0 sub default_themes { return qw< moose bugs >; }
32 6     6 1 507 sub applies_to { return 'PPI::Document' }
33              
34             sub prepare_to_scan_document {
35 6     6 1 53217 my ( $self, $document ) = @_;
36              
37 6         33 return $self->_is_interesting_document($document);
38             }
39              
40             sub _is_interesting_document {
41 13     13   26 my ( $self, $document ) = @_;
42              
43 13         20 foreach my $module ( keys %{ $self->{_equivalent_modules} } ) {
  13         63  
44 19 100       2775 return $TRUE if $document->uses_module($module);
45             }
46              
47 1         10 return $FALSE;
48             }
49              
50             sub violates {
51 6     6 1 80 my ( $self, undef, $document ) = @_;
52              
53 6         10 my @violations;
54 6         33 foreach my $namespace ( $document->namespaces() ) {
55             SUBDOCUMENT:
56 7         12610 foreach my $subdocument (
57             $document->subdocuments_for_namespace($namespace) ) {
58             next SUBDOCUMENT
59 7 100       102 if not $self->_is_interesting_document($subdocument);
60              
61 6 100       3171 if ( my $destructor
62             = $subdocument->find_first( \&_is_destructor ) ) {
63 3         110 push
64             @violations,
65             $self->violation(
66             $DESCRIPTION, $EXPLANATION,
67             $destructor
68             );
69             }
70             }
71             }
72              
73 6         835 return @violations;
74             }
75              
76             sub _is_destructor {
77 133     133   1397 my ( undef, $element ) = @_;
78              
79 133 100       692 return $FALSE if not $element->isa('PPI::Statement::Sub');
80              
81 5         28 return $element->name() eq 'DESTROY';
82             }
83              
84             1;
85              
86             # ABSTRACT: Use DEMOLISH instead of DESTROY
87              
88             __END__
89              
90             =pod
91              
92             =head1 NAME
93              
94             Perl::Critic::Policy::Moose::ProhibitDESTROYMethod - Use DEMOLISH instead of DESTROY
95              
96             =head1 VERSION
97              
98             version 1.03
99              
100             =head1 DESCRIPTION
101              
102             Getting the order of destructor execution correct with inheritance involved is
103             difficult. Let L<Moose> take care of it for you by putting your cleanup code
104             into a C<DEMOLISH()> method instead of a C<DESTROY()> method.
105              
106             # ok
107             package Foo;
108              
109             use Moose::Role;
110              
111             sub DEMOLISH {
112             ...
113             }
114              
115             # not ok
116             package Foo;
117              
118             use Moose::Role;
119              
120             sub DESTROY {
121             ...
122             }
123              
124             =for stopwords destructor
125              
126             =head1 AFFILIATION
127              
128             This policy is part of L<Perl::Critic::Moose>.
129              
130             =head1 CONFIGURATION
131              
132             There is a single option, C<equivalent_modules>. This allows you to specify
133             modules that should be treated the same as L<Moose> and L<Moose::Role>, if,
134             say, you were doing something with L<Moose::Exporter>. For example, if you
135             were to have this in your F<.perlcriticrc> file:
136              
137             [Moose::ProhibitDESTROYMethod]
138             equivalent_modules = MyCompany::Moose MooseX::NewThing
139              
140             then the following code would result in a violation:
141              
142             package Baz;
143              
144             use MyCompany::Moose;
145              
146             sub DESTROY {
147             ...
148             }
149              
150             =head1 SEE ALSO
151              
152             L<Moose::Manual::Construction>
153              
154             =head1 AUTHORS
155              
156             =over 4
157              
158             =item *
159              
160             Elliot Shank <perl@galumph.com>
161              
162             =item *
163              
164             Dave Rolsky <autarch@urth.org>
165              
166             =back
167              
168             =head1 COPYRIGHT AND LICENSE
169              
170             This software is copyright (c) 2008 - 2015 by Elliot Shank.
171              
172             This is free software; you can redistribute it and/or modify it under
173             the same terms as the Perl 5 programming language system itself.
174              
175             =cut