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