Import Upstream version 1.140
This commit is contained in:
denghao
commit
e3ffca65c1
|
|
@ -0,0 +1,99 @@
|
|||
use 5.006001;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Module::Build;
|
||||
# meta_merge->resources->license now takes an arrayref of URLs in 0.4200 (or
|
||||
# thereabouts, but I can't tell for sure from the Changes file).
|
||||
|
||||
use lib 'inc';
|
||||
|
||||
use Perl::Critic::BuildUtilities qw<
|
||||
required_module_versions
|
||||
build_required_module_versions
|
||||
emit_tar_warning_if_necessary
|
||||
get_PL_files
|
||||
>;
|
||||
use Perl::Critic::Module::Build;
|
||||
|
||||
|
||||
emit_tar_warning_if_necessary();
|
||||
|
||||
|
||||
my $builder = Perl::Critic::Module::Build->new(
|
||||
module_name => 'Perl::Critic',
|
||||
dist_author => 'Jeffrey Thalhammer <jeff@imaginative-software.com>',
|
||||
dist_abstract => 'Critique Perl source code for best-practices.',
|
||||
license => 'perl',
|
||||
dynamic_config => 1,
|
||||
create_readme => 1,
|
||||
create_packlist => 1,
|
||||
sign => 0,
|
||||
|
||||
requires => { required_module_versions() },
|
||||
build_requires => { build_required_module_versions() },
|
||||
|
||||
# Don't require a developer version of Module::Build, even if the
|
||||
# distribution tarball was created with one. (Oops.)
|
||||
configure_requires => {
|
||||
'Module::Build' => '0.4204',
|
||||
},
|
||||
|
||||
PL_files => get_PL_files(),
|
||||
|
||||
script_files => ['bin/perlcritic'],
|
||||
|
||||
meta_merge => {
|
||||
resources => {
|
||||
bugtracker => 'https://github.com/Perl-Critic/Perl-Critic/issues',
|
||||
homepage => 'http://perlcritic.com',
|
||||
license => [ 'http://dev.perl.org/licenses' ],
|
||||
MailingList => 'https://groups.google.com/d/forum/perl-critic',
|
||||
repository => 'git://github.com/Perl-Critic/Perl-Critic.git',
|
||||
},
|
||||
no_index => {
|
||||
file => [
|
||||
qw<
|
||||
TODO.pod
|
||||
>
|
||||
],
|
||||
directory => [
|
||||
qw<
|
||||
doc
|
||||
inc
|
||||
tools
|
||||
xt
|
||||
>
|
||||
],
|
||||
},
|
||||
x_authority => 'cpan:CRITICRE',
|
||||
},
|
||||
|
||||
add_to_cleanup => [
|
||||
qw<
|
||||
Debian_CPANTS.txt
|
||||
Makefile
|
||||
Makefile.old
|
||||
MANIFEST.bak
|
||||
META.json
|
||||
META.yml
|
||||
pm_to_blib
|
||||
README
|
||||
>,
|
||||
values %{ get_PL_files() },
|
||||
],
|
||||
);
|
||||
|
||||
$builder->create_build_script();
|
||||
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
# Contributing to Perl::Critic
|
||||
|
||||
These are the guidelines for contributing to the Perl::Critic repository.
|
||||
|
||||
## Issues
|
||||
|
||||
File an issue if you think you've found a bug. Please describe
|
||||
|
||||
1. How can it be reproduced
|
||||
2. What was expected
|
||||
3. What actually occurred
|
||||
4. What version of the involved component
|
||||
|
||||
## Patches
|
||||
|
||||
Patches for fixes, features, and improvements are accepted via pull requests.
|
||||
|
||||
Pull requests should be based on the **dev branch**, unless you want to contribute to an active branch for a specific topic.
|
||||
|
||||
All contributions are welcome and most will be accepted.
|
||||
|
||||
Please see the [developer guidelines](https://github.com/Perl-Critic/Perl-Critic/blob/dev/README.developer) and the complete [developer documentation](https://metacpan.org/pod/Perl::Critic::DEVELOPER).
|
||||
|
||||
## Licensing and copyright
|
||||
|
||||
Please note that accepted contributions are included in the repository and hence under the same license as the repository contributed to.
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
INSTALLATION
|
||||
|
||||
To install Perl::Critic give the following commands
|
||||
to your favorite shell:
|
||||
|
||||
tar -zxf Perl-Critic-1.126.tar.gz
|
||||
cd Perl-Critic-1.126
|
||||
perl Build.pl
|
||||
./Build
|
||||
./Build test
|
||||
./Build install
|
||||
|
|
@ -0,0 +1,307 @@
|
|||
Terms of Perl itself
|
||||
|
||||
a) the GNU General Public License as published by the Free
|
||||
Software Foundation; either version 1, or (at your option) any
|
||||
later version, or
|
||||
b) the "Artistic License"
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 1, February 1989
|
||||
|
||||
Copyright (C) 1989 Free Software Foundation, Inc.
|
||||
51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
Preamble
|
||||
|
||||
The license agreements of most software companies try to keep users
|
||||
at the mercy of those companies. By contrast, our General Public
|
||||
License is intended to guarantee your freedom to share and change free
|
||||
software--to make sure the software is free for all its users. The
|
||||
General Public License applies to the Free Software Foundation's
|
||||
software and to any other program whose authors commit to using it.
|
||||
You can use it for your programs, too.
|
||||
|
||||
When we speak of free software, we are referring to freedom, not
|
||||
price. Specifically, the General Public License is designed to make
|
||||
sure that you have the freedom to give away or sell copies of free
|
||||
software, that you receive source code or can get it if you want it,
|
||||
that you can change the software or use pieces of it in new free
|
||||
programs; and that you know you can do these things.
|
||||
|
||||
To protect your rights, we need to make restrictions that forbid
|
||||
anyone to deny you these rights or to ask you to surrender the rights.
|
||||
These restrictions translate to certain responsibilities for you if you
|
||||
distribute copies of the software, or if you modify it.
|
||||
|
||||
For example, if you distribute copies of a such a program, whether
|
||||
gratis or for a fee, you must give the recipients all the rights that
|
||||
you have. You must make sure that they, too, receive or can get the
|
||||
source code. And you must tell them their rights.
|
||||
|
||||
We protect your rights with two steps: (1) copyright the software, and
|
||||
(2) offer you this license which gives you legal permission to copy,
|
||||
distribute and/or modify the software.
|
||||
|
||||
Also, for each author's protection and ours, we want to make certain
|
||||
that everyone understands that there is no warranty for this free
|
||||
software. If the software is modified by someone else and passed on, we
|
||||
want its recipients to know that what they have is not the original, so
|
||||
that any problems introduced by others will not reflect on the original
|
||||
authors' reputations.
|
||||
|
||||
The precise terms and conditions for copying, distribution and
|
||||
modification follow.
|
||||
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
||||
|
||||
0. This License Agreement applies to any program or other work which
|
||||
contains a notice placed by the copyright holder saying it may be
|
||||
distributed under the terms of this General Public License. The
|
||||
"Program", below, refers to any such program or work, and a "work based
|
||||
on the Program" means either the Program or any work containing the
|
||||
Program or a portion of it, either verbatim or with modifications. Each
|
||||
licensee is addressed as "you".
|
||||
|
||||
1. You may copy and distribute verbatim copies of the Program's source
|
||||
code as you receive it, in any medium, provided that you conspicuously and
|
||||
appropriately publish on each copy an appropriate copyright notice and
|
||||
disclaimer of warranty; keep intact all the notices that refer to this
|
||||
General Public License and to the absence of any warranty; and give any
|
||||
other recipients of the Program a copy of this General Public License
|
||||
along with the Program. You may charge a fee for the physical act of
|
||||
transferring a copy.
|
||||
|
||||
2. You may modify your copy or copies of the Program or any portion of
|
||||
it, and copy and distribute such modifications under the terms of Paragraph
|
||||
1 above, provided that you also do the following:
|
||||
|
||||
a) cause the modified files to carry prominent notices stating that
|
||||
you changed the files and the date of any change; and
|
||||
|
||||
b) cause the whole of any work that you distribute or publish, that
|
||||
in whole or in part contains the Program or any part thereof, either
|
||||
with or without modifications, to be licensed at no charge to all
|
||||
third parties under the terms of this General Public License (except
|
||||
that you may choose to grant warranty protection to some or all
|
||||
third parties, at your option).
|
||||
|
||||
c) If the modified program normally reads commands interactively when
|
||||
run, you must cause it, when started running for such interactive use
|
||||
in the simplest and most usual way, to print or display an
|
||||
announcement including an appropriate copyright notice and a notice
|
||||
that there is no warranty (or else, saying that you provide a
|
||||
warranty) and that users may redistribute the program under these
|
||||
conditions, and telling the user how to view a copy of this General
|
||||
Public License.
|
||||
|
||||
d) You may charge a fee for the physical act of transferring a
|
||||
copy, and you may at your option offer warranty protection in
|
||||
exchange for a fee.
|
||||
|
||||
Mere aggregation of another independent work with the Program (or its
|
||||
derivative) on a volume of a storage or distribution medium does not bring
|
||||
the other work under the scope of these terms.
|
||||
|
||||
3. You may copy and distribute the Program (or a portion or derivative of
|
||||
it, under Paragraph 2) in object code or executable form under the terms of
|
||||
Paragraphs 1 and 2 above provided that you also do one of the following:
|
||||
|
||||
a) accompany it with the complete corresponding machine-readable
|
||||
source code, which must be distributed under the terms of
|
||||
Paragraphs 1 and 2 above; or,
|
||||
|
||||
b) accompany it with a written offer, valid for at least three
|
||||
years, to give any third party free (except for a nominal charge
|
||||
for the cost of distribution) a complete machine-readable copy of the
|
||||
corresponding source code, to be distributed under the terms of
|
||||
Paragraphs 1 and 2 above; or,
|
||||
|
||||
c) accompany it with the information you received as to where the
|
||||
corresponding source code may be obtained. (This alternative is
|
||||
allowed only for noncommercial distribution and only if you
|
||||
received the program in object code or executable form alone.)
|
||||
|
||||
Source code for a work means the preferred form of the work for making
|
||||
modifications to it. For an executable file, complete source code means
|
||||
all the source code for all modules it contains; but, as a special
|
||||
exception, it need not include source code for modules which are standard
|
||||
libraries that accompany the operating system on which the executable
|
||||
file runs, or for standard header files or definitions files that
|
||||
accompany that operating system.
|
||||
|
||||
4. You may not copy, modify, sublicense, distribute or transfer the
|
||||
Program except as expressly provided under this General Public License.
|
||||
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
|
||||
the Program is void, and will automatically terminate your rights to use
|
||||
the Program under this License. However, parties who have received
|
||||
copies, or rights to use copies, from you under this General Public
|
||||
License will not have their licenses terminated so long as such parties
|
||||
remain in full compliance.
|
||||
|
||||
5. By copying, distributing or modifying the Program (or any work based
|
||||
on the Program) you indicate your acceptance of this license to do so,
|
||||
and all its terms and conditions.
|
||||
|
||||
6. Each time you redistribute the Program (or any work based on the
|
||||
Program), the recipient automatically receives a license from the original
|
||||
licensor to copy, distribute or modify the Program subject to these
|
||||
terms and conditions. You may not impose any further restrictions on the
|
||||
recipients' exercise of the rights granted herein.
|
||||
|
||||
7. The Free Software Foundation may publish revised and/or new versions
|
||||
of the General Public License from time to time. Such new versions will
|
||||
be similar in spirit to the present version, but may differ in detail to
|
||||
address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the Program
|
||||
specifies a version number of the license which applies to it and "any
|
||||
later version", you have the option of following the terms and conditions
|
||||
either of that version or of any later version published by the Free
|
||||
Software Foundation. If the Program does not specify a version number of
|
||||
the license, you may choose any version ever published by the Free Software
|
||||
Foundation.
|
||||
|
||||
8. If you wish to incorporate parts of the Program into other free
|
||||
programs whose distribution conditions are different, write to the author
|
||||
to ask for permission. For software which is copyrighted by the Free
|
||||
Software Foundation, write to the Free Software Foundation; we sometimes
|
||||
make exceptions for this. Our decision will be guided by the two goals
|
||||
of preserving the free status of all derivatives of our free software and
|
||||
of promoting the sharing and reuse of software generally.
|
||||
|
||||
NO WARRANTY
|
||||
|
||||
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
|
||||
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
|
||||
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
|
||||
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
|
||||
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
|
||||
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
|
||||
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
|
||||
REPAIR OR CORRECTION.
|
||||
|
||||
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
|
||||
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
|
||||
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
|
||||
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
|
||||
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
|
||||
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
|
||||
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGES.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
The Artistic License
|
||||
|
||||
Preamble
|
||||
|
||||
The intent of this document is to state the conditions under which a Package
|
||||
may be copied, such that the Copyright Holder maintains some semblance of
|
||||
artistic control over the development of the package, while giving the users of the
|
||||
package the right to use and distribute the Package in a more-or-less customary
|
||||
fashion, plus the right to make reasonable modifications.
|
||||
|
||||
Definitions:
|
||||
|
||||
- "Package" refers to the collection of files distributed by the Copyright
|
||||
Holder, and derivatives of that collection of files created through textual
|
||||
modification.
|
||||
- "Standard Version" refers to such a Package if it has not been modified,
|
||||
or has been modified in accordance with the wishes of the Copyright
|
||||
Holder.
|
||||
- "Copyright Holder" is whoever is named in the copyright or copyrights for
|
||||
the package.
|
||||
- "You" is you, if you're thinking about copying or distributing this Package.
|
||||
- "Reasonable copying fee" is whatever you can justify on the basis of
|
||||
media cost, duplication charges, time of people involved, and so on. (You
|
||||
will not be required to justify it to the Copyright Holder, but only to the
|
||||
computing community at large as a market that must bear the fee.)
|
||||
- "Freely Available" means that no fee is charged for the item itself, though
|
||||
there may be fees involved in handling the item. It also means that
|
||||
recipients of the item may redistribute it under the same conditions they
|
||||
received it.
|
||||
|
||||
1. You may make and give away verbatim copies of the source form of the
|
||||
Standard Version of this Package without restriction, provided that you duplicate
|
||||
all of the original copyright notices and associated disclaimers.
|
||||
|
||||
2. You may apply bug fixes, portability fixes and other modifications derived from
|
||||
the Public Domain or from the Copyright Holder. A Package modified in such a
|
||||
way shall still be considered the Standard Version.
|
||||
|
||||
3. You may otherwise modify your copy of this Package in any way, provided
|
||||
that you insert a prominent notice in each changed file stating how and when
|
||||
you changed that file, and provided that you do at least ONE of the following:
|
||||
|
||||
a) place your modifications in the Public Domain or otherwise
|
||||
make them Freely Available, such as by posting said modifications
|
||||
to Usenet or an equivalent medium, or placing the modifications on
|
||||
a major archive site such as ftp.uu.net, or by allowing the
|
||||
Copyright Holder to include your modifications in the Standard
|
||||
Version of the Package.
|
||||
|
||||
b) use the modified Package only within your corporation or
|
||||
organization.
|
||||
|
||||
c) rename any non-standard executables so the names do not
|
||||
conflict with standard executables, which must also be provided,
|
||||
and provide a separate manual page for each non-standard
|
||||
executable that clearly documents how it differs from the Standard
|
||||
Version.
|
||||
|
||||
d) make other distribution arrangements with the Copyright Holder.
|
||||
|
||||
4. You may distribute the programs of this Package in object code or executable
|
||||
form, provided that you do at least ONE of the following:
|
||||
|
||||
a) distribute a Standard Version of the executables and library
|
||||
files, together with instructions (in the manual page or equivalent)
|
||||
on where to get the Standard Version.
|
||||
|
||||
b) accompany the distribution with the machine-readable source of
|
||||
the Package with your modifications.
|
||||
|
||||
c) accompany any non-standard executables with their
|
||||
corresponding Standard Version executables, giving the
|
||||
non-standard executables non-standard names, and clearly
|
||||
documenting the differences in manual pages (or equivalent),
|
||||
together with instructions on where to get the Standard Version.
|
||||
|
||||
d) make other distribution arrangements with the Copyright Holder.
|
||||
|
||||
5. You may charge a reasonable copying fee for any distribution of this Package.
|
||||
You may charge any fee you choose for support of this Package. You may not
|
||||
charge a fee for this Package itself. However, you may distribute this Package in
|
||||
aggregate with other (possibly commercial) programs as part of a larger
|
||||
(possibly commercial) software distribution provided that you do not advertise
|
||||
this Package as a product of your own.
|
||||
|
||||
6. The scripts and library files supplied as input to or produced as output from
|
||||
the programs of this Package do not automatically fall under the copyright of this
|
||||
Package, but belong to whomever generated them, and may be sold
|
||||
commercially, and may be aggregated with this Package.
|
||||
|
||||
7. C or perl subroutines supplied by you and linked into this Package shall not
|
||||
be considered part of this Package.
|
||||
|
||||
8. The name of the Copyright Holder may not be used to endorse or promote
|
||||
products derived from this software without specific prior written permission.
|
||||
|
||||
9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
|
||||
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
|
||||
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR
|
||||
PURPOSE.
|
||||
|
||||
The End
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,427 @@
|
|||
bin/perlcritic
|
||||
Build.PL
|
||||
Changes
|
||||
CONTRIBUTING.md
|
||||
cpanfile
|
||||
examples/generatestats
|
||||
examples/loadanalysisdb
|
||||
examples/perlcriticrc
|
||||
examples/perlcriticrc-conway
|
||||
extras/perlcritic.el
|
||||
inc/Devel/AssertOS.pm
|
||||
inc/Devel/AssertOS/Solaris.pm
|
||||
inc/Devel/CheckOS.pm
|
||||
inc/Perl/Critic/BuildUtilities.pm
|
||||
inc/Perl/Critic/Module/Build.pm
|
||||
inc/Perl/Critic/Module/Build/Standard.pm
|
||||
inc/Perl/Critic/PolicySummaryGenerator.pm
|
||||
INSTALL
|
||||
lib/Perl/Critic.pm
|
||||
lib/Perl/Critic/Annotation.pm
|
||||
lib/Perl/Critic/Command.pm
|
||||
lib/Perl/Critic/Config.pm
|
||||
lib/Perl/Critic/CORE_DEVELOPER.pod
|
||||
lib/Perl/Critic/DEVELOPER.pod
|
||||
lib/Perl/Critic/Document.pm
|
||||
lib/Perl/Critic/Exception.pm
|
||||
lib/Perl/Critic/Exception/AggregateConfiguration.pm
|
||||
lib/Perl/Critic/Exception/Configuration.pm
|
||||
lib/Perl/Critic/Exception/Configuration/Generic.pm
|
||||
lib/Perl/Critic/Exception/Configuration/NonExistentPolicy.pm
|
||||
lib/Perl/Critic/Exception/Configuration/Option.pm
|
||||
lib/Perl/Critic/Exception/Configuration/Option/Global.pm
|
||||
lib/Perl/Critic/Exception/Configuration/Option/Global/ExtraParameter.pm
|
||||
lib/Perl/Critic/Exception/Configuration/Option/Global/ParameterValue.pm
|
||||
lib/Perl/Critic/Exception/Configuration/Option/Policy.pm
|
||||
lib/Perl/Critic/Exception/Configuration/Option/Policy/ExtraParameter.pm
|
||||
lib/Perl/Critic/Exception/Configuration/Option/Policy/ParameterValue.pm
|
||||
lib/Perl/Critic/Exception/Fatal.pm
|
||||
lib/Perl/Critic/Exception/Fatal/Generic.pm
|
||||
lib/Perl/Critic/Exception/Fatal/Internal.pm
|
||||
lib/Perl/Critic/Exception/Fatal/PolicyDefinition.pm
|
||||
lib/Perl/Critic/Exception/IO.pm
|
||||
lib/Perl/Critic/Exception/Parse.pm
|
||||
lib/Perl/Critic/OptionsProcessor.pm
|
||||
lib/Perl/Critic/Policy.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitBooleanGrep.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitComplexMappings.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitLvalueSubstr.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitReverseSortBlock.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitShiftRef.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitSleepViaSelect.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringyEval.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringySplit.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitUniversalCan.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitUniversalIsa.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitUselessTopic.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitVoidGrep.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitVoidMap.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrep.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockMap.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/RequireGlobFunction.pm
|
||||
lib/Perl/Critic/Policy/BuiltinFunctions/RequireSimpleSortBlock.pm
|
||||
lib/Perl/Critic/Policy/ClassHierarchies/ProhibitAutoloading.pm
|
||||
lib/Perl/Critic/Policy/ClassHierarchies/ProhibitExplicitISA.pm
|
||||
lib/Perl/Critic/Policy/ClassHierarchies/ProhibitOneArgBless.pm
|
||||
lib/Perl/Critic/Policy/CodeLayout/ProhibitHardTabs.pm
|
||||
lib/Perl/Critic/Policy/CodeLayout/ProhibitParensWithBuiltins.pm
|
||||
lib/Perl/Critic/Policy/CodeLayout/ProhibitQuotedWordLists.pm
|
||||
lib/Perl/Critic/Policy/CodeLayout/ProhibitTrailingWhitespace.pm
|
||||
lib/Perl/Critic/Policy/CodeLayout/RequireConsistentNewlines.pm
|
||||
lib/Perl/Critic/Policy/CodeLayout/RequireTidyCode.pm
|
||||
lib/Perl/Critic/Policy/CodeLayout/RequireTrailingCommas.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitCascadingIfElse.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitCStyleForLoops.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitDeepNests.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitLabelsWithSpecialBlockNames.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitMutatingListFunctions.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitNegativeExpressionsInUnlessAndUntilConditions.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitPostfixControls.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitUnlessBlocks.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitUnreachableCode.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitUntilBlocks.pm
|
||||
lib/Perl/Critic/Policy/ControlStructures/ProhibitYadaOperator.pm
|
||||
lib/Perl/Critic/Policy/Documentation/PodSpelling.pm
|
||||
lib/Perl/Critic/Policy/Documentation/RequirePackageMatchesPodName.pm
|
||||
lib/Perl/Critic/Policy/Documentation/RequirePodAtEnd.pm
|
||||
lib/Perl/Critic/Policy/Documentation/RequirePodSections.pm
|
||||
lib/Perl/Critic/Policy/ErrorHandling/RequireCarping.pm
|
||||
lib/Perl/Critic/Policy/ErrorHandling/RequireCheckingReturnValueOfEval.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/ProhibitBacktickOperators.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/ProhibitBarewordFileHandles.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/ProhibitExplicitStdin.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/ProhibitInteractiveTest.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/ProhibitJoinedReadline.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/ProhibitOneArgSelect.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/ProhibitReadlineInForLoop.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/ProhibitTwoArgOpen.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/RequireBracedFileHandleWithPrint.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/RequireBriefOpen.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/RequireCheckedClose.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/RequireCheckedOpen.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/RequireCheckedSyscalls.pm
|
||||
lib/Perl/Critic/Policy/InputOutput/RequireEncodingWithUTF8Layer.pm
|
||||
lib/Perl/Critic/Policy/Miscellanea/ProhibitFormats.pm
|
||||
lib/Perl/Critic/Policy/Miscellanea/ProhibitTies.pm
|
||||
lib/Perl/Critic/Policy/Miscellanea/ProhibitUnrestrictedNoCritic.pm
|
||||
lib/Perl/Critic/Policy/Miscellanea/ProhibitUselessNoCritic.pm
|
||||
lib/Perl/Critic/Policy/Modules/ProhibitAutomaticExportation.pm
|
||||
lib/Perl/Critic/Policy/Modules/ProhibitConditionalUseStatements.pm
|
||||
lib/Perl/Critic/Policy/Modules/ProhibitEvilModules.pm
|
||||
lib/Perl/Critic/Policy/Modules/ProhibitExcessMainComplexity.pm
|
||||
lib/Perl/Critic/Policy/Modules/ProhibitMultiplePackages.pm
|
||||
lib/Perl/Critic/Policy/Modules/RequireBarewordIncludes.pm
|
||||
lib/Perl/Critic/Policy/Modules/RequireEndWithOne.pm
|
||||
lib/Perl/Critic/Policy/Modules/RequireExplicitPackage.pm
|
||||
lib/Perl/Critic/Policy/Modules/RequireFilenameMatchesPackage.pm
|
||||
lib/Perl/Critic/Policy/Modules/RequireNoMatchVarsWithUseEnglish.pm
|
||||
lib/Perl/Critic/Policy/Modules/RequireVersionVar.pm
|
||||
lib/Perl/Critic/Policy/NamingConventions/Capitalization.pm
|
||||
lib/Perl/Critic/Policy/NamingConventions/ProhibitAmbiguousNames.pm
|
||||
lib/Perl/Critic/Policy/Objects/ProhibitIndirectSyntax.pm
|
||||
lib/Perl/Critic/Policy/References/ProhibitDoubleSigils.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/ProhibitCaptureWithoutTest.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/ProhibitComplexRegexes.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/ProhibitEnumeratedClasses.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/ProhibitEscapedMetacharacters.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/ProhibitFixedStringMatches.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/ProhibitSingleCharAlternation.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusedCapture.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusualDelimiters.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/ProhibitUselessTopic.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/RequireBracesForMultiline.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/RequireDotMatchAnything.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/RequireExtendedFormatting.pm
|
||||
lib/Perl/Critic/Policy/RegularExpressions/RequireLineBoundaryMatching.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/ProhibitAmpersandSigils.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/ProhibitBuiltinHomonyms.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/ProhibitExcessComplexity.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/ProhibitExplicitReturnUndef.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/ProhibitManyArgs.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/ProhibitNestedSubs.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/ProhibitReturnSort.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/ProhibitSubroutinePrototypes.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/ProhibitUnusedPrivateSubroutines.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/ProtectPrivateSubs.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/RequireArgUnpacking.pm
|
||||
lib/Perl/Critic/Policy/Subroutines/RequireFinalReturn.pm
|
||||
lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitNoStrict.pm
|
||||
lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitNoWarnings.pm
|
||||
lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitProlongedStrictureOverride.pm
|
||||
lib/Perl/Critic/Policy/TestingAndDebugging/RequireTestLabels.pm
|
||||
lib/Perl/Critic/Policy/TestingAndDebugging/RequireUseStrict.pm
|
||||
lib/Perl/Critic/Policy/TestingAndDebugging/RequireUseWarnings.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitCommaSeparatedStatements.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitComplexVersion.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitConstantPragma.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyQuotes.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEscapedCharacters.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitImplicitNewlines.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitInterpolationOfLiterals.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLeadingZeros.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLongChainsOfMethodCalls.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMagicNumbers.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMismatchedOperators.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMixedBooleanOperators.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNoisyQuotes.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitQuotesAsQuotelikeOperatorDelimiters.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitSpecialLiteralHeredocTerminator.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitVersionStrings.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/RequireConstantVersion.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/RequireInterpolationOfMetachars.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/RequireNumberSeparators.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/RequireQuotedHeredocTerminator.pm
|
||||
lib/Perl/Critic/Policy/ValuesAndExpressions/RequireUpperCaseHeredocTerminator.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProhibitAugmentedAssignmentInDeclaration.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProhibitConditionalDeclarations.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProhibitEvilVariables.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProhibitLocalVars.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProhibitMatchVars.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProhibitPackageVars.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProhibitPerl4PackageNames.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProhibitPunctuationVars.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProhibitReusedNames.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProhibitUnusedVariables.pm
|
||||
lib/Perl/Critic/Policy/Variables/ProtectPrivateVars.pm
|
||||
lib/Perl/Critic/Policy/Variables/RequireInitializationForLocalVars.pm
|
||||
lib/Perl/Critic/Policy/Variables/RequireLexicalLoopIterators.pm
|
||||
lib/Perl/Critic/Policy/Variables/RequireLocalizedPunctuationVars.pm
|
||||
lib/Perl/Critic/Policy/Variables/RequireNegativeIndices.pm
|
||||
lib/Perl/Critic/PolicyConfig.pm
|
||||
lib/Perl/Critic/PolicyFactory.pm
|
||||
lib/Perl/Critic/PolicyListing.pm
|
||||
lib/Perl/Critic/PolicyParameter.pm
|
||||
lib/Perl/Critic/PolicyParameter/Behavior.pm
|
||||
lib/Perl/Critic/PolicyParameter/Behavior/Boolean.pm
|
||||
lib/Perl/Critic/PolicyParameter/Behavior/Enumeration.pm
|
||||
lib/Perl/Critic/PolicyParameter/Behavior/Integer.pm
|
||||
lib/Perl/Critic/PolicyParameter/Behavior/String.pm
|
||||
lib/Perl/Critic/PolicyParameter/Behavior/StringList.pm
|
||||
lib/Perl/Critic/PolicySummary.pod
|
||||
lib/Perl/Critic/ProfilePrototype.pm
|
||||
lib/Perl/Critic/Statistics.pm
|
||||
lib/Perl/Critic/TestUtils.pm
|
||||
lib/Perl/Critic/Theme.pm
|
||||
lib/Perl/Critic/ThemeListing.pm
|
||||
lib/Perl/Critic/UserProfile.pm
|
||||
lib/Perl/Critic/Utils.pm
|
||||
lib/Perl/Critic/Utils/Constants.pm
|
||||
lib/Perl/Critic/Utils/DataConversion.pm
|
||||
lib/Perl/Critic/Utils/McCabe.pm
|
||||
lib/Perl/Critic/Utils/Perl.pm
|
||||
lib/Perl/Critic/Utils/POD.pm
|
||||
lib/Perl/Critic/Utils/POD/ParseInteriorSequence.pm
|
||||
lib/Perl/Critic/Utils/PPI.pm
|
||||
lib/Perl/Critic/Violation.pm
|
||||
lib/Test/Perl/Critic/Policy.pm
|
||||
LICENSE
|
||||
MANIFEST This list of files
|
||||
META.json
|
||||
META.yml
|
||||
README
|
||||
README.md
|
||||
t/00_modules.t
|
||||
t/00_versions.t
|
||||
t/01_bad_perlcriticrc
|
||||
t/01_config.t
|
||||
t/01_config_bad_perlcriticrc.t
|
||||
t/01_policy_config.t
|
||||
t/02_policy.t
|
||||
t/03_annotations.t
|
||||
t/03_pragmas.t
|
||||
t/04_options_processor.t
|
||||
t/05_utils.t
|
||||
t/05_utils_perl.t
|
||||
t/05_utils_pod.t
|
||||
t/05_utils_ppi.t
|
||||
t/06_violation.d/lib/Perl/Critic/Policy/Test.pm
|
||||
t/06_violation.d/lib/ViolationTest.pm
|
||||
t/06_violation.d/lib/ViolationTest2.pm
|
||||
t/06_violation.d/source/Line.pm
|
||||
t/06_violation.t
|
||||
t/07_command.t
|
||||
t/07_perlcritic.t
|
||||
t/08_document.t
|
||||
t/09_theme.t
|
||||
t/10_user_profile.t
|
||||
t/11_policy_factory.t
|
||||
t/12_policy_listing.t
|
||||
t/12_theme_listing.t
|
||||
t/13_bundled_policies.t
|
||||
t/14_policy_parameter_behavior_boolean.t
|
||||
t/14_policy_parameter_behavior_enumeration.t
|
||||
t/14_policy_parameter_behavior_integer.t
|
||||
t/14_policy_parameter_behavior_list_string.t
|
||||
t/14_policy_parameter_behavior_string.t
|
||||
t/14_policy_parameters.t
|
||||
t/15_statistics.t
|
||||
t/16_roundtrip_defaults.t
|
||||
t/20_policies.t
|
||||
t/20_policy_pod_spelling.d/stop-words.txt
|
||||
t/20_policy_pod_spelling.t
|
||||
t/20_policy_prohibit_evil_modules.t
|
||||
t/20_policy_prohibit_hard_tabs.t
|
||||
t/20_policy_prohibit_trailing_whitespace.t
|
||||
t/20_policy_require_consistent_newlines.t
|
||||
t/20_policy_require_tidy_code.t
|
||||
t/92_memory_leaks.t
|
||||
t/BuiltinFunctions/ProhibitBooleanGrep.run
|
||||
t/BuiltinFunctions/ProhibitComplexMappings.run
|
||||
t/BuiltinFunctions/ProhibitLvalueSubstr.run
|
||||
t/BuiltinFunctions/ProhibitReverseSortBlock.run
|
||||
t/BuiltinFunctions/ProhibitShiftRef.run
|
||||
t/BuiltinFunctions/ProhibitSleepViaSelect.run
|
||||
t/BuiltinFunctions/ProhibitStringyEval.run
|
||||
t/BuiltinFunctions/ProhibitStringySplit.run
|
||||
t/BuiltinFunctions/ProhibitUniversalCan.run
|
||||
t/BuiltinFunctions/ProhibitUniversalIsa.run
|
||||
t/BuiltinFunctions/ProhibitUselessTopic.run
|
||||
t/BuiltinFunctions/ProhibitVoidGrep.run
|
||||
t/BuiltinFunctions/ProhibitVoidMap.run
|
||||
t/BuiltinFunctions/RequireBlockGrep.run
|
||||
t/BuiltinFunctions/RequireBlockMap.run
|
||||
t/BuiltinFunctions/RequireGlobFunction.run
|
||||
t/BuiltinFunctions/RequireSimpleSortBlock.run
|
||||
t/ClassHierarchies/ProhibitAutoloading.run
|
||||
t/ClassHierarchies/ProhibitExplicitISA.run
|
||||
t/ClassHierarchies/ProhibitOneArgBless.run
|
||||
t/CodeLayout/ProhibitParensWithBuiltins.run
|
||||
t/CodeLayout/ProhibitQuotedWordLists.run
|
||||
t/CodeLayout/RequireTrailingCommas.run
|
||||
t/ControlStructures/ProhibitCascadingIfElse.run
|
||||
t/ControlStructures/ProhibitCStyleForLoops.run
|
||||
t/ControlStructures/ProhibitDeepNests.run
|
||||
t/ControlStructures/ProhibitLabelsWithSpecialBlockNames.run
|
||||
t/ControlStructures/ProhibitMutatingListFunctions.run
|
||||
t/ControlStructures/ProhibitNegativeExpressionsInUnlessAndUntilConditions.run.PL
|
||||
t/ControlStructures/ProhibitPostfixControls.run
|
||||
t/ControlStructures/ProhibitUnlessBlocks.run
|
||||
t/ControlStructures/ProhibitUnreachableCode.run
|
||||
t/ControlStructures/ProhibitUntilBlocks.run
|
||||
t/ControlStructures/ProhibitYadaOperator.run
|
||||
t/Documentation/RequirePackageMatchesPodName.run
|
||||
t/Documentation/RequirePodAtEnd.run
|
||||
t/Documentation/RequirePodSections.run
|
||||
t/ErrorHandling/RequireCarping.run
|
||||
t/ErrorHandling/RequireCheckingReturnValueOfEval.run
|
||||
t/gh-734.t
|
||||
t/InputOutput/ProhibitBacktickOperators.run
|
||||
t/InputOutput/ProhibitBarewordFileHandles.run
|
||||
t/InputOutput/ProhibitExplicitStdin.run
|
||||
t/InputOutput/ProhibitInteractiveTest.run
|
||||
t/InputOutput/ProhibitJoinedReadline.run
|
||||
t/InputOutput/ProhibitOneArgSelect.run
|
||||
t/InputOutput/ProhibitReadlineInForLoop.run
|
||||
t/InputOutput/ProhibitTwoArgOpen.run
|
||||
t/InputOutput/RequireBracedFileHandleWithPrint.run
|
||||
t/InputOutput/RequireBriefOpen.run
|
||||
t/InputOutput/RequireCheckedClose.run
|
||||
t/InputOutput/RequireCheckedOpen.run
|
||||
t/InputOutput/RequireCheckedSyscalls.run
|
||||
t/InputOutput/RequireEncodingWithUTF8Layer.run
|
||||
t/Miscellanea/ProhibitFormats.run
|
||||
t/Miscellanea/ProhibitTies.run
|
||||
t/Miscellanea/ProhibitUnrestrictedNoCritic.run
|
||||
t/Modules/ProhibitAutomaticExportation.run
|
||||
t/Modules/ProhibitConditionalUseStatements.run
|
||||
t/Modules/ProhibitEvilModules.d/modules-no-regular-expressions.txt
|
||||
t/Modules/ProhibitEvilModules.d/modules-regular-expressions.txt
|
||||
t/Modules/ProhibitEvilModules.run
|
||||
t/Modules/ProhibitExcessMainComplexity.run
|
||||
t/Modules/ProhibitMultiplePackages.run
|
||||
t/Modules/RequireBarewordIncludes.run
|
||||
t/Modules/RequireEndWithOne.run
|
||||
t/Modules/RequireExplicitPackage.run
|
||||
t/Modules/RequireFilenameMatchesPackage.run
|
||||
t/Modules/RequireNoMatchVarsWithUseEnglish.run
|
||||
t/Modules/RequireVersionVar.run
|
||||
t/NamingConventions/Capitalization.run.PL
|
||||
t/NamingConventions/ProhibitAmbiguousNames.run
|
||||
t/Objects/ProhibitIndirectSyntax.run
|
||||
t/References/ProhibitDoubleSigils.run
|
||||
t/RegularExpressions/ProhibitCaptureWithoutTest.run
|
||||
t/RegularExpressions/ProhibitComplexRegexes.run
|
||||
t/RegularExpressions/ProhibitEnumeratedClasses.run
|
||||
t/RegularExpressions/ProhibitEscapedMetacharacters.run
|
||||
t/RegularExpressions/ProhibitFixedStringMatches.run
|
||||
t/RegularExpressions/ProhibitSingleCharAlternation.run
|
||||
t/RegularExpressions/ProhibitUnusedCapture.run
|
||||
t/RegularExpressions/ProhibitUnusualDelimiters.run
|
||||
t/RegularExpressions/ProhibitUselessTopic.run
|
||||
t/RegularExpressions/RequireBracesForMultiline.run
|
||||
t/RegularExpressions/RequireDotMatchAnything.run
|
||||
t/RegularExpressions/RequireExtendedFormatting.run
|
||||
t/RegularExpressions/RequireLineBoundaryMatching.run
|
||||
t/Subroutines/ProhibitAmpersandSigils.run
|
||||
t/Subroutines/ProhibitBuiltinHomonyms.run
|
||||
t/Subroutines/ProhibitExcessComplexity.run
|
||||
t/Subroutines/ProhibitExplicitReturnUndef.run
|
||||
t/Subroutines/ProhibitManyArgs.run
|
||||
t/Subroutines/ProhibitNestedSubs.run
|
||||
t/Subroutines/ProhibitReturnSort.run
|
||||
t/Subroutines/ProhibitSubroutinePrototypes.run
|
||||
t/Subroutines/ProhibitUnusedPrivateSubroutines.run
|
||||
t/Subroutines/ProtectPrivateSubs.run
|
||||
t/Subroutines/RequireArgUnpacking.run
|
||||
t/Subroutines/RequireFinalReturn.run
|
||||
t/TestingAndDebugging/ProhibitNoStrict.run
|
||||
t/TestingAndDebugging/ProhibitNoWarnings.run
|
||||
t/TestingAndDebugging/ProhibitProlongedStrictureOverride.run
|
||||
t/TestingAndDebugging/RequireTestLabels.run
|
||||
t/TestingAndDebugging/RequireUseStrict.run
|
||||
t/TestingAndDebugging/RequireUseWarnings.run
|
||||
t/ValuesAndExpressions/ProhibitCommaSeparatedStatements.run
|
||||
t/ValuesAndExpressions/ProhibitComplexVersion.run
|
||||
t/ValuesAndExpressions/ProhibitConstantPragma.run
|
||||
t/ValuesAndExpressions/ProhibitEmptyQuotes.run
|
||||
t/ValuesAndExpressions/ProhibitEscapedCharacters.run
|
||||
t/ValuesAndExpressions/ProhibitImplicitNewlines.run
|
||||
t/ValuesAndExpressions/ProhibitInterpolationOfLiterals.run
|
||||
t/ValuesAndExpressions/ProhibitLeadingZeros.run
|
||||
t/ValuesAndExpressions/ProhibitLongChainsOfMethodCalls.run
|
||||
t/ValuesAndExpressions/ProhibitMagicNumbers.run
|
||||
t/ValuesAndExpressions/ProhibitMismatchedOperators.run
|
||||
t/ValuesAndExpressions/ProhibitMixedBooleanOperators.run
|
||||
t/ValuesAndExpressions/ProhibitNoisyQuotes.run
|
||||
t/ValuesAndExpressions/ProhibitQuotesAsQuotelikeOperatorDelimiters.run
|
||||
t/ValuesAndExpressions/ProhibitSpecialLiteralHeredocTerminator.run
|
||||
t/ValuesAndExpressions/ProhibitVersionStrings.run
|
||||
t/ValuesAndExpressions/RequireConstantVersion.run
|
||||
t/ValuesAndExpressions/RequireInterpolationOfMetachars.run
|
||||
t/ValuesAndExpressions/RequireNumberSeparators.run
|
||||
t/ValuesAndExpressions/RequireQuotedHeredocTerminator.run
|
||||
t/ValuesAndExpressions/RequireUpperCaseHeredocTerminator.run
|
||||
t/Variables/ProhibitAugmentedAssignmentInDeclaration.run
|
||||
t/Variables/ProhibitConditionalDeclarations.run
|
||||
t/Variables/ProhibitEvilVariables.d/variables-no-regular-expressions.txt
|
||||
t/Variables/ProhibitEvilVariables.d/variables-regular-expressions.txt
|
||||
t/Variables/ProhibitEvilVariables.run
|
||||
t/Variables/ProhibitLocalVars.run
|
||||
t/Variables/ProhibitMatchVars.run
|
||||
t/Variables/ProhibitPackageVars.run
|
||||
t/Variables/ProhibitPerl4PackageNames.run
|
||||
t/Variables/ProhibitPunctuationVars.run
|
||||
t/Variables/ProhibitReusedNames.run
|
||||
t/Variables/ProhibitUnusedVariables.run
|
||||
t/Variables/ProtectPrivateVars.run
|
||||
t/Variables/RequireInitializationForLocalVars.run
|
||||
t/Variables/RequireLexicalLoopIterators.run
|
||||
t/Variables/RequireLocalizedPunctuationVars.run.PL
|
||||
t/Variables/RequireNegativeIndices.run
|
||||
TODO.pod
|
||||
tools/ppidump
|
||||
xt/40_criticize-code.t
|
||||
xt/40_perlcriticrc-code
|
||||
xt/40_stop_words
|
||||
xt/41_criticize-policies.t
|
||||
xt/41_perlcriticrc-policies
|
||||
xt/42_criticize-tests.t
|
||||
xt/42_perlcriticrc-tests
|
||||
xt/43_criticize-run-files.t
|
||||
xt/43_perlcriticrc-run-files
|
||||
xt/80_policysummary.t
|
||||
xt/81_ppi_problems.t
|
||||
xt/94_includes.t
|
||||
xt/95_kwalitee.t
|
||||
xt/98_pod_syntax.t
|
||||
xt/99_pod_coverage.t
|
||||
|
|
@ -0,0 +1,896 @@
|
|||
{
|
||||
"abstract" : "Critique Perl source code for best-practices.",
|
||||
"author" : [
|
||||
"Jeffrey Thalhammer <jeff@imaginative-software.com>"
|
||||
],
|
||||
"dynamic_config" : 1,
|
||||
"generated_by" : "Module::Build version 0.4231",
|
||||
"license" : [
|
||||
"perl_5"
|
||||
],
|
||||
"meta-spec" : {
|
||||
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
|
||||
"version" : 2
|
||||
},
|
||||
"name" : "Perl-Critic",
|
||||
"no_index" : {
|
||||
"directory" : [
|
||||
"doc",
|
||||
"inc",
|
||||
"tools",
|
||||
"xt"
|
||||
],
|
||||
"file" : [
|
||||
"TODO.pod"
|
||||
]
|
||||
},
|
||||
"prereqs" : {
|
||||
"build" : {
|
||||
"requires" : {
|
||||
"Test::Deep" : "0",
|
||||
"Test::More" : "0",
|
||||
"lib" : "0"
|
||||
}
|
||||
},
|
||||
"configure" : {
|
||||
"requires" : {
|
||||
"Module::Build" : "0.4204"
|
||||
}
|
||||
},
|
||||
"runtime" : {
|
||||
"requires" : {
|
||||
"B::Keywords" : "1.05",
|
||||
"Carp" : "0",
|
||||
"Config::Tiny" : "2",
|
||||
"English" : "0",
|
||||
"Exception::Class" : "1.23",
|
||||
"Exporter" : "5.63",
|
||||
"Fatal" : "0",
|
||||
"File::Basename" : "0",
|
||||
"File::Find" : "0",
|
||||
"File::Path" : "0",
|
||||
"File::Spec" : "0",
|
||||
"File::Spec::Unix" : "0",
|
||||
"File::Temp" : "0",
|
||||
"File::Which" : "0",
|
||||
"Getopt::Long" : "0",
|
||||
"IO::String" : "0",
|
||||
"IPC::Open2" : "1",
|
||||
"List::MoreUtils" : "0.19",
|
||||
"List::Util" : "0",
|
||||
"Module::Build" : "0.4204",
|
||||
"Module::Pluggable" : "3.1",
|
||||
"PPI" : "1.265",
|
||||
"PPI::Document" : "1.265",
|
||||
"PPI::Document::File" : "1.265",
|
||||
"PPI::Node" : "1.265",
|
||||
"PPI::Token::Quote::Single" : "1.265",
|
||||
"PPI::Token::Whitespace" : "1.265",
|
||||
"PPIx::QuoteLike" : "0",
|
||||
"PPIx::Regexp" : "0.027",
|
||||
"PPIx::Regexp::Util" : "0.068",
|
||||
"PPIx::Utilities::Node" : "1.001",
|
||||
"PPIx::Utilities::Statement" : "1.001",
|
||||
"Perl::Tidy" : "0",
|
||||
"Pod::Parser" : "0",
|
||||
"Pod::PlainText" : "0",
|
||||
"Pod::Select" : "0",
|
||||
"Pod::Spell" : "1",
|
||||
"Pod::Usage" : "0",
|
||||
"Readonly" : "2",
|
||||
"Scalar::Util" : "0",
|
||||
"String::Format" : "1.18",
|
||||
"Task::Weaken" : "0",
|
||||
"Term::ANSIColor" : "2.02",
|
||||
"Test::Builder" : "0.92",
|
||||
"Text::ParseWords" : "3",
|
||||
"base" : "0",
|
||||
"charnames" : "0",
|
||||
"overload" : "0",
|
||||
"perl" : "5.006001",
|
||||
"strict" : "0",
|
||||
"version" : "0.77",
|
||||
"warnings" : "0"
|
||||
}
|
||||
}
|
||||
},
|
||||
"provides" : {
|
||||
"Perl::Critic" : {
|
||||
"file" : "lib/Perl/Critic.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Annotation" : {
|
||||
"file" : "lib/Perl/Critic/Annotation.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Command" : {
|
||||
"file" : "lib/Perl/Critic/Command.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Config" : {
|
||||
"file" : "lib/Perl/Critic/Config.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Document" : {
|
||||
"file" : "lib/Perl/Critic/Document.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception" : {
|
||||
"file" : "lib/Perl/Critic/Exception.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::AggregateConfiguration" : {
|
||||
"file" : "lib/Perl/Critic/Exception/AggregateConfiguration.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Configuration" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Configuration.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Configuration::Generic" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Configuration/Generic.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Configuration::NonExistentPolicy" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Configuration/NonExistentPolicy.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Configuration::Option" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Configuration/Option.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Configuration::Option::Global" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Configuration/Option/Global.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Configuration/Option/Global/ExtraParameter.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Configuration::Option::Global::ParameterValue" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Configuration/Option/Global/ParameterValue.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Configuration::Option::Policy" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Configuration/Option/Policy.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Configuration::Option::Policy::ExtraParameter" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Configuration/Option/Policy/ExtraParameter.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Configuration/Option/Policy/ParameterValue.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Fatal" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Fatal.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Fatal::Generic" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Fatal/Generic.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Fatal::Internal" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Fatal/Internal.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Fatal::PolicyDefinition" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Fatal/PolicyDefinition.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::IO" : {
|
||||
"file" : "lib/Perl/Critic/Exception/IO.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Exception::Parse" : {
|
||||
"file" : "lib/Perl/Critic/Exception/Parse.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::OptionsProcessor" : {
|
||||
"file" : "lib/Perl/Critic/OptionsProcessor.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy" : {
|
||||
"file" : "lib/Perl/Critic/Policy.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitBooleanGrep" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitBooleanGrep.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitComplexMappings" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitComplexMappings.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitLvalueSubstr.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitReverseSortBlock" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitReverseSortBlock.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitShiftRef" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitShiftRef.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitSleepViaSelect.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringyEval.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringySplit.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitUniversalCan.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitUniversalIsa.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitUselessTopic" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitUselessTopic.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitVoidGrep.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitVoidMap.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrep.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockMap.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/RequireGlobFunction.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock" : {
|
||||
"file" : "lib/Perl/Critic/Policy/BuiltinFunctions/RequireSimpleSortBlock.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ClassHierarchies::ProhibitAutoloading" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ClassHierarchies/ProhibitAutoloading.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ClassHierarchies/ProhibitExplicitISA.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ClassHierarchies/ProhibitOneArgBless.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::CodeLayout::ProhibitHardTabs" : {
|
||||
"file" : "lib/Perl/Critic/Policy/CodeLayout/ProhibitHardTabs.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins" : {
|
||||
"file" : "lib/Perl/Critic/Policy/CodeLayout/ProhibitParensWithBuiltins.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists" : {
|
||||
"file" : "lib/Perl/Critic/Policy/CodeLayout/ProhibitQuotedWordLists.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::CodeLayout::ProhibitTrailingWhitespace" : {
|
||||
"file" : "lib/Perl/Critic/Policy/CodeLayout/ProhibitTrailingWhitespace.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines" : {
|
||||
"file" : "lib/Perl/Critic/Policy/CodeLayout/RequireConsistentNewlines.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::CodeLayout::RequireTidyCode" : {
|
||||
"file" : "lib/Perl/Critic/Policy/CodeLayout/RequireTidyCode.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::CodeLayout::RequireTrailingCommas" : {
|
||||
"file" : "lib/Perl/Critic/Policy/CodeLayout/RequireTrailingCommas.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitCStyleForLoops.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitCascadingIfElse.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitDeepNests" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitDeepNests.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitLabelsWithSpecialBlockNames.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitMutatingListFunctions.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitNegativeExpressionsInUnlessAndUntilConditions.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitPostfixControls.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitUnlessBlocks.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitUnreachableCode.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitUntilBlocks.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ControlStructures::ProhibitYadaOperator" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ControlStructures/ProhibitYadaOperator.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Documentation::PodSpelling" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Documentation/PodSpelling.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Documentation::RequirePackageMatchesPodName" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Documentation/RequirePackageMatchesPodName.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Documentation::RequirePodAtEnd" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Documentation/RequirePodAtEnd.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Documentation::RequirePodSections" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Documentation/RequirePodSections.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ErrorHandling::RequireCarping" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ErrorHandling/RequireCarping.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ErrorHandling/RequireCheckingReturnValueOfEval.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/ProhibitBacktickOperators.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/ProhibitBarewordFileHandles.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::ProhibitExplicitStdin" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/ProhibitExplicitStdin.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/ProhibitInteractiveTest.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::ProhibitJoinedReadline" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/ProhibitJoinedReadline.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/ProhibitOneArgSelect.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::ProhibitReadlineInForLoop" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/ProhibitReadlineInForLoop.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/ProhibitTwoArgOpen.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::RequireBracedFileHandleWithPrint" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/RequireBracedFileHandleWithPrint.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::RequireBriefOpen" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/RequireBriefOpen.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::RequireCheckedClose" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/RequireCheckedClose.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::RequireCheckedOpen" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/RequireCheckedOpen.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::RequireCheckedSyscalls" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/RequireCheckedSyscalls.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::InputOutput::RequireEncodingWithUTF8Layer" : {
|
||||
"file" : "lib/Perl/Critic/Policy/InputOutput/RequireEncodingWithUTF8Layer.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Miscellanea::ProhibitFormats" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Miscellanea/ProhibitFormats.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Miscellanea::ProhibitTies" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Miscellanea/ProhibitTies.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Miscellanea::ProhibitUnrestrictedNoCritic" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Miscellanea/ProhibitUnrestrictedNoCritic.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Miscellanea::ProhibitUselessNoCritic" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Miscellanea/ProhibitUselessNoCritic.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::ProhibitAutomaticExportation" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/ProhibitAutomaticExportation.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::ProhibitConditionalUseStatements" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/ProhibitConditionalUseStatements.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::ProhibitEvilModules" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/ProhibitEvilModules.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::ProhibitExcessMainComplexity" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/ProhibitExcessMainComplexity.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::ProhibitMultiplePackages" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/ProhibitMultiplePackages.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::RequireBarewordIncludes" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/RequireBarewordIncludes.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::RequireEndWithOne" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/RequireEndWithOne.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::RequireExplicitPackage" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/RequireExplicitPackage.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/RequireFilenameMatchesPackage.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::RequireNoMatchVarsWithUseEnglish" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/RequireNoMatchVarsWithUseEnglish.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Modules::RequireVersionVar" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Modules/RequireVersionVar.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::NamingConventions::Capitalization" : {
|
||||
"file" : "lib/Perl/Critic/Policy/NamingConventions/Capitalization.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames" : {
|
||||
"file" : "lib/Perl/Critic/Policy/NamingConventions/ProhibitAmbiguousNames.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Objects::ProhibitIndirectSyntax" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Objects/ProhibitIndirectSyntax.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::References::ProhibitDoubleSigils" : {
|
||||
"file" : "lib/Perl/Critic/Policy/References/ProhibitDoubleSigils.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/ProhibitCaptureWithoutTest.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::ProhibitComplexRegexes" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/ProhibitComplexRegexes.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::ProhibitEnumeratedClasses" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/ProhibitEnumeratedClasses.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::ProhibitEscapedMetacharacters" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/ProhibitEscapedMetacharacters.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::ProhibitFixedStringMatches" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/ProhibitFixedStringMatches.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::ProhibitSingleCharAlternation" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/ProhibitSingleCharAlternation.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::ProhibitUnusedCapture" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusedCapture.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::ProhibitUnusualDelimiters" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusualDelimiters.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::ProhibitUselessTopic" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/ProhibitUselessTopic.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::RequireBracesForMultiline" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/RequireBracesForMultiline.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::RequireDotMatchAnything" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/RequireDotMatchAnything.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/RequireExtendedFormatting.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching" : {
|
||||
"file" : "lib/Perl/Critic/Policy/RegularExpressions/RequireLineBoundaryMatching.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::ProhibitAmpersandSigils" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/ProhibitAmpersandSigils.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/ProhibitBuiltinHomonyms.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::ProhibitExcessComplexity" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/ProhibitExcessComplexity.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/ProhibitExplicitReturnUndef.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::ProhibitManyArgs" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/ProhibitManyArgs.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::ProhibitNestedSubs" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/ProhibitNestedSubs.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::ProhibitReturnSort" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/ProhibitReturnSort.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/ProhibitSubroutinePrototypes.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/ProhibitUnusedPrivateSubroutines.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::ProtectPrivateSubs" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/ProtectPrivateSubs.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::RequireArgUnpacking" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/RequireArgUnpacking.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Subroutines::RequireFinalReturn" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Subroutines/RequireFinalReturn.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict" : {
|
||||
"file" : "lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitNoStrict.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings" : {
|
||||
"file" : "lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitNoWarnings.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::TestingAndDebugging::ProhibitProlongedStrictureOverride" : {
|
||||
"file" : "lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitProlongedStrictureOverride.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::TestingAndDebugging::RequireTestLabels" : {
|
||||
"file" : "lib/Perl/Critic/Policy/TestingAndDebugging/RequireTestLabels.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict" : {
|
||||
"file" : "lib/Perl/Critic/Policy/TestingAndDebugging/RequireUseStrict.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings" : {
|
||||
"file" : "lib/Perl/Critic/Policy/TestingAndDebugging/RequireUseWarnings.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitCommaSeparatedStatements.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitComplexVersion.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitConstantPragma.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyQuotes.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitEscapedCharacters" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEscapedCharacters.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitImplicitNewlines" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitImplicitNewlines.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitInterpolationOfLiterals.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLeadingZeros.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLongChainsOfMethodCalls.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitMagicNumbers" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMagicNumbers.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitMismatchedOperators" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMismatchedOperators.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMixedBooleanOperators.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNoisyQuotes.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitQuotesAsQuotelikeOperatorDelimiters.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitSpecialLiteralHeredocTerminator.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitVersionStrings" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitVersionStrings.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/RequireConstantVersion.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/RequireInterpolationOfMetachars.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/RequireNumberSeparators.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/RequireQuotedHeredocTerminator.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator" : {
|
||||
"file" : "lib/Perl/Critic/Policy/ValuesAndExpressions/RequireUpperCaseHeredocTerminator.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProhibitAugmentedAssignmentInDeclaration" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProhibitAugmentedAssignmentInDeclaration.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProhibitConditionalDeclarations.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProhibitEvilVariables" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProhibitEvilVariables.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProhibitLocalVars" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProhibitLocalVars.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProhibitMatchVars" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProhibitMatchVars.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProhibitPackageVars" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProhibitPackageVars.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProhibitPerl4PackageNames" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProhibitPerl4PackageNames.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProhibitPunctuationVars" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProhibitPunctuationVars.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProhibitReusedNames" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProhibitReusedNames.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProhibitUnusedVariables" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProhibitUnusedVariables.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::ProtectPrivateVars" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/ProtectPrivateVars.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::RequireInitializationForLocalVars" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/RequireInitializationForLocalVars.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::RequireLexicalLoopIterators" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/RequireLexicalLoopIterators.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::RequireLocalizedPunctuationVars" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/RequireLocalizedPunctuationVars.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Policy::Variables::RequireNegativeIndices" : {
|
||||
"file" : "lib/Perl/Critic/Policy/Variables/RequireNegativeIndices.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::PolicyConfig" : {
|
||||
"file" : "lib/Perl/Critic/PolicyConfig.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::PolicyFactory" : {
|
||||
"file" : "lib/Perl/Critic/PolicyFactory.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::PolicyListing" : {
|
||||
"file" : "lib/Perl/Critic/PolicyListing.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::PolicyParameter" : {
|
||||
"file" : "lib/Perl/Critic/PolicyParameter.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::PolicyParameter::Behavior" : {
|
||||
"file" : "lib/Perl/Critic/PolicyParameter/Behavior.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::PolicyParameter::Behavior::Boolean" : {
|
||||
"file" : "lib/Perl/Critic/PolicyParameter/Behavior/Boolean.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::PolicyParameter::Behavior::Enumeration" : {
|
||||
"file" : "lib/Perl/Critic/PolicyParameter/Behavior/Enumeration.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::PolicyParameter::Behavior::Integer" : {
|
||||
"file" : "lib/Perl/Critic/PolicyParameter/Behavior/Integer.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::PolicyParameter::Behavior::String" : {
|
||||
"file" : "lib/Perl/Critic/PolicyParameter/Behavior/String.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::PolicyParameter::Behavior::StringList" : {
|
||||
"file" : "lib/Perl/Critic/PolicyParameter/Behavior/StringList.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::ProfilePrototype" : {
|
||||
"file" : "lib/Perl/Critic/ProfilePrototype.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Statistics" : {
|
||||
"file" : "lib/Perl/Critic/Statistics.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::TestUtils" : {
|
||||
"file" : "lib/Perl/Critic/TestUtils.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Theme" : {
|
||||
"file" : "lib/Perl/Critic/Theme.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::ThemeListing" : {
|
||||
"file" : "lib/Perl/Critic/ThemeListing.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::UserProfile" : {
|
||||
"file" : "lib/Perl/Critic/UserProfile.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Utils" : {
|
||||
"file" : "lib/Perl/Critic/Utils.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Utils::Constants" : {
|
||||
"file" : "lib/Perl/Critic/Utils/Constants.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Utils::DataConversion" : {
|
||||
"file" : "lib/Perl/Critic/Utils/DataConversion.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Utils::McCabe" : {
|
||||
"file" : "lib/Perl/Critic/Utils/McCabe.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Utils::POD" : {
|
||||
"file" : "lib/Perl/Critic/Utils/POD.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Utils::POD::ParseInteriorSequence" : {
|
||||
"file" : "lib/Perl/Critic/Utils/POD/ParseInteriorSequence.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Utils::PPI" : {
|
||||
"file" : "lib/Perl/Critic/Utils/PPI.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Utils::Perl" : {
|
||||
"file" : "lib/Perl/Critic/Utils/Perl.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Perl::Critic::Violation" : {
|
||||
"file" : "lib/Perl/Critic/Violation.pm",
|
||||
"version" : "1.140"
|
||||
},
|
||||
"Test::Perl::Critic::Policy" : {
|
||||
"file" : "lib/Test/Perl/Critic/Policy.pm",
|
||||
"version" : "1.140"
|
||||
}
|
||||
},
|
||||
"release_status" : "stable",
|
||||
"resources" : {
|
||||
"bugtracker" : {
|
||||
"web" : "https://github.com/Perl-Critic/Perl-Critic/issues"
|
||||
},
|
||||
"homepage" : "http://perlcritic.com",
|
||||
"license" : [
|
||||
"http://dev.perl.org/licenses/"
|
||||
],
|
||||
"repository" : {
|
||||
"url" : "git://github.com/Perl-Critic/Perl-Critic.git"
|
||||
},
|
||||
"x_MailingList" : "https://groups.google.com/d/forum/perl-critic"
|
||||
},
|
||||
"version" : "1.140",
|
||||
"x_authority" : "cpan:CRITICRE",
|
||||
"x_serialization_backend" : "JSON::PP version 4.04"
|
||||
}
|
||||
|
|
@ -0,0 +1,673 @@
|
|||
---
|
||||
abstract: 'Critique Perl source code for best-practices.'
|
||||
author:
|
||||
- 'Jeffrey Thalhammer <jeff@imaginative-software.com>'
|
||||
build_requires:
|
||||
Test::Deep: '0'
|
||||
Test::More: '0'
|
||||
lib: '0'
|
||||
configure_requires:
|
||||
Module::Build: '0.4204'
|
||||
dynamic_config: 1
|
||||
generated_by: 'Module::Build version 0.4231, CPAN::Meta::Converter version 2.150010'
|
||||
license: perl
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.4.html
|
||||
version: '1.4'
|
||||
name: Perl-Critic
|
||||
no_index:
|
||||
directory:
|
||||
- doc
|
||||
- inc
|
||||
- tools
|
||||
- xt
|
||||
file:
|
||||
- TODO.pod
|
||||
provides:
|
||||
Perl::Critic:
|
||||
file: lib/Perl/Critic.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Annotation:
|
||||
file: lib/Perl/Critic/Annotation.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Command:
|
||||
file: lib/Perl/Critic/Command.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Config:
|
||||
file: lib/Perl/Critic/Config.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Document:
|
||||
file: lib/Perl/Critic/Document.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception:
|
||||
file: lib/Perl/Critic/Exception.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::AggregateConfiguration:
|
||||
file: lib/Perl/Critic/Exception/AggregateConfiguration.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Configuration:
|
||||
file: lib/Perl/Critic/Exception/Configuration.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Configuration::Generic:
|
||||
file: lib/Perl/Critic/Exception/Configuration/Generic.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Configuration::NonExistentPolicy:
|
||||
file: lib/Perl/Critic/Exception/Configuration/NonExistentPolicy.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Configuration::Option:
|
||||
file: lib/Perl/Critic/Exception/Configuration/Option.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Configuration::Option::Global:
|
||||
file: lib/Perl/Critic/Exception/Configuration/Option/Global.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter:
|
||||
file: lib/Perl/Critic/Exception/Configuration/Option/Global/ExtraParameter.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Configuration::Option::Global::ParameterValue:
|
||||
file: lib/Perl/Critic/Exception/Configuration/Option/Global/ParameterValue.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Configuration::Option::Policy:
|
||||
file: lib/Perl/Critic/Exception/Configuration/Option/Policy.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Configuration::Option::Policy::ExtraParameter:
|
||||
file: lib/Perl/Critic/Exception/Configuration/Option/Policy/ExtraParameter.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue:
|
||||
file: lib/Perl/Critic/Exception/Configuration/Option/Policy/ParameterValue.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Fatal:
|
||||
file: lib/Perl/Critic/Exception/Fatal.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Fatal::Generic:
|
||||
file: lib/Perl/Critic/Exception/Fatal/Generic.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Fatal::Internal:
|
||||
file: lib/Perl/Critic/Exception/Fatal/Internal.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Fatal::PolicyDefinition:
|
||||
file: lib/Perl/Critic/Exception/Fatal/PolicyDefinition.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::IO:
|
||||
file: lib/Perl/Critic/Exception/IO.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Exception::Parse:
|
||||
file: lib/Perl/Critic/Exception/Parse.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::OptionsProcessor:
|
||||
file: lib/Perl/Critic/OptionsProcessor.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy:
|
||||
file: lib/Perl/Critic/Policy.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitBooleanGrep:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitBooleanGrep.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitComplexMappings:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitComplexMappings.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitLvalueSubstr.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitReverseSortBlock:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitReverseSortBlock.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitShiftRef:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitShiftRef.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitSleepViaSelect.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringyEval.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringySplit.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitUniversalCan.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitUniversalIsa.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitUselessTopic:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitUselessTopic.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitVoidGrep.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitVoidMap.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrep.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockMap.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/RequireGlobFunction.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock:
|
||||
file: lib/Perl/Critic/Policy/BuiltinFunctions/RequireSimpleSortBlock.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ClassHierarchies::ProhibitAutoloading:
|
||||
file: lib/Perl/Critic/Policy/ClassHierarchies/ProhibitAutoloading.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA:
|
||||
file: lib/Perl/Critic/Policy/ClassHierarchies/ProhibitExplicitISA.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless:
|
||||
file: lib/Perl/Critic/Policy/ClassHierarchies/ProhibitOneArgBless.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::CodeLayout::ProhibitHardTabs:
|
||||
file: lib/Perl/Critic/Policy/CodeLayout/ProhibitHardTabs.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins:
|
||||
file: lib/Perl/Critic/Policy/CodeLayout/ProhibitParensWithBuiltins.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists:
|
||||
file: lib/Perl/Critic/Policy/CodeLayout/ProhibitQuotedWordLists.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::CodeLayout::ProhibitTrailingWhitespace:
|
||||
file: lib/Perl/Critic/Policy/CodeLayout/ProhibitTrailingWhitespace.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines:
|
||||
file: lib/Perl/Critic/Policy/CodeLayout/RequireConsistentNewlines.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::CodeLayout::RequireTidyCode:
|
||||
file: lib/Perl/Critic/Policy/CodeLayout/RequireTidyCode.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::CodeLayout::RequireTrailingCommas:
|
||||
file: lib/Perl/Critic/Policy/CodeLayout/RequireTrailingCommas.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitCStyleForLoops.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitCascadingIfElse.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitDeepNests:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitDeepNests.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitLabelsWithSpecialBlockNames.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitMutatingListFunctions.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitNegativeExpressionsInUnlessAndUntilConditions.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitPostfixControls.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitUnlessBlocks.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitUnreachableCode.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitUntilBlocks.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitYadaOperator:
|
||||
file: lib/Perl/Critic/Policy/ControlStructures/ProhibitYadaOperator.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Documentation::PodSpelling:
|
||||
file: lib/Perl/Critic/Policy/Documentation/PodSpelling.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Documentation::RequirePackageMatchesPodName:
|
||||
file: lib/Perl/Critic/Policy/Documentation/RequirePackageMatchesPodName.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Documentation::RequirePodAtEnd:
|
||||
file: lib/Perl/Critic/Policy/Documentation/RequirePodAtEnd.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Documentation::RequirePodSections:
|
||||
file: lib/Perl/Critic/Policy/Documentation/RequirePodSections.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ErrorHandling::RequireCarping:
|
||||
file: lib/Perl/Critic/Policy/ErrorHandling/RequireCarping.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval:
|
||||
file: lib/Perl/Critic/Policy/ErrorHandling/RequireCheckingReturnValueOfEval.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/ProhibitBacktickOperators.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/ProhibitBarewordFileHandles.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::ProhibitExplicitStdin:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/ProhibitExplicitStdin.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/ProhibitInteractiveTest.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::ProhibitJoinedReadline:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/ProhibitJoinedReadline.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/ProhibitOneArgSelect.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::ProhibitReadlineInForLoop:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/ProhibitReadlineInForLoop.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/ProhibitTwoArgOpen.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::RequireBracedFileHandleWithPrint:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/RequireBracedFileHandleWithPrint.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::RequireBriefOpen:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/RequireBriefOpen.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::RequireCheckedClose:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/RequireCheckedClose.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::RequireCheckedOpen:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/RequireCheckedOpen.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::RequireCheckedSyscalls:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/RequireCheckedSyscalls.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::InputOutput::RequireEncodingWithUTF8Layer:
|
||||
file: lib/Perl/Critic/Policy/InputOutput/RequireEncodingWithUTF8Layer.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Miscellanea::ProhibitFormats:
|
||||
file: lib/Perl/Critic/Policy/Miscellanea/ProhibitFormats.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Miscellanea::ProhibitTies:
|
||||
file: lib/Perl/Critic/Policy/Miscellanea/ProhibitTies.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Miscellanea::ProhibitUnrestrictedNoCritic:
|
||||
file: lib/Perl/Critic/Policy/Miscellanea/ProhibitUnrestrictedNoCritic.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Miscellanea::ProhibitUselessNoCritic:
|
||||
file: lib/Perl/Critic/Policy/Miscellanea/ProhibitUselessNoCritic.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::ProhibitAutomaticExportation:
|
||||
file: lib/Perl/Critic/Policy/Modules/ProhibitAutomaticExportation.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::ProhibitConditionalUseStatements:
|
||||
file: lib/Perl/Critic/Policy/Modules/ProhibitConditionalUseStatements.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::ProhibitEvilModules:
|
||||
file: lib/Perl/Critic/Policy/Modules/ProhibitEvilModules.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::ProhibitExcessMainComplexity:
|
||||
file: lib/Perl/Critic/Policy/Modules/ProhibitExcessMainComplexity.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::ProhibitMultiplePackages:
|
||||
file: lib/Perl/Critic/Policy/Modules/ProhibitMultiplePackages.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::RequireBarewordIncludes:
|
||||
file: lib/Perl/Critic/Policy/Modules/RequireBarewordIncludes.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::RequireEndWithOne:
|
||||
file: lib/Perl/Critic/Policy/Modules/RequireEndWithOne.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::RequireExplicitPackage:
|
||||
file: lib/Perl/Critic/Policy/Modules/RequireExplicitPackage.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage:
|
||||
file: lib/Perl/Critic/Policy/Modules/RequireFilenameMatchesPackage.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::RequireNoMatchVarsWithUseEnglish:
|
||||
file: lib/Perl/Critic/Policy/Modules/RequireNoMatchVarsWithUseEnglish.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Modules::RequireVersionVar:
|
||||
file: lib/Perl/Critic/Policy/Modules/RequireVersionVar.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::NamingConventions::Capitalization:
|
||||
file: lib/Perl/Critic/Policy/NamingConventions/Capitalization.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames:
|
||||
file: lib/Perl/Critic/Policy/NamingConventions/ProhibitAmbiguousNames.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Objects::ProhibitIndirectSyntax:
|
||||
file: lib/Perl/Critic/Policy/Objects/ProhibitIndirectSyntax.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::References::ProhibitDoubleSigils:
|
||||
file: lib/Perl/Critic/Policy/References/ProhibitDoubleSigils.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/ProhibitCaptureWithoutTest.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::ProhibitComplexRegexes:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/ProhibitComplexRegexes.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::ProhibitEnumeratedClasses:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/ProhibitEnumeratedClasses.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::ProhibitEscapedMetacharacters:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/ProhibitEscapedMetacharacters.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::ProhibitFixedStringMatches:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/ProhibitFixedStringMatches.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::ProhibitSingleCharAlternation:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/ProhibitSingleCharAlternation.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::ProhibitUnusedCapture:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusedCapture.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::ProhibitUnusualDelimiters:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusualDelimiters.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::ProhibitUselessTopic:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/ProhibitUselessTopic.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::RequireBracesForMultiline:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/RequireBracesForMultiline.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::RequireDotMatchAnything:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/RequireDotMatchAnything.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/RequireExtendedFormatting.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching:
|
||||
file: lib/Perl/Critic/Policy/RegularExpressions/RequireLineBoundaryMatching.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::ProhibitAmpersandSigils:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/ProhibitAmpersandSigils.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/ProhibitBuiltinHomonyms.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::ProhibitExcessComplexity:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/ProhibitExcessComplexity.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/ProhibitExplicitReturnUndef.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::ProhibitManyArgs:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/ProhibitManyArgs.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::ProhibitNestedSubs:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/ProhibitNestedSubs.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::ProhibitReturnSort:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/ProhibitReturnSort.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/ProhibitSubroutinePrototypes.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/ProhibitUnusedPrivateSubroutines.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::ProtectPrivateSubs:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/ProtectPrivateSubs.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::RequireArgUnpacking:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/RequireArgUnpacking.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Subroutines::RequireFinalReturn:
|
||||
file: lib/Perl/Critic/Policy/Subroutines/RequireFinalReturn.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict:
|
||||
file: lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitNoStrict.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings:
|
||||
file: lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitNoWarnings.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::TestingAndDebugging::ProhibitProlongedStrictureOverride:
|
||||
file: lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitProlongedStrictureOverride.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::TestingAndDebugging::RequireTestLabels:
|
||||
file: lib/Perl/Critic/Policy/TestingAndDebugging/RequireTestLabels.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict:
|
||||
file: lib/Perl/Critic/Policy/TestingAndDebugging/RequireUseStrict.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings:
|
||||
file: lib/Perl/Critic/Policy/TestingAndDebugging/RequireUseWarnings.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitCommaSeparatedStatements.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitComplexVersion.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitConstantPragma.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyQuotes.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitEscapedCharacters:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEscapedCharacters.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitImplicitNewlines:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitImplicitNewlines.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitInterpolationOfLiterals.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLeadingZeros.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLongChainsOfMethodCalls.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitMagicNumbers:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMagicNumbers.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitMismatchedOperators:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMismatchedOperators.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMixedBooleanOperators.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNoisyQuotes.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitQuotesAsQuotelikeOperatorDelimiters.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitSpecialLiteralHeredocTerminator.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::ProhibitVersionStrings:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitVersionStrings.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/RequireConstantVersion.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/RequireInterpolationOfMetachars.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/RequireNumberSeparators.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/RequireQuotedHeredocTerminator.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator:
|
||||
file: lib/Perl/Critic/Policy/ValuesAndExpressions/RequireUpperCaseHeredocTerminator.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProhibitAugmentedAssignmentInDeclaration:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProhibitAugmentedAssignmentInDeclaration.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProhibitConditionalDeclarations.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProhibitEvilVariables:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProhibitEvilVariables.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProhibitLocalVars:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProhibitLocalVars.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProhibitMatchVars:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProhibitMatchVars.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProhibitPackageVars:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProhibitPackageVars.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProhibitPerl4PackageNames:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProhibitPerl4PackageNames.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProhibitPunctuationVars:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProhibitPunctuationVars.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProhibitReusedNames:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProhibitReusedNames.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProhibitUnusedVariables:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProhibitUnusedVariables.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::ProtectPrivateVars:
|
||||
file: lib/Perl/Critic/Policy/Variables/ProtectPrivateVars.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::RequireInitializationForLocalVars:
|
||||
file: lib/Perl/Critic/Policy/Variables/RequireInitializationForLocalVars.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::RequireLexicalLoopIterators:
|
||||
file: lib/Perl/Critic/Policy/Variables/RequireLexicalLoopIterators.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::RequireLocalizedPunctuationVars:
|
||||
file: lib/Perl/Critic/Policy/Variables/RequireLocalizedPunctuationVars.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Policy::Variables::RequireNegativeIndices:
|
||||
file: lib/Perl/Critic/Policy/Variables/RequireNegativeIndices.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::PolicyConfig:
|
||||
file: lib/Perl/Critic/PolicyConfig.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::PolicyFactory:
|
||||
file: lib/Perl/Critic/PolicyFactory.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::PolicyListing:
|
||||
file: lib/Perl/Critic/PolicyListing.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::PolicyParameter:
|
||||
file: lib/Perl/Critic/PolicyParameter.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::PolicyParameter::Behavior:
|
||||
file: lib/Perl/Critic/PolicyParameter/Behavior.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::PolicyParameter::Behavior::Boolean:
|
||||
file: lib/Perl/Critic/PolicyParameter/Behavior/Boolean.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::PolicyParameter::Behavior::Enumeration:
|
||||
file: lib/Perl/Critic/PolicyParameter/Behavior/Enumeration.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::PolicyParameter::Behavior::Integer:
|
||||
file: lib/Perl/Critic/PolicyParameter/Behavior/Integer.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::PolicyParameter::Behavior::String:
|
||||
file: lib/Perl/Critic/PolicyParameter/Behavior/String.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::PolicyParameter::Behavior::StringList:
|
||||
file: lib/Perl/Critic/PolicyParameter/Behavior/StringList.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::ProfilePrototype:
|
||||
file: lib/Perl/Critic/ProfilePrototype.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Statistics:
|
||||
file: lib/Perl/Critic/Statistics.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::TestUtils:
|
||||
file: lib/Perl/Critic/TestUtils.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Theme:
|
||||
file: lib/Perl/Critic/Theme.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::ThemeListing:
|
||||
file: lib/Perl/Critic/ThemeListing.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::UserProfile:
|
||||
file: lib/Perl/Critic/UserProfile.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Utils:
|
||||
file: lib/Perl/Critic/Utils.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Utils::Constants:
|
||||
file: lib/Perl/Critic/Utils/Constants.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Utils::DataConversion:
|
||||
file: lib/Perl/Critic/Utils/DataConversion.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Utils::McCabe:
|
||||
file: lib/Perl/Critic/Utils/McCabe.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Utils::POD:
|
||||
file: lib/Perl/Critic/Utils/POD.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Utils::POD::ParseInteriorSequence:
|
||||
file: lib/Perl/Critic/Utils/POD/ParseInteriorSequence.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Utils::PPI:
|
||||
file: lib/Perl/Critic/Utils/PPI.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Utils::Perl:
|
||||
file: lib/Perl/Critic/Utils/Perl.pm
|
||||
version: '1.140'
|
||||
Perl::Critic::Violation:
|
||||
file: lib/Perl/Critic/Violation.pm
|
||||
version: '1.140'
|
||||
Test::Perl::Critic::Policy:
|
||||
file: lib/Test/Perl/Critic/Policy.pm
|
||||
version: '1.140'
|
||||
requires:
|
||||
B::Keywords: '1.05'
|
||||
Carp: '0'
|
||||
Config::Tiny: '2'
|
||||
English: '0'
|
||||
Exception::Class: '1.23'
|
||||
Exporter: '5.63'
|
||||
Fatal: '0'
|
||||
File::Basename: '0'
|
||||
File::Find: '0'
|
||||
File::Path: '0'
|
||||
File::Spec: '0'
|
||||
File::Spec::Unix: '0'
|
||||
File::Temp: '0'
|
||||
File::Which: '0'
|
||||
Getopt::Long: '0'
|
||||
IO::String: '0'
|
||||
IPC::Open2: '1'
|
||||
List::MoreUtils: '0.19'
|
||||
List::Util: '0'
|
||||
Module::Build: '0.4204'
|
||||
Module::Pluggable: '3.1'
|
||||
PPI: '1.265'
|
||||
PPI::Document: '1.265'
|
||||
PPI::Document::File: '1.265'
|
||||
PPI::Node: '1.265'
|
||||
PPI::Token::Quote::Single: '1.265'
|
||||
PPI::Token::Whitespace: '1.265'
|
||||
PPIx::QuoteLike: '0'
|
||||
PPIx::Regexp: '0.027'
|
||||
PPIx::Regexp::Util: '0.068'
|
||||
PPIx::Utilities::Node: '1.001'
|
||||
PPIx::Utilities::Statement: '1.001'
|
||||
Perl::Tidy: '0'
|
||||
Pod::Parser: '0'
|
||||
Pod::PlainText: '0'
|
||||
Pod::Select: '0'
|
||||
Pod::Spell: '1'
|
||||
Pod::Usage: '0'
|
||||
Readonly: '2'
|
||||
Scalar::Util: '0'
|
||||
String::Format: '1.18'
|
||||
Task::Weaken: '0'
|
||||
Term::ANSIColor: '2.02'
|
||||
Test::Builder: '0.92'
|
||||
Text::ParseWords: '3'
|
||||
base: '0'
|
||||
charnames: '0'
|
||||
overload: '0'
|
||||
perl: '5.006001'
|
||||
strict: '0'
|
||||
version: '0.77'
|
||||
warnings: '0'
|
||||
resources:
|
||||
MailingList: https://groups.google.com/d/forum/perl-critic
|
||||
bugtracker: https://github.com/Perl-Critic/Perl-Critic/issues
|
||||
homepage: http://perlcritic.com
|
||||
license: http://dev.perl.org/licenses/
|
||||
repository: git://github.com/Perl-Critic/Perl-Critic.git
|
||||
version: '1.140'
|
||||
x_authority: cpan:CRITICRE
|
||||
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
|
||||
|
|
@ -0,0 +1,712 @@
|
|||
NAME
|
||||
Perl::Critic - Critique Perl source code for best-practices.
|
||||
|
||||
SYNOPSIS
|
||||
use Perl::Critic;
|
||||
my $file = shift;
|
||||
my $critic = Perl::Critic->new();
|
||||
my @violations = $critic->critique($file);
|
||||
print @violations;
|
||||
|
||||
DESCRIPTION
|
||||
Perl::Critic is an extensible framework for creating and applying coding
|
||||
standards to Perl source code. Essentially, it is a static source code
|
||||
analysis engine. Perl::Critic is distributed with a number of
|
||||
Perl::Critic::Policy modules that attempt to enforce various coding
|
||||
guidelines. Most Policy modules are based on Damian Conway's book Perl
|
||||
Best Practices. However, Perl::Critic is not limited to PBP and will
|
||||
even support Policies that contradict Conway. You can enable, disable,
|
||||
and customize those Polices through the Perl::Critic interface. You can
|
||||
also create new Policy modules that suit your own tastes.
|
||||
|
||||
For a command-line interface to Perl::Critic, see the documentation for
|
||||
perlcritic. If you want to integrate Perl::Critic with your build
|
||||
process, Test::Perl::Critic provides an interface that is suitable for
|
||||
test programs. Also, Test::Perl::Critic::Progressive is useful for
|
||||
gradually applying coding standards to legacy code. For the ultimate
|
||||
convenience (at the expense of some flexibility) see the criticism
|
||||
pragma.
|
||||
|
||||
If you'd like to try Perl::Critic without installing anything, there is
|
||||
a web-service available at <http://perlcritic.com>. The web-service does
|
||||
not yet support all the configuration features that are available in the
|
||||
native Perl::Critic API, but it should give you a good idea of what it
|
||||
does.
|
||||
|
||||
Also, ActivePerl includes a very slick graphical interface to
|
||||
Perl-Critic called "perlcritic-gui". You can get a free community
|
||||
edition of ActivePerl from <http://www.activestate.com>.
|
||||
|
||||
PREREQUISITES
|
||||
Perl::Critic runs on Perl back to Perl 5.6.1. It relies on the PPI
|
||||
module to do the heavy work of parsing Perl.
|
||||
|
||||
INTERFACE SUPPORT
|
||||
The "Perl::Critic" module is considered to be a public class. Any
|
||||
changes to its interface will go through a deprecation cycle.
|
||||
|
||||
CONSTRUCTOR
|
||||
"new( [ -profile => $FILE, -severity => $N, -theme => $string, -include
|
||||
=> \@PATTERNS, -exclude => \@PATTERNS, -top => $N, -only => $B,
|
||||
-profile-strictness => $PROFILE_STRICTNESS_{WARN|FATAL|QUIET}, -force =>
|
||||
$B, -verbose => $N ], -color => $B, -pager => $string, -allow-unsafe =>
|
||||
$B, -criticism-fatal => $B)"
|
||||
"new()"
|
||||
Returns a reference to a new Perl::Critic object. Most arguments are
|
||||
just passed directly into Perl::Critic::Config, but I have described
|
||||
them here as well. The default value for all arguments can be
|
||||
defined in your .perlcriticrc file. See the "CONFIGURATION" section
|
||||
for more information about that. All arguments are optional
|
||||
key-value pairs as follows:
|
||||
|
||||
-profile is a path to a configuration file. If $FILE is not defined,
|
||||
Perl::Critic::Config attempts to find a .perlcriticrc configuration
|
||||
file in the current directory, and then in your home directory.
|
||||
Alternatively, you can set the "PERLCRITIC" environment variable to
|
||||
point to a file in another location. If a configuration file can't
|
||||
be found, or if $FILE is an empty string, then all Policies will be
|
||||
loaded with their default configuration. See "CONFIGURATION" for
|
||||
more information.
|
||||
|
||||
-severity is the minimum severity level. Only Policy modules that
|
||||
have a severity greater than $N will be applied. Severity values are
|
||||
integers ranging from 1 (least severe violations) to 5 (most severe
|
||||
violations). The default is 5. For a given "-profile", decreasing
|
||||
the "-severity" will usually reveal more Policy violations. You can
|
||||
set the default value for this option in your .perlcriticrc file.
|
||||
Users can redefine the severity level for any Policy in their
|
||||
.perlcriticrc file. See "CONFIGURATION" for more information.
|
||||
|
||||
If it is difficult for you to remember whether severity "5" is the
|
||||
most or least restrictive level, then you can use one of these named
|
||||
values:
|
||||
|
||||
SEVERITY NAME ...is equivalent to... SEVERITY NUMBER
|
||||
--------------------------------------------------------
|
||||
-severity => 'gentle' -severity => 5
|
||||
-severity => 'stern' -severity => 4
|
||||
-severity => 'harsh' -severity => 3
|
||||
-severity => 'cruel' -severity => 2
|
||||
-severity => 'brutal' -severity => 1
|
||||
|
||||
The names reflect how severely the code is criticized: a "gentle"
|
||||
criticism reports only the most severe violations, and so on down to
|
||||
a "brutal" criticism which reports even the most minor violations.
|
||||
|
||||
-theme is special expression that determines which Policies to apply
|
||||
based on their respective themes. For example, the following would
|
||||
load only Policies that have a 'bugs' AND 'pbp' theme:
|
||||
|
||||
my $critic = Perl::Critic->new( -theme => 'bugs && pbp' );
|
||||
|
||||
Unless the "-severity" option is explicitly given, setting "-theme"
|
||||
silently causes the "-severity" to be set to 1. You can set the
|
||||
default value for this option in your .perlcriticrc file. See the
|
||||
"POLICY THEMES" section for more information about themes.
|
||||
|
||||
-include is a reference to a list of string @PATTERNS. Policy
|
||||
modules that match at least one "m/$PATTERN/ixms" will always be
|
||||
loaded, irrespective of all other settings. For example:
|
||||
|
||||
my $critic = Perl::Critic->new(-include => ['layout'], -severity => 4);
|
||||
|
||||
This would cause Perl::Critic to apply all the "CodeLayout::*"
|
||||
Policy modules even though they have a severity level that is less
|
||||
than 4. You can set the default value for this option in your
|
||||
.perlcriticrc file. You can also use "-include" in conjunction with
|
||||
the "-exclude" option. Note that "-exclude" takes precedence over
|
||||
"-include" when a Policy matches both patterns.
|
||||
|
||||
-exclude is a reference to a list of string @PATTERNS. Policy
|
||||
modules that match at least one "m/$PATTERN/ixms" will not be
|
||||
loaded, irrespective of all other settings. For example:
|
||||
|
||||
my $critic = Perl::Critic->new(-exclude => ['strict'], -severity => 1);
|
||||
|
||||
This would cause Perl::Critic to not apply the "RequireUseStrict"
|
||||
and "ProhibitNoStrict" Policy modules even though they have a
|
||||
severity level that is greater than 1. You can set the default value
|
||||
for this option in your .perlcriticrc file. You can also use
|
||||
"-exclude" in conjunction with the "-include" option. Note that
|
||||
"-exclude" takes precedence over "-include" when a Policy matches
|
||||
both patterns.
|
||||
|
||||
-single-policy is a string "PATTERN". Only one policy that matches
|
||||
"m/$PATTERN/ixms" will be used. Policies that do not match will be
|
||||
excluded. This option has precedence over the "-severity", "-theme",
|
||||
"-include", "-exclude", and "-only" options. You can set the default
|
||||
value for this option in your .perlcriticrc file.
|
||||
|
||||
-top is the maximum number of Violations to return when ranked by
|
||||
their severity levels. This must be a positive integer. Violations
|
||||
are still returned in the order that they occur within the file.
|
||||
Unless the "-severity" option is explicitly given, setting "-top"
|
||||
silently causes the "-severity" to be set to 1. You can set the
|
||||
default value for this option in your .perlcriticrc file.
|
||||
|
||||
-only is a boolean value. If set to a true value, Perl::Critic will
|
||||
only choose from Policies that are mentioned in the user's profile.
|
||||
If set to a false value (which is the default), then Perl::Critic
|
||||
chooses from all the Policies that it finds at your site. You can
|
||||
set the default value for this option in your .perlcriticrc file.
|
||||
|
||||
-profile-strictness is an enumerated value, one of
|
||||
"$PROFILE_STRICTNESS_WARN" in Perl::Critic::Utils::Constants (the
|
||||
default), "$PROFILE_STRICTNESS_FATAL" in
|
||||
Perl::Critic::Utils::Constants, and "$PROFILE_STRICTNESS_QUIET" in
|
||||
Perl::Critic::Utils::Constants. If set to
|
||||
"$PROFILE_STRICTNESS_FATAL" in Perl::Critic::Utils::Constants,
|
||||
Perl::Critic will make certain warnings about problems found in a
|
||||
.perlcriticrc or file specified via the -profile option fatal. For
|
||||
example, Perl::Critic normally only "warn"s about profiles referring
|
||||
to non-existent Policies, but this value makes this situation fatal.
|
||||
Correspondingly, "$PROFILE_STRICTNESS_QUIET" in
|
||||
Perl::Critic::Utils::Constants makes Perl::Critic shut up about
|
||||
these things.
|
||||
|
||||
-force is a boolean value that controls whether Perl::Critic
|
||||
observes the magical "## no critic" annotations in your code. If set
|
||||
to a true value, Perl::Critic will analyze all code. If set to a
|
||||
false value (which is the default) Perl::Critic will ignore code
|
||||
that is tagged with these annotations. See "BENDING THE RULES" for
|
||||
more information. You can set the default value for this option in
|
||||
your .perlcriticrc file.
|
||||
|
||||
-verbose can be a positive integer (from 1 to 11), or a literal
|
||||
format specification. See Perl::Critic::Violation for an explanation
|
||||
of format specifications. You can set the default value for this
|
||||
option in your .perlcriticrc file.
|
||||
|
||||
-unsafe directs Perl::Critic to allow the use of Policies that are
|
||||
marked as "unsafe" by the author. Such policies may compile
|
||||
untrusted code or do other nefarious things.
|
||||
|
||||
-color and -pager are not used by Perl::Critic but is provided for
|
||||
the benefit of perlcritic.
|
||||
|
||||
-criticism-fatal is not used by Perl::Critic but is provided for the
|
||||
benefit of criticism.
|
||||
|
||||
-color-severity-highest, -color-severity-high, -color-severity-
|
||||
medium, -color-severity-low, and -color-severity-lowest are not used
|
||||
by Perl::Critic, but are provided for the benefit of perlcritic.
|
||||
Each is set to the Term::ANSIColor color specification to be used to
|
||||
display violations of the corresponding severity.
|
||||
|
||||
-files-with-violations and -files-without-violations are not used by
|
||||
Perl::Critic, but are provided for the benefit of perlcritic, to
|
||||
cause only the relevant filenames to be displayed.
|
||||
|
||||
METHODS
|
||||
"critique( $source_code )"
|
||||
Runs the $source_code through the Perl::Critic engine using all the
|
||||
Policies that have been loaded into this engine. If $source_code is
|
||||
a scalar reference, then it is treated as a string of actual Perl
|
||||
code. If $source_code is a reference to an instance of
|
||||
PPI::Document, then that instance is used directly. Otherwise, it is
|
||||
treated as a path to a local file containing Perl code. This method
|
||||
returns a list of Perl::Critic::Violation objects for each violation
|
||||
of the loaded Policies. The list is sorted in the order that the
|
||||
Violations appear in the code. If there are no violations, this
|
||||
method returns an empty list.
|
||||
|
||||
"add_policy( -policy => $policy_name, -params => \%param_hash )"
|
||||
Creates a Policy object and loads it into this Critic. If the object
|
||||
cannot be instantiated, it will throw a fatal exception. Otherwise,
|
||||
it returns a reference to this Critic.
|
||||
|
||||
-policy is the name of a Perl::Critic::Policy subclass module. The
|
||||
'Perl::Critic::Policy' portion of the name can be omitted for
|
||||
brevity. This argument is required.
|
||||
|
||||
-params is an optional reference to a hash of Policy parameters. The
|
||||
contents of this hash reference will be passed into to the
|
||||
constructor of the Policy module. See the documentation in the
|
||||
relevant Policy module for a description of the arguments it
|
||||
supports.
|
||||
|
||||
" policies() "
|
||||
Returns a list containing references to all the Policy objects that
|
||||
have been loaded into this engine. Objects will be in the order that
|
||||
they were loaded.
|
||||
|
||||
" config() "
|
||||
Returns the Perl::Critic::Config object that was created for or
|
||||
given to this Critic.
|
||||
|
||||
" statistics() "
|
||||
Returns the Perl::Critic::Statistics object that was created for
|
||||
this Critic. The Statistics object accumulates data for all files
|
||||
that are analyzed by this Critic.
|
||||
|
||||
FUNCTIONAL INTERFACE
|
||||
For those folks who prefer to have a functional interface, The
|
||||
"critique" method can be exported on request and called as a static
|
||||
function. If the first argument is a hashref, its contents are used to
|
||||
construct a new Perl::Critic object internally. The keys of that hash
|
||||
should be the same as those supported by the "Perl::Critic::new()"
|
||||
method. Here are some examples:
|
||||
|
||||
use Perl::Critic qw(critique);
|
||||
|
||||
# Use default parameters...
|
||||
@violations = critique( $some_file );
|
||||
|
||||
# Use custom parameters...
|
||||
@violations = critique( {-severity => 2}, $some_file );
|
||||
|
||||
# As a one-liner
|
||||
%> perl -MPerl::Critic=critique -e 'print critique(shift)' some_file.pm
|
||||
|
||||
None of the other object-methods are currently supported as static
|
||||
functions. Sorry.
|
||||
|
||||
CONFIGURATION
|
||||
Most of the settings for Perl::Critic and each of the Policy modules can
|
||||
be controlled by a configuration file. The default configuration file is
|
||||
called .perlcriticrc. Perl::Critic will look for this file in the
|
||||
current directory first, and then in your home directory. Alternatively,
|
||||
you can set the "PERLCRITIC" environment variable to explicitly point to
|
||||
a different file in another location. If none of these files exist, and
|
||||
the "-profile" option is not given to the constructor, then all the
|
||||
modules that are found in the Perl::Critic::Policy namespace will be
|
||||
loaded with their default configuration.
|
||||
|
||||
The format of the configuration file is a series of INI-style blocks
|
||||
that contain key-value pairs separated by '='. Comments should start
|
||||
with '#' and can be placed on a separate line or after the name-value
|
||||
pairs if you desire.
|
||||
|
||||
Default settings for Perl::Critic itself can be set before the first
|
||||
named block. For example, putting any or all of these at the top of your
|
||||
configuration file will set the default value for the corresponding
|
||||
constructor argument.
|
||||
|
||||
severity = 3 #Integer or named level
|
||||
only = 1 #Zero or One
|
||||
force = 0 #Zero or One
|
||||
verbose = 4 #Integer or format spec
|
||||
top = 50 #A positive integer
|
||||
theme = (pbp || security) && bugs #A theme expression
|
||||
include = NamingConventions ClassHierarchies #Space-delimited list
|
||||
exclude = Variables Modules::RequirePackage #Space-delimited list
|
||||
criticism-fatal = 1 #Zero or One
|
||||
color = 1 #Zero or One
|
||||
allow-unsafe = 1 #Zero or One
|
||||
pager = less #pager to pipe output to
|
||||
|
||||
The remainder of the configuration file is a series of blocks like this:
|
||||
|
||||
[Perl::Critic::Policy::Category::PolicyName]
|
||||
severity = 1
|
||||
set_themes = foo bar
|
||||
add_themes = baz
|
||||
maximum_violations_per_document = 57
|
||||
arg1 = value1
|
||||
arg2 = value2
|
||||
|
||||
"Perl::Critic::Policy::Category::PolicyName" is the full name of a
|
||||
module that implements the policy. The Policy modules distributed with
|
||||
Perl::Critic have been grouped into categories according to the table of
|
||||
contents in Damian Conway's book Perl Best Practices. For brevity, you
|
||||
can omit the 'Perl::Critic::Policy' part of the module name.
|
||||
|
||||
"severity" is the level of importance you wish to assign to the Policy.
|
||||
All Policy modules are defined with a default severity value ranging
|
||||
from 1 (least severe) to 5 (most severe). However, you may disagree with
|
||||
the default severity and choose to give it a higher or lower severity,
|
||||
based on your own coding philosophy. You can set the "severity" to an
|
||||
integer from 1 to 5, or use one of the equivalent names:
|
||||
|
||||
SEVERITY NAME ...is equivalent to... SEVERITY NUMBER
|
||||
----------------------------------------------------
|
||||
gentle 5
|
||||
stern 4
|
||||
harsh 3
|
||||
cruel 2
|
||||
brutal 1
|
||||
|
||||
The names reflect how severely the code is criticized: a "gentle"
|
||||
criticism reports only the most severe violations, and so on down to a
|
||||
"brutal" criticism which reports even the most minor violations.
|
||||
|
||||
"set_themes" sets the theme for the Policy and overrides its default
|
||||
theme. The argument is a string of one or more whitespace-delimited
|
||||
alphanumeric words. Themes are case-insensitive. See "POLICY THEMES" for
|
||||
more information.
|
||||
|
||||
"add_themes" appends to the default themes for this Policy. The argument
|
||||
is a string of one or more whitespace-delimited words. Themes are case-
|
||||
insensitive. See "POLICY THEMES" for more information.
|
||||
|
||||
"maximum_violations_per_document" limits the number of Violations the
|
||||
Policy will return for a given document. Some Policies have a default
|
||||
limit; see the documentation for the individual Policies to see whether
|
||||
there is one. To force a Policy to not have a limit, specify "no_limit"
|
||||
or the empty string for the value of this parameter.
|
||||
|
||||
The remaining key-value pairs are configuration parameters that will be
|
||||
passed into the constructor for that Policy. The constructors for most
|
||||
Policy objects do not support arguments, and those that do should have
|
||||
reasonable defaults. See the documentation on the appropriate Policy
|
||||
module for more details.
|
||||
|
||||
Instead of redefining the severity for a given Policy, you can
|
||||
completely disable a Policy by prepending a '-' to the name of the
|
||||
module in your configuration file. In this manner, the Policy will never
|
||||
be loaded, regardless of the "-severity" given to the Perl::Critic
|
||||
constructor.
|
||||
|
||||
A simple configuration might look like this:
|
||||
|
||||
#--------------------------------------------------------------
|
||||
# I think these are really important, so always load them
|
||||
|
||||
[TestingAndDebugging::RequireUseStrict]
|
||||
severity = 5
|
||||
|
||||
[TestingAndDebugging::RequireUseWarnings]
|
||||
severity = 5
|
||||
|
||||
#--------------------------------------------------------------
|
||||
# I think these are less important, so only load when asked
|
||||
|
||||
[Variables::ProhibitPackageVars]
|
||||
severity = 2
|
||||
|
||||
[ControlStructures::ProhibitPostfixControls]
|
||||
allow = if unless # My custom configuration
|
||||
severity = cruel # Same as "severity = 2"
|
||||
|
||||
#--------------------------------------------------------------
|
||||
# Give these policies a custom theme. I can activate just
|
||||
# these policies by saying `perlcritic -theme larry`
|
||||
|
||||
[Modules::RequireFilenameMatchesPackage]
|
||||
add_themes = larry
|
||||
|
||||
[TestingAndDebugging::RequireTestLables]
|
||||
add_themes = larry curly moe
|
||||
|
||||
#--------------------------------------------------------------
|
||||
# I do not agree with these at all, so never load them
|
||||
|
||||
[-NamingConventions::Capitalization]
|
||||
[-ValuesAndExpressions::ProhibitMagicNumbers]
|
||||
|
||||
#--------------------------------------------------------------
|
||||
# For all other Policies, I accept the default severity,
|
||||
# so no additional configuration is required for them.
|
||||
|
||||
For additional configuration examples, see the perlcriticrc file that is
|
||||
included in this examples directory of this distribution.
|
||||
|
||||
Damian Conway's own Perl::Critic configuration is also included in this
|
||||
distribution as examples/perlcriticrc-conway.
|
||||
|
||||
THE POLICIES
|
||||
A large number of Policy modules are distributed with Perl::Critic. They
|
||||
are described briefly in the companion document
|
||||
Perl::Critic::PolicySummary and in more detail in the individual modules
|
||||
themselves. Say ""perlcritic -doc PATTERN"" to see the perldoc for all
|
||||
Policy modules that match the regex "m/PATTERN/ixms"
|
||||
|
||||
There are a number of distributions of additional policies on CPAN. If
|
||||
Perl::Critic doesn't contain a policy that you want, some one may have
|
||||
already written it. See the "SEE ALSO" section below for a list of some
|
||||
of these distributions.
|
||||
|
||||
POLICY THEMES
|
||||
Each Policy is defined with one or more "themes". Themes can be used to
|
||||
create arbitrary groups of Policies. They are intended to provide an
|
||||
alternative mechanism for selecting your preferred set of Policies. For
|
||||
example, you may wish disable a certain subset of Policies when
|
||||
analyzing test programs. Conversely, you may wish to enable only a
|
||||
specific subset of Policies when analyzing modules.
|
||||
|
||||
The Policies that ship with Perl::Critic have been broken into the
|
||||
following themes. This is just our attempt to provide some basic logical
|
||||
groupings. You are free to invent new themes that suit your needs.
|
||||
|
||||
THEME DESCRIPTION
|
||||
--------------------------------------------------------------------------
|
||||
core All policies that ship with Perl::Critic
|
||||
pbp Policies that come directly from "Perl Best Practices"
|
||||
bugs Policies that that prevent or reveal bugs
|
||||
certrec Policies that CERT recommends
|
||||
certrule Policies that CERT considers rules
|
||||
maintenance Policies that affect the long-term health of the code
|
||||
cosmetic Policies that only have a superficial effect
|
||||
complexity Policies that specifically relate to code complexity
|
||||
security Policies that relate to security issues
|
||||
tests Policies that are specific to test programs
|
||||
|
||||
Any Policy may fit into multiple themes. Say "perlcritic -list" to get a
|
||||
listing of all available Policies and the themes that are associated
|
||||
with each one. You can also change the theme for any Policy in your
|
||||
.perlcriticrc file. See the "CONFIGURATION" section for more information
|
||||
about that.
|
||||
|
||||
Using the "-theme" option, you can create an arbitrarily complex rule
|
||||
that determines which Policies will be loaded. Precedence is the same as
|
||||
regular Perl code, and you can use parentheses to enforce precedence as
|
||||
well. Supported operators are:
|
||||
|
||||
Operator Alternative Example
|
||||
-----------------------------------------------------------------
|
||||
&& and 'pbp && core'
|
||||
|| or 'pbp || (bugs && security)'
|
||||
! not 'pbp && ! (portability || complexity)'
|
||||
|
||||
Theme names are case-insensitive. If the "-theme" is set to an empty
|
||||
string, then it evaluates as true all Policies.
|
||||
|
||||
BENDING THE RULES
|
||||
Perl::Critic takes a hard-line approach to your code: either you comply
|
||||
or you don't. In the real world, it is not always practical (nor even
|
||||
possible) to fully comply with coding standards. In such cases, it is
|
||||
wise to show that you are knowingly violating the standards and that you
|
||||
have a Damn Good Reason (DGR) for doing so.
|
||||
|
||||
To help with those situations, you can direct Perl::Critic to ignore
|
||||
certain lines or blocks of code by using annotations:
|
||||
|
||||
require 'LegacyLibaray1.pl'; ## no critic
|
||||
require 'LegacyLibrary2.pl'; ## no critic
|
||||
|
||||
for my $element (@list) {
|
||||
|
||||
## no critic
|
||||
|
||||
$foo = ""; #Violates 'ProhibitEmptyQuotes'
|
||||
$barf = bar() if $foo; #Violates 'ProhibitPostfixControls'
|
||||
#Some more evil code...
|
||||
|
||||
## use critic
|
||||
|
||||
#Some good code...
|
||||
do_something($_);
|
||||
}
|
||||
|
||||
The "## no critic" annotations direct Perl::Critic to ignore the
|
||||
remaining lines of code until a "## use critic" annotation is found. If
|
||||
the ""## no critic"" annotation is on the same line as a code statement,
|
||||
then only that line of code is overlooked. To direct perlcritic to
|
||||
ignore the ""## no critic"" annotations, use the "--force" option.
|
||||
|
||||
A bare "## no critic" annotation disables all the active Policies. If
|
||||
you wish to disable only specific Policies, add a list of Policy names
|
||||
as arguments, just as you would for the "no strict" or "no warnings"
|
||||
pragmas. For example, this would disable the "ProhibitEmptyQuotes" and
|
||||
"ProhibitPostfixControls" policies until the end of the block or until
|
||||
the next "## use critic" annotation (whichever comes first):
|
||||
|
||||
## no critic (EmptyQuotes, PostfixControls)
|
||||
|
||||
# Now exempt from ValuesAndExpressions::ProhibitEmptyQuotes
|
||||
$foo = "";
|
||||
|
||||
# Now exempt ControlStructures::ProhibitPostfixControls
|
||||
$barf = bar() if $foo;
|
||||
|
||||
# Still subjected to ValuesAndExpression::RequireNumberSeparators
|
||||
$long_int = 10000000000;
|
||||
|
||||
Since the Policy names are matched against the "## no critic" arguments
|
||||
as regular expressions, you can abbreviate the Policy names or disable
|
||||
an entire family of Policies in one shot like this:
|
||||
|
||||
## no critic (NamingConventions)
|
||||
|
||||
# Now exempt from NamingConventions::Capitalization
|
||||
my $camelHumpVar = 'foo';
|
||||
|
||||
# Now exempt from NamingConventions::Capitalization
|
||||
sub camelHumpSub {}
|
||||
|
||||
The argument list must be enclosed in parentheses or brackets and must
|
||||
contain one or more comma-separated barewords (e.g. don't use quotes).
|
||||
The "## no critic" annotations can be nested, and Policies named by an
|
||||
inner annotation will be disabled along with those already disabled an
|
||||
outer annotation.
|
||||
|
||||
Some Policies like "Subroutines::ProhibitExcessComplexity" apply to an
|
||||
entire block of code. In those cases, the "## no critic" annotation must
|
||||
appear on the line where the violation is reported. For example:
|
||||
|
||||
sub complicated_function { ## no critic (ProhibitExcessComplexity)
|
||||
# Your code here...
|
||||
}
|
||||
|
||||
Policies such as "Documentation::RequirePodSections" apply to the entire
|
||||
document, in which case violations are reported at line 1.
|
||||
|
||||
Use this feature wisely. "## no critic" annotations should be used in
|
||||
the smallest possible scope, or only on individual lines of code. And
|
||||
you should always be as specific as possible about which Policies you
|
||||
want to disable (i.e. never use a bare "## no critic"). If Perl::Critic
|
||||
complains about your code, try and find a compliant solution before
|
||||
resorting to this feature.
|
||||
|
||||
THE Perl::Critic PHILOSOPHY
|
||||
Coding standards are deeply personal and highly subjective. The goal of
|
||||
Perl::Critic is to help you write code that conforms with a set of best
|
||||
practices. Our primary goal is not to dictate what those practices are,
|
||||
but rather, to implement the practices discovered by others. Ultimately,
|
||||
you make the rules -- Perl::Critic is merely a tool for encouraging
|
||||
consistency. If there is a policy that you think is important or that we
|
||||
have overlooked, we would be very grateful for contributions, or you can
|
||||
simply load your own private set of policies into Perl::Critic.
|
||||
|
||||
EXTENDING THE CRITIC
|
||||
The modular design of Perl::Critic is intended to facilitate the
|
||||
addition of new Policies. You'll need to have some understanding of PPI,
|
||||
but most Policy modules are pretty straightforward and only require
|
||||
about 20 lines of code. Please see the Perl::Critic::DEVELOPER file
|
||||
included in this distribution for a step-by-step demonstration of how to
|
||||
create new Policy modules.
|
||||
|
||||
If you develop any new Policy modules, feel free to send them to
|
||||
"<team@perlcritic.com>" and I'll be happy to consider putting them into
|
||||
the Perl::Critic distribution. Or if you would like to work on the
|
||||
Perl::Critic project directly, you can fork our repository at
|
||||
<https://github.com/Perl-Critic/Perl-Critic.git>.
|
||||
|
||||
The Perl::Critic team is also available for hire. If your organization
|
||||
has its own coding standards, we can create custom Policies to enforce
|
||||
your local guidelines. Or if your code base is prone to a particular
|
||||
defect pattern, we can design Policies that will help you catch those
|
||||
costly defects before they go into production. To discuss your needs
|
||||
with the Perl::Critic team, just contact "<team@perlcritic.com>".
|
||||
|
||||
PREREQUISITES
|
||||
Perl::Critic requires the following modules:
|
||||
|
||||
B::Keywords
|
||||
|
||||
Config::Tiny
|
||||
|
||||
Exception::Class
|
||||
|
||||
File::Spec
|
||||
|
||||
File::Spec::Unix
|
||||
|
||||
File::Which
|
||||
|
||||
IO::String
|
||||
|
||||
List::MoreUtils
|
||||
|
||||
List::Util
|
||||
|
||||
Module::Pluggable
|
||||
|
||||
Perl::Tidy
|
||||
|
||||
Pod::Spell
|
||||
|
||||
PPI
|
||||
|
||||
Pod::PlainText
|
||||
|
||||
Pod::Select
|
||||
|
||||
Pod::Usage
|
||||
|
||||
Readonly
|
||||
|
||||
Scalar::Util
|
||||
|
||||
String::Format
|
||||
|
||||
Task::Weaken
|
||||
|
||||
Term::ANSIColor
|
||||
|
||||
Text::ParseWords
|
||||
|
||||
version
|
||||
|
||||
CONTACTING THE DEVELOPMENT TEAM
|
||||
You are encouraged to subscribe to the public mailing list at
|
||||
<https://groups.google.com/d/forum/perl-critic>. At least one member of
|
||||
the development team is usually hanging around in
|
||||
<irc://irc.perl.org/#perlcritic> and you can follow Perl::Critic on
|
||||
Twitter, at <https://twitter.com/perlcritic>.
|
||||
|
||||
SEE ALSO
|
||||
There are a number of distributions of additional Policies available. A
|
||||
few are listed here:
|
||||
|
||||
Perl::Critic::More
|
||||
|
||||
Perl::Critic::Bangs
|
||||
|
||||
Perl::Critic::Lax
|
||||
|
||||
Perl::Critic::StricterSubs
|
||||
|
||||
Perl::Critic::Swift
|
||||
|
||||
Perl::Critic::Tics
|
||||
|
||||
These distributions enable you to use Perl::Critic in your unit tests:
|
||||
|
||||
Test::Perl::Critic
|
||||
|
||||
Test::Perl::Critic::Progressive
|
||||
|
||||
There is also a distribution that will install all the Perl::Critic
|
||||
related modules known to the development team:
|
||||
|
||||
Task::Perl::Critic
|
||||
|
||||
BUGS
|
||||
Scrutinizing Perl code is hard for humans, let alone machines. If you
|
||||
find any bugs, particularly false-positives or false-negatives from a
|
||||
Perl::Critic::Policy, please submit them at
|
||||
<https://github.com/Perl-Critic/Perl-Critic/issues>. Thanks.
|
||||
|
||||
CREDITS
|
||||
Adam Kennedy - For creating PPI, the heart and soul of Perl::Critic.
|
||||
|
||||
Damian Conway - For writing Perl Best Practices, finally :)
|
||||
|
||||
Chris Dolan - For contributing the best features and Policy modules.
|
||||
|
||||
Andy Lester - Wise sage and master of all-things-testing.
|
||||
|
||||
Elliot Shank - The self-proclaimed quality freak.
|
||||
|
||||
Giuseppe Maxia - For all the great ideas and positive encouragement.
|
||||
|
||||
and Sharon, my wife - For putting up with my all-night code sessions.
|
||||
|
||||
Thanks also to the Perl Foundation for providing a grant to support
|
||||
Chris Dolan's project to implement twenty PBP policies.
|
||||
<http://www.perlfoundation.org/april_1_2007_new_grant_awards>
|
||||
|
||||
Thanks also to this incomplete laundry list of folks who have
|
||||
contributed to Perl::Critic in some way: Daniel Mita, Gregory Oschwald,
|
||||
Mike O'Regan, Tom Hukins, Omer Gazit, Evan Zacks, Paul Howarth, Sawyer
|
||||
X, Christian Walde, Dave Rolsky, Jakub Wilk, Roy Ivy III, Oliver
|
||||
Trosien, Glenn Fowler, Matt Creenan, Alex Balhatchet, Sebastian Paaske
|
||||
Tørholm, Stuart A Johnston, Dan Book, Steven Humphrey, James Raspass,
|
||||
Nick Tonkin, Harrison Katz, Douglas Sims, Mark Fowler, Alan Berndt, Neil
|
||||
Bowers, Sergey Romanov, Gabor Szabo, Graham Knop, Mike Eldridge, David
|
||||
Steinbrunner, Kirk Kimmel, Guillaume Aubert, Dave Cross, Anirvan
|
||||
Chatterjee, Todd Rinaldo, Graham Ollis, Karen Etheridge, Jonas Brømsø,
|
||||
Olaf Alders, Jim Keenan, Slaven Rezić, Szymon Nieznański.
|
||||
|
||||
AUTHOR
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
COPYRIGHT
|
||||
Copyright (c) 2005-2019 Imaginative Software Systems. All rights
|
||||
reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself. The full text of this license can
|
||||
be found in the LICENSE file included with this module.
|
||||
|
||||
|
|
@ -0,0 +1,754 @@
|
|||
# BUILD STATUS
|
||||
|
||||
* [](https://github.com/Perl-Critic/Perl-Critic/actions?query=workflow%3Atestsuite+branch%3Adev)
|
||||
* [CPAN Testers](http://cpantesters.org/distro/P/Perl-Critic.html)
|
||||
|
||||
# NAME
|
||||
|
||||
Perl::Critic - Critique Perl source code for best-practices.
|
||||
|
||||
# SYNOPSIS
|
||||
|
||||
use Perl::Critic;
|
||||
my $file = shift;
|
||||
my $critic = Perl::Critic->new();
|
||||
my @violations = $critic->critique($file);
|
||||
print @violations;
|
||||
|
||||
# DESCRIPTION
|
||||
|
||||
Perl::Critic is an extensible framework for creating and applying coding
|
||||
standards to Perl source code. Essentially, it is a static source code
|
||||
analysis engine. Perl::Critic is distributed with a number of
|
||||
[Perl::Critic::Policy](https://metacpan.org/pod/Perl::Critic::Policy) modules that attempt to enforce various coding
|
||||
guidelines. Most Policy modules are based on Damian Conway's book **Perl Best
|
||||
Practices**. However, Perl::Critic is **not** limited to PBP and will even
|
||||
support Policies that contradict Conway. You can enable, disable, and
|
||||
customize those Polices through the Perl::Critic interface. You can also
|
||||
create new Policy modules that suit your own tastes.
|
||||
|
||||
For a command-line interface to Perl::Critic, see the documentation for
|
||||
[perlcritic](https://metacpan.org/pod/perlcritic). If you want to integrate Perl::Critic with your build process,
|
||||
[Test::Perl::Critic](https://metacpan.org/pod/Test::Perl::Critic) provides an interface that is suitable for test
|
||||
programs. Also, [Test::Perl::Critic::Progressive](https://metacpan.org/pod/Test::Perl::Critic::Progressive) is useful for gradually
|
||||
applying coding standards to legacy code. For the ultimate convenience (at
|
||||
the expense of some flexibility) see the [criticism](https://metacpan.org/pod/criticism) pragma.
|
||||
|
||||
If you'd like to try [Perl::Critic](https://metacpan.org/pod/Perl::Critic) without installing anything, there is a
|
||||
web-service available at [http://perlcritic.com](http://perlcritic.com). The web-service does not
|
||||
yet support all the configuration features that are available in the native
|
||||
Perl::Critic API, but it should give you a good idea of what it does.
|
||||
|
||||
Also, ActivePerl includes a very slick graphical interface to Perl-Critic
|
||||
called `perlcritic-gui`. You can get a free community edition of ActivePerl
|
||||
from [http://www.activestate.com](http://www.activestate.com).
|
||||
|
||||
# PREREQUISITES
|
||||
|
||||
Perl::Critic runs on Perl back to Perl 5.6.1. It relies on the [PPI](https://metacpan.org/pod/PPI)
|
||||
module to do the heavy work of parsing Perl.
|
||||
|
||||
# INTERFACE SUPPORT
|
||||
|
||||
The `Perl::Critic` module is considered to be a public class. Any
|
||||
changes to its interface will go through a deprecation cycle.
|
||||
|
||||
# CONSTRUCTOR
|
||||
|
||||
- `new( [ -profile => $FILE, -severity => $N, -theme => $string, -include => \@PATTERNS, -exclude => \@PATTERNS, -top => $N, -only => $B, -profile-strictness => $PROFILE_STRICTNESS_{WARN|FATAL|QUIET}, -force => $B, -verbose => $N ], -color => $B, -pager => $string, -allow-unsafe => $B, -criticism-fatal => $B)`
|
||||
- `new()`
|
||||
|
||||
Returns a reference to a new Perl::Critic object. Most arguments are just
|
||||
passed directly into [Perl::Critic::Config](https://metacpan.org/pod/Perl::Critic::Config), but I have described them here
|
||||
as well. The default value for all arguments can be defined in your
|
||||
`.perlcriticrc` file. See the ["CONFIGURATION"](#configuration) section for more
|
||||
information about that. All arguments are optional key-value pairs as
|
||||
follows:
|
||||
|
||||
**-profile** is a path to a configuration file. If `$FILE` is not defined,
|
||||
Perl::Critic::Config attempts to find a `.perlcriticrc` configuration file in
|
||||
the current directory, and then in your home directory. Alternatively, you
|
||||
can set the `PERLCRITIC` environment variable to point to a file in another
|
||||
location. If a configuration file can't be found, or if `$FILE` is an empty
|
||||
string, then all Policies will be loaded with their default configuration.
|
||||
See ["CONFIGURATION"](#configuration) for more information.
|
||||
|
||||
**-severity** is the minimum severity level. Only Policy modules that have a
|
||||
severity greater than `$N` will be applied. Severity values are integers
|
||||
ranging from 1 (least severe violations) to 5 (most severe violations). The
|
||||
default is 5. For a given `-profile`, decreasing the `-severity` will
|
||||
usually reveal more Policy violations. You can set the default value for this
|
||||
option in your `.perlcriticrc` file. Users can redefine the severity level
|
||||
for any Policy in their `.perlcriticrc` file. See ["CONFIGURATION"](#configuration) for
|
||||
more information.
|
||||
|
||||
If it is difficult for you to remember whether severity "5" is the most or
|
||||
least restrictive level, then you can use one of these named values:
|
||||
|
||||
SEVERITY NAME ...is equivalent to... SEVERITY NUMBER
|
||||
--------------------------------------------------------
|
||||
-severity => 'gentle' -severity => 5
|
||||
-severity => 'stern' -severity => 4
|
||||
-severity => 'harsh' -severity => 3
|
||||
-severity => 'cruel' -severity => 2
|
||||
-severity => 'brutal' -severity => 1
|
||||
|
||||
The names reflect how severely the code is criticized: a `gentle` criticism
|
||||
reports only the most severe violations, and so on down to a `brutal`
|
||||
criticism which reports even the most minor violations.
|
||||
|
||||
**-theme** is special expression that determines which Policies to apply based
|
||||
on their respective themes. For example, the following would load only
|
||||
Policies that have a 'bugs' AND 'pbp' theme:
|
||||
|
||||
my $critic = Perl::Critic->new( -theme => 'bugs && pbp' );
|
||||
|
||||
Unless the `-severity` option is explicitly given, setting `-theme` silently
|
||||
causes the `-severity` to be set to 1. You can set the default value for
|
||||
this option in your `.perlcriticrc` file. See the ["POLICY THEMES"](#policy-themes) section
|
||||
for more information about themes.
|
||||
|
||||
**-include** is a reference to a list of string `@PATTERNS`. Policy modules
|
||||
that match at least one `m/$PATTERN/ixms` will always be loaded, irrespective
|
||||
of all other settings. For example:
|
||||
|
||||
my $critic = Perl::Critic->new(-include => ['layout'], -severity => 4);
|
||||
|
||||
This would cause Perl::Critic to apply all the `CodeLayout::*` Policy modules
|
||||
even though they have a severity level that is less than 4. You can set the
|
||||
default value for this option in your `.perlcriticrc` file. You can also use
|
||||
`-include` in conjunction with the `-exclude` option. Note that `-exclude`
|
||||
takes precedence over `-include` when a Policy matches both patterns.
|
||||
|
||||
**-exclude** is a reference to a list of string `@PATTERNS`. Policy modules
|
||||
that match at least one `m/$PATTERN/ixms` will not be loaded, irrespective of
|
||||
all other settings. For example:
|
||||
|
||||
my $critic = Perl::Critic->new(-exclude => ['strict'], -severity => 1);
|
||||
|
||||
This would cause Perl::Critic to not apply the `RequireUseStrict` and
|
||||
`ProhibitNoStrict` Policy modules even though they have a severity level that
|
||||
is greater than 1. You can set the default value for this option in your
|
||||
`.perlcriticrc` file. You can also use `-exclude` in conjunction with the
|
||||
`-include` option. Note that `-exclude` takes precedence over `-include`
|
||||
when a Policy matches both patterns.
|
||||
|
||||
**-single-policy** is a string `PATTERN`. Only one policy that matches
|
||||
`m/$PATTERN/ixms` will be used. Policies that do not match will be excluded.
|
||||
This option has precedence over the `-severity`, `-theme`, `-include`,
|
||||
`-exclude`, and `-only` options. You can set the default value for this
|
||||
option in your `.perlcriticrc` file.
|
||||
|
||||
**-top** is the maximum number of Violations to return when ranked by their
|
||||
severity levels. This must be a positive integer. Violations are still
|
||||
returned in the order that they occur within the file. Unless the `-severity`
|
||||
option is explicitly given, setting `-top` silently causes the `-severity`
|
||||
to be set to 1. You can set the default value for this option in your
|
||||
`.perlcriticrc` file.
|
||||
|
||||
**-only** is a boolean value. If set to a true value, Perl::Critic will only
|
||||
choose from Policies that are mentioned in the user's profile. If set to a
|
||||
false value (which is the default), then Perl::Critic chooses from all the
|
||||
Policies that it finds at your site. You can set the default value for this
|
||||
option in your `.perlcriticrc` file.
|
||||
|
||||
**-profile-strictness** is an enumerated value, one of
|
||||
["$PROFILE\_STRICTNESS\_WARN" in Perl::Critic::Utils::Constants](https://metacpan.org/pod/Perl::Critic::Utils::Constants#PROFILE_STRICTNESS_WARN) (the default),
|
||||
["$PROFILE\_STRICTNESS\_FATAL" in Perl::Critic::Utils::Constants](https://metacpan.org/pod/Perl::Critic::Utils::Constants#PROFILE_STRICTNESS_FATAL), and
|
||||
["$PROFILE\_STRICTNESS\_QUIET" in Perl::Critic::Utils::Constants](https://metacpan.org/pod/Perl::Critic::Utils::Constants#PROFILE_STRICTNESS_QUIET). If set to
|
||||
["$PROFILE\_STRICTNESS\_FATAL" in Perl::Critic::Utils::Constants](https://metacpan.org/pod/Perl::Critic::Utils::Constants#PROFILE_STRICTNESS_FATAL), Perl::Critic
|
||||
will make certain warnings about problems found in a `.perlcriticrc` or file
|
||||
specified via the **-profile** option fatal. For example, Perl::Critic normally
|
||||
only `warn`s about profiles referring to non-existent Policies, but this
|
||||
value makes this situation fatal. Correspondingly,
|
||||
["$PROFILE\_STRICTNESS\_QUIET" in Perl::Critic::Utils::Constants](https://metacpan.org/pod/Perl::Critic::Utils::Constants#PROFILE_STRICTNESS_QUIET) makes
|
||||
Perl::Critic shut up about these things.
|
||||
|
||||
**-force** is a boolean value that controls whether Perl::Critic observes the
|
||||
magical `"## no critic"` annotations in your code. If set to a true value,
|
||||
Perl::Critic will analyze all code. If set to a false value (which is the
|
||||
default) Perl::Critic will ignore code that is tagged with these annotations.
|
||||
See ["BENDING THE RULES"](#bending-the-rules) for more information. You can set the default
|
||||
value for this option in your `.perlcriticrc` file.
|
||||
|
||||
**-verbose** can be a positive integer (from 1 to 11), or a literal format
|
||||
specification. See [Perl::Critic::Violation](https://metacpan.org/pod/Perl::Critic::Violation) for an
|
||||
explanation of format specifications. You can set the default value for this
|
||||
option in your `.perlcriticrc` file.
|
||||
|
||||
**-unsafe** directs Perl::Critic to allow the use of Policies that are marked
|
||||
as "unsafe" by the author. Such policies may compile untrusted code or do
|
||||
other nefarious things.
|
||||
|
||||
**-color** and **-pager** are not used by Perl::Critic but is provided for the
|
||||
benefit of [perlcritic](https://metacpan.org/pod/perlcritic).
|
||||
|
||||
**-criticism-fatal** is not used by Perl::Critic but is provided for the
|
||||
benefit of [criticism](https://metacpan.org/pod/criticism).
|
||||
|
||||
**-color-severity-highest**, **-color-severity-high**, **-color-severity-
|
||||
medium**, **-color-severity-low**, and **-color-severity-lowest** are not used by
|
||||
Perl::Critic, but are provided for the benefit of [perlcritic](https://metacpan.org/pod/perlcritic).
|
||||
Each is set to the Term::ANSIColor color specification to be used to display
|
||||
violations of the corresponding severity.
|
||||
|
||||
**-files-with-violations** and **-files-without-violations** are not used by
|
||||
Perl::Critic, but are provided for the benefit of [perlcritic](https://metacpan.org/pod/perlcritic), to
|
||||
cause only the relevant filenames to be displayed.
|
||||
|
||||
# METHODS
|
||||
|
||||
- `critique( $source_code )`
|
||||
|
||||
Runs the `$source_code` through the Perl::Critic engine using all the
|
||||
Policies that have been loaded into this engine. If `$source_code` is a
|
||||
scalar reference, then it is treated as a string of actual Perl code. If
|
||||
`$source_code` is a reference to an instance of [PPI::Document](https://metacpan.org/pod/PPI::Document), then that
|
||||
instance is used directly. Otherwise, it is treated as a path to a local file
|
||||
containing Perl code. This method returns a list of
|
||||
[Perl::Critic::Violation](https://metacpan.org/pod/Perl::Critic::Violation) objects for each violation of the loaded Policies.
|
||||
The list is sorted in the order that the Violations appear in the code. If
|
||||
there are no violations, this method returns an empty list.
|
||||
|
||||
- `add_policy( -policy => $policy_name, -params => \%param_hash )`
|
||||
|
||||
Creates a Policy object and loads it into this Critic. If the object cannot
|
||||
be instantiated, it will throw a fatal exception. Otherwise, it returns a
|
||||
reference to this Critic.
|
||||
|
||||
**-policy** is the name of a [Perl::Critic::Policy](https://metacpan.org/pod/Perl::Critic::Policy) subclass module. The
|
||||
`'Perl::Critic::Policy'` portion of the name can be omitted for brevity.
|
||||
This argument is required.
|
||||
|
||||
**-params** is an optional reference to a hash of Policy parameters. The
|
||||
contents of this hash reference will be passed into to the constructor of the
|
||||
Policy module. See the documentation in the relevant Policy module for a
|
||||
description of the arguments it supports.
|
||||
|
||||
- ` policies() `
|
||||
|
||||
Returns a list containing references to all the Policy objects that have been
|
||||
loaded into this engine. Objects will be in the order that they were loaded.
|
||||
|
||||
- ` config() `
|
||||
|
||||
Returns the [Perl::Critic::Config](https://metacpan.org/pod/Perl::Critic::Config) object that was created for or given to
|
||||
this Critic.
|
||||
|
||||
- ` statistics() `
|
||||
|
||||
Returns the [Perl::Critic::Statistics](https://metacpan.org/pod/Perl::Critic::Statistics) object that was created for this
|
||||
Critic. The Statistics object accumulates data for all files that are
|
||||
analyzed by this Critic.
|
||||
|
||||
# FUNCTIONAL INTERFACE
|
||||
|
||||
For those folks who prefer to have a functional interface, The `critique`
|
||||
method can be exported on request and called as a static function. If the
|
||||
first argument is a hashref, its contents are used to construct a new
|
||||
Perl::Critic object internally. The keys of that hash should be the same as
|
||||
those supported by the `Perl::Critic::new()` method. Here are some examples:
|
||||
|
||||
use Perl::Critic qw(critique);
|
||||
|
||||
# Use default parameters...
|
||||
@violations = critique( $some_file );
|
||||
|
||||
# Use custom parameters...
|
||||
@violations = critique( {-severity => 2}, $some_file );
|
||||
|
||||
# As a one-liner
|
||||
%> perl -MPerl::Critic=critique -e 'print critique(shift)' some_file.pm
|
||||
|
||||
None of the other object-methods are currently supported as static
|
||||
functions. Sorry.
|
||||
|
||||
# CONFIGURATION
|
||||
|
||||
Most of the settings for Perl::Critic and each of the Policy modules can be
|
||||
controlled by a configuration file. The default configuration file is called
|
||||
`.perlcriticrc`. Perl::Critic will look for this file in the current
|
||||
directory first, and then in your home directory. Alternatively, you can set
|
||||
the `PERLCRITIC` environment variable to explicitly point to a different file
|
||||
in another location. If none of these files exist, and the `-profile` option
|
||||
is not given to the constructor, then all the modules that are found in the
|
||||
Perl::Critic::Policy namespace will be loaded with their default
|
||||
configuration.
|
||||
|
||||
The format of the configuration file is a series of INI-style blocks that
|
||||
contain key-value pairs separated by '='. Comments should start with '#' and
|
||||
can be placed on a separate line or after the name-value pairs if you desire.
|
||||
|
||||
Default settings for Perl::Critic itself can be set **before the first named
|
||||
block.** For example, putting any or all of these at the top of your
|
||||
configuration file will set the default value for the corresponding
|
||||
constructor argument.
|
||||
|
||||
severity = 3 #Integer or named level
|
||||
only = 1 #Zero or One
|
||||
force = 0 #Zero or One
|
||||
verbose = 4 #Integer or format spec
|
||||
top = 50 #A positive integer
|
||||
theme = (pbp || security) && bugs #A theme expression
|
||||
include = NamingConventions ClassHierarchies #Space-delimited list
|
||||
exclude = Variables Modules::RequirePackage #Space-delimited list
|
||||
criticism-fatal = 1 #Zero or One
|
||||
color = 1 #Zero or One
|
||||
allow-unsafe = 1 #Zero or One
|
||||
pager = less #pager to pipe output to
|
||||
|
||||
The remainder of the configuration file is a series of blocks like this:
|
||||
|
||||
[Perl::Critic::Policy::Category::PolicyName]
|
||||
severity = 1
|
||||
set_themes = foo bar
|
||||
add_themes = baz
|
||||
maximum_violations_per_document = 57
|
||||
arg1 = value1
|
||||
arg2 = value2
|
||||
|
||||
`Perl::Critic::Policy::Category::PolicyName` is the full name of a module
|
||||
that implements the policy. The Policy modules distributed with Perl::Critic
|
||||
have been grouped into categories according to the table of contents in Damian
|
||||
Conway's book **Perl Best Practices**. For brevity, you can omit the
|
||||
`'Perl::Critic::Policy'` part of the module name.
|
||||
|
||||
`severity` is the level of importance you wish to assign to the Policy. All
|
||||
Policy modules are defined with a default severity value ranging from 1 (least
|
||||
severe) to 5 (most severe). However, you may disagree with the default
|
||||
severity and choose to give it a higher or lower severity, based on your own
|
||||
coding philosophy. You can set the `severity` to an integer from 1 to 5, or
|
||||
use one of the equivalent names:
|
||||
|
||||
SEVERITY NAME ...is equivalent to... SEVERITY NUMBER
|
||||
----------------------------------------------------
|
||||
gentle 5
|
||||
stern 4
|
||||
harsh 3
|
||||
cruel 2
|
||||
brutal 1
|
||||
|
||||
The names reflect how severely the code is criticized: a `gentle` criticism
|
||||
reports only the most severe violations, and so on down to a `brutal`
|
||||
criticism which reports even the most minor violations.
|
||||
|
||||
`set_themes` sets the theme for the Policy and overrides its default theme.
|
||||
The argument is a string of one or more whitespace-delimited alphanumeric
|
||||
words. Themes are case-insensitive. See ["POLICY THEMES"](#policy-themes) for more
|
||||
information.
|
||||
|
||||
`add_themes` appends to the default themes for this Policy. The argument is
|
||||
a string of one or more whitespace-delimited words. Themes are case-
|
||||
insensitive. See ["POLICY THEMES"](#policy-themes) for more information.
|
||||
|
||||
`maximum_violations_per_document` limits the number of Violations the Policy
|
||||
will return for a given document. Some Policies have a default limit; see the
|
||||
documentation for the individual Policies to see whether there is one. To
|
||||
force a Policy to not have a limit, specify "no\_limit" or the empty string for
|
||||
the value of this parameter.
|
||||
|
||||
The remaining key-value pairs are configuration parameters that will be passed
|
||||
into the constructor for that Policy. The constructors for most Policy
|
||||
objects do not support arguments, and those that do should have reasonable
|
||||
defaults. See the documentation on the appropriate Policy module for more
|
||||
details.
|
||||
|
||||
Instead of redefining the severity for a given Policy, you can completely
|
||||
disable a Policy by prepending a '-' to the name of the module in your
|
||||
configuration file. In this manner, the Policy will never be loaded,
|
||||
regardless of the `-severity` given to the Perl::Critic constructor.
|
||||
|
||||
A simple configuration might look like this:
|
||||
|
||||
#--------------------------------------------------------------
|
||||
# I think these are really important, so always load them
|
||||
|
||||
[TestingAndDebugging::RequireUseStrict]
|
||||
severity = 5
|
||||
|
||||
[TestingAndDebugging::RequireUseWarnings]
|
||||
severity = 5
|
||||
|
||||
#--------------------------------------------------------------
|
||||
# I think these are less important, so only load when asked
|
||||
|
||||
[Variables::ProhibitPackageVars]
|
||||
severity = 2
|
||||
|
||||
[ControlStructures::ProhibitPostfixControls]
|
||||
allow = if unless # My custom configuration
|
||||
severity = cruel # Same as "severity = 2"
|
||||
|
||||
#--------------------------------------------------------------
|
||||
# Give these policies a custom theme. I can activate just
|
||||
# these policies by saying `perlcritic -theme larry`
|
||||
|
||||
[Modules::RequireFilenameMatchesPackage]
|
||||
add_themes = larry
|
||||
|
||||
[TestingAndDebugging::RequireTestLables]
|
||||
add_themes = larry curly moe
|
||||
|
||||
#--------------------------------------------------------------
|
||||
# I do not agree with these at all, so never load them
|
||||
|
||||
[-NamingConventions::Capitalization]
|
||||
[-ValuesAndExpressions::ProhibitMagicNumbers]
|
||||
|
||||
#--------------------------------------------------------------
|
||||
# For all other Policies, I accept the default severity,
|
||||
# so no additional configuration is required for them.
|
||||
|
||||
For additional configuration examples, see the `perlcriticrc` file that is
|
||||
included in this `examples` directory of this distribution.
|
||||
|
||||
Damian Conway's own Perl::Critic configuration is also included in this
|
||||
distribution as `examples/perlcriticrc-conway`.
|
||||
|
||||
# THE POLICIES
|
||||
|
||||
A large number of Policy modules are distributed with Perl::Critic. They are
|
||||
described briefly in the companion document [Perl::Critic::PolicySummary](https://metacpan.org/pod/Perl::Critic::PolicySummary) and
|
||||
in more detail in the individual modules themselves. Say `"perlcritic -doc
|
||||
PATTERN"` to see the perldoc for all Policy modules that match the regex
|
||||
`m/PATTERN/ixms`
|
||||
|
||||
There are a number of distributions of additional policies on CPAN. If
|
||||
[Perl::Critic](https://metacpan.org/pod/Perl::Critic) doesn't contain a policy that you want, some one may have
|
||||
already written it. See the ["SEE ALSO"](#see-also) section below for a list of some
|
||||
of these distributions.
|
||||
|
||||
# POLICY THEMES
|
||||
|
||||
Each Policy is defined with one or more "themes". Themes can be used to
|
||||
create arbitrary groups of Policies. They are intended to provide an
|
||||
alternative mechanism for selecting your preferred set of Policies. For
|
||||
example, you may wish disable a certain subset of Policies when analyzing test
|
||||
programs. Conversely, you may wish to enable only a specific subset of
|
||||
Policies when analyzing modules.
|
||||
|
||||
The Policies that ship with Perl::Critic have been broken into the following
|
||||
themes. This is just our attempt to provide some basic logical groupings.
|
||||
You are free to invent new themes that suit your needs.
|
||||
|
||||
THEME DESCRIPTION
|
||||
--------------------------------------------------------------------------
|
||||
core All policies that ship with Perl::Critic
|
||||
pbp Policies that come directly from "Perl Best Practices"
|
||||
bugs Policies that that prevent or reveal bugs
|
||||
certrec Policies that CERT recommends
|
||||
certrule Policies that CERT considers rules
|
||||
maintenance Policies that affect the long-term health of the code
|
||||
cosmetic Policies that only have a superficial effect
|
||||
complexity Policies that specifically relate to code complexity
|
||||
security Policies that relate to security issues
|
||||
tests Policies that are specific to test programs
|
||||
|
||||
Any Policy may fit into multiple themes. Say `"perlcritic -list"` to get a
|
||||
listing of all available Policies and the themes that are associated with each
|
||||
one. You can also change the theme for any Policy in your `.perlcriticrc`
|
||||
file. See the ["CONFIGURATION"](#configuration) section for more information about that.
|
||||
|
||||
Using the `-theme` option, you can create an arbitrarily complex rule that
|
||||
determines which Policies will be loaded. Precedence is the same as regular
|
||||
Perl code, and you can use parentheses to enforce precedence as well.
|
||||
Supported operators are:
|
||||
|
||||
Operator Alternative Example
|
||||
-----------------------------------------------------------------
|
||||
&& and 'pbp && core'
|
||||
|| or 'pbp || (bugs && security)'
|
||||
! not 'pbp && ! (portability || complexity)'
|
||||
|
||||
Theme names are case-insensitive. If the `-theme` is set to an empty string,
|
||||
then it evaluates as true all Policies.
|
||||
|
||||
# BENDING THE RULES
|
||||
|
||||
Perl::Critic takes a hard-line approach to your code: either you comply or you
|
||||
don't. In the real world, it is not always practical (nor even possible) to
|
||||
fully comply with coding standards. In such cases, it is wise to show that
|
||||
you are knowingly violating the standards and that you have a Damn Good Reason
|
||||
(DGR) for doing so.
|
||||
|
||||
To help with those situations, you can direct Perl::Critic to ignore certain
|
||||
lines or blocks of code by using annotations:
|
||||
|
||||
require 'LegacyLibaray1.pl'; ## no critic
|
||||
require 'LegacyLibrary2.pl'; ## no critic
|
||||
|
||||
for my $element (@list) {
|
||||
|
||||
## no critic
|
||||
|
||||
$foo = ""; #Violates 'ProhibitEmptyQuotes'
|
||||
$barf = bar() if $foo; #Violates 'ProhibitPostfixControls'
|
||||
#Some more evil code...
|
||||
|
||||
## use critic
|
||||
|
||||
#Some good code...
|
||||
do_something($_);
|
||||
}
|
||||
|
||||
The `"## no critic"` annotations direct Perl::Critic to ignore the remaining
|
||||
lines of code until a `"## use critic"` annotation is found. If the `"## no
|
||||
critic"` annotation is on the same line as a code statement, then only that
|
||||
line of code is overlooked. To direct perlcritic to ignore the `"## no
|
||||
critic"` annotations, use the `--force` option.
|
||||
|
||||
A bare `"## no critic"` annotation disables all the active Policies. If you
|
||||
wish to disable only specific Policies, add a list of Policy names as
|
||||
arguments, just as you would for the `"no strict"` or `"no warnings"`
|
||||
pragmas. For example, this would disable the `ProhibitEmptyQuotes` and
|
||||
`ProhibitPostfixControls` policies until the end of the block or until the
|
||||
next `"## use critic"` annotation (whichever comes first):
|
||||
|
||||
## no critic (EmptyQuotes, PostfixControls)
|
||||
|
||||
# Now exempt from ValuesAndExpressions::ProhibitEmptyQuotes
|
||||
$foo = "";
|
||||
|
||||
# Now exempt ControlStructures::ProhibitPostfixControls
|
||||
$barf = bar() if $foo;
|
||||
|
||||
# Still subjected to ValuesAndExpression::RequireNumberSeparators
|
||||
$long_int = 10000000000;
|
||||
|
||||
Since the Policy names are matched against the `"## no critic"` arguments as
|
||||
regular expressions, you can abbreviate the Policy names or disable an entire
|
||||
family of Policies in one shot like this:
|
||||
|
||||
## no critic (NamingConventions)
|
||||
|
||||
# Now exempt from NamingConventions::Capitalization
|
||||
my $camelHumpVar = 'foo';
|
||||
|
||||
# Now exempt from NamingConventions::Capitalization
|
||||
sub camelHumpSub {}
|
||||
|
||||
The argument list must be enclosed in parentheses or brackets and must contain
|
||||
one or more comma-separated barewords (e.g. don't use quotes).
|
||||
The `"## no critic"` annotations can be nested, and Policies named by an inner
|
||||
annotation will be disabled along with those already disabled an outer
|
||||
annotation.
|
||||
|
||||
Some Policies like `Subroutines::ProhibitExcessComplexity` apply to an entire
|
||||
block of code. In those cases, the `"## no critic"` annotation must appear
|
||||
on the line where the violation is reported. For example:
|
||||
|
||||
sub complicated_function { ## no critic (ProhibitExcessComplexity)
|
||||
# Your code here...
|
||||
}
|
||||
|
||||
Policies such as `Documentation::RequirePodSections` apply to the entire
|
||||
document, in which case violations are reported at line 1.
|
||||
|
||||
Use this feature wisely. `"## no critic"` annotations should be used in the
|
||||
smallest possible scope, or only on individual lines of code. And you should
|
||||
always be as specific as possible about which Policies you want to disable
|
||||
(i.e. never use a bare `"## no critic"`). If Perl::Critic complains about
|
||||
your code, try and find a compliant solution before resorting to this feature.
|
||||
|
||||
# THE [Perl::Critic](https://metacpan.org/pod/Perl::Critic) PHILOSOPHY
|
||||
|
||||
Coding standards are deeply personal and highly subjective. The goal of
|
||||
Perl::Critic is to help you write code that conforms with a set of best
|
||||
practices. Our primary goal is not to dictate what those practices are, but
|
||||
rather, to implement the practices discovered by others. Ultimately, you make
|
||||
the rules -- Perl::Critic is merely a tool for encouraging consistency. If
|
||||
there is a policy that you think is important or that we have overlooked, we
|
||||
would be very grateful for contributions, or you can simply load your own
|
||||
private set of policies into Perl::Critic.
|
||||
|
||||
# EXTENDING THE CRITIC
|
||||
|
||||
The modular design of Perl::Critic is intended to facilitate the addition of
|
||||
new Policies. You'll need to have some understanding of [PPI](https://metacpan.org/pod/PPI), but most
|
||||
Policy modules are pretty straightforward and only require about 20 lines of
|
||||
code. Please see the [Perl::Critic::DEVELOPER](https://metacpan.org/pod/Perl::Critic::DEVELOPER) file included in this
|
||||
distribution for a step-by-step demonstration of how to create new Policy
|
||||
modules.
|
||||
|
||||
If you develop any new Policy modules, feel free to send them to `<team@perlcritic.com>` and I'll be happy to consider putting them into the
|
||||
Perl::Critic distribution. Or if you would like to work on the Perl::Critic
|
||||
project directly, you can fork our repository at
|
||||
[https://github.com/Perl-Critic/Perl-Critic.git](https://github.com/Perl-Critic/Perl-Critic.git).
|
||||
|
||||
The Perl::Critic team is also available for hire. If your organization has
|
||||
its own coding standards, we can create custom Policies to enforce your local
|
||||
guidelines. Or if your code base is prone to a particular defect pattern, we
|
||||
can design Policies that will help you catch those costly defects **before**
|
||||
they go into production. To discuss your needs with the Perl::Critic team,
|
||||
just contact `<team@perlcritic.com>`.
|
||||
|
||||
# PREREQUISITES
|
||||
|
||||
Perl::Critic requires the following modules:
|
||||
|
||||
[B::Keywords](https://metacpan.org/pod/B::Keywords)
|
||||
|
||||
[Config::Tiny](https://metacpan.org/pod/Config::Tiny)
|
||||
|
||||
[Exception::Class](https://metacpan.org/pod/Exception::Class)
|
||||
|
||||
[File::Spec](https://metacpan.org/pod/File::Spec)
|
||||
|
||||
[File::Spec::Unix](https://metacpan.org/pod/File::Spec::Unix)
|
||||
|
||||
[File::Which](https://metacpan.org/pod/File::Which)
|
||||
|
||||
[IO::String](https://metacpan.org/pod/IO::String)
|
||||
|
||||
[List::MoreUtils](https://metacpan.org/pod/List::MoreUtils)
|
||||
|
||||
[List::Util](https://metacpan.org/pod/List::Util)
|
||||
|
||||
[Module::Pluggable](https://metacpan.org/pod/Module::Pluggable)
|
||||
|
||||
[Perl::Tidy](https://metacpan.org/pod/Perl::Tidy)
|
||||
|
||||
[Pod::Spell](https://metacpan.org/pod/Pod::Spell)
|
||||
|
||||
[PPI](https://metacpan.org/pod/PPI)
|
||||
|
||||
[Pod::PlainText](https://metacpan.org/pod/Pod::PlainText)
|
||||
|
||||
[Pod::Select](https://metacpan.org/pod/Pod::Select)
|
||||
|
||||
[Pod::Usage](https://metacpan.org/pod/Pod::Usage)
|
||||
|
||||
[Readonly](https://metacpan.org/pod/Readonly)
|
||||
|
||||
[Scalar::Util](https://metacpan.org/pod/Scalar::Util)
|
||||
|
||||
[String::Format](https://metacpan.org/pod/String::Format)
|
||||
|
||||
[Task::Weaken](https://metacpan.org/pod/Task::Weaken)
|
||||
|
||||
[Term::ANSIColor](https://metacpan.org/pod/Term::ANSIColor)
|
||||
|
||||
[Text::ParseWords](https://metacpan.org/pod/Text::ParseWords)
|
||||
|
||||
[version](https://metacpan.org/pod/version)
|
||||
|
||||
# CONTACTING THE DEVELOPMENT TEAM
|
||||
|
||||
You are encouraged to subscribe to the public mailing list at
|
||||
[https://groups.google.com/d/forum/perl-critic](https://groups.google.com/d/forum/perl-critic).
|
||||
At least one member of the development team is usually hanging around
|
||||
in [irc://irc.perl.org/#perlcritic](irc://irc.perl.org/#perlcritic) and you can follow Perl::Critic on
|
||||
Twitter, at [https://twitter.com/perlcritic](https://twitter.com/perlcritic).
|
||||
|
||||
# SEE ALSO
|
||||
|
||||
There are a number of distributions of additional Policies available. A few
|
||||
are listed here:
|
||||
|
||||
[Perl::Critic::More](https://metacpan.org/pod/Perl::Critic::More)
|
||||
|
||||
[Perl::Critic::Bangs](https://metacpan.org/pod/Perl::Critic::Bangs)
|
||||
|
||||
[Perl::Critic::Lax](https://metacpan.org/pod/Perl::Critic::Lax)
|
||||
|
||||
[Perl::Critic::StricterSubs](https://metacpan.org/pod/Perl::Critic::StricterSubs)
|
||||
|
||||
[Perl::Critic::Swift](https://metacpan.org/pod/Perl::Critic::Swift)
|
||||
|
||||
[Perl::Critic::Tics](https://metacpan.org/pod/Perl::Critic::Tics)
|
||||
|
||||
These distributions enable you to use Perl::Critic in your unit tests:
|
||||
|
||||
[Test::Perl::Critic](https://metacpan.org/pod/Test::Perl::Critic)
|
||||
|
||||
[Test::Perl::Critic::Progressive](https://metacpan.org/pod/Test::Perl::Critic::Progressive)
|
||||
|
||||
There is also a distribution that will install all the Perl::Critic related
|
||||
modules known to the development team:
|
||||
|
||||
[Task::Perl::Critic](https://metacpan.org/pod/Task::Perl::Critic)
|
||||
|
||||
# BUGS
|
||||
|
||||
Scrutinizing Perl code is hard for humans, let alone machines. If you find
|
||||
any bugs, particularly false-positives or false-negatives from a
|
||||
Perl::Critic::Policy, please submit them at
|
||||
[https://github.com/Perl-Critic/Perl-Critic/issues](https://github.com/Perl-Critic/Perl-Critic/issues). Thanks.
|
||||
|
||||
# CREDITS
|
||||
|
||||
Adam Kennedy - For creating [PPI](https://metacpan.org/pod/PPI), the heart and soul of [Perl::Critic](https://metacpan.org/pod/Perl::Critic).
|
||||
|
||||
Damian Conway - For writing **Perl Best Practices**, finally :)
|
||||
|
||||
Chris Dolan - For contributing the best features and Policy modules.
|
||||
|
||||
Andy Lester - Wise sage and master of all-things-testing.
|
||||
|
||||
Elliot Shank - The self-proclaimed quality freak.
|
||||
|
||||
Giuseppe Maxia - For all the great ideas and positive encouragement.
|
||||
|
||||
and Sharon, my wife - For putting up with my all-night code sessions.
|
||||
|
||||
Thanks also to the Perl Foundation for providing a grant to support Chris
|
||||
Dolan's project to implement twenty PBP policies.
|
||||
[http://www.perlfoundation.org/april\_1\_2007\_new\_grant\_awards](http://www.perlfoundation.org/april_1_2007_new_grant_awards)
|
||||
|
||||
Thanks also to this incomplete laundry list of folks who have contributed
|
||||
to Perl::Critic in some way:
|
||||
Gregory Oschwald,
|
||||
Mike O'Regan,
|
||||
Tom Hukins,
|
||||
Omer Gazit,
|
||||
Evan Zacks,
|
||||
Paul Howarth,
|
||||
Sawyer X,
|
||||
Christian Walde,
|
||||
Dave Rolsky,
|
||||
Jakub Wilk,
|
||||
Roy Ivy III,
|
||||
Oliver Trosien,
|
||||
Glenn Fowler,
|
||||
Matt Creenan,
|
||||
Alex Balhatchet,
|
||||
Sebastian Paaske Tørholm,
|
||||
Stuart A Johnston,
|
||||
Dan Book,
|
||||
Steven Humphrey,
|
||||
James Raspass,
|
||||
Nick Tonkin,
|
||||
Harrison Katz,
|
||||
Douglas Sims,
|
||||
Mark Fowler,
|
||||
Alan Berndt,
|
||||
Neil Bowers,
|
||||
Sergey Romanov,
|
||||
Gabor Szabo,
|
||||
Graham Knop,
|
||||
Mike Eldridge,
|
||||
David Steinbrunner,
|
||||
Kirk Kimmel,
|
||||
Guillaume Aubert,
|
||||
Dave Cross,
|
||||
Anirvan Chatterjee,
|
||||
Todd Rinaldo,
|
||||
Graham Ollis,
|
||||
Karen Etheridge,
|
||||
Jonas Brømsø,
|
||||
Olaf Alders,
|
||||
Jim Keenan,
|
||||
Slaven Rezić,
|
||||
Szymon Nieznański.
|
||||
|
||||
# AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
# COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2018 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it under
|
||||
the same terms as Perl itself. The full text of this license can be found in
|
||||
the LICENSE file included with this module.
|
||||
|
|
@ -0,0 +1,677 @@
|
|||
# best viewed via "perldoc TODO.pod"
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords API LHS RHS REFACTORINGS FH SVN stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::TODO - Things for Perl::Critic developers to do
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Perl-Critic-More is a separate distribution for less-widely-accepted
|
||||
policies. It contains its own TODO.pod.
|
||||
|
||||
=head1 NEW FEATURES
|
||||
|
||||
=over
|
||||
|
||||
=item * Report PBP and Safari sections in addition to PBP page numbers.
|
||||
|
||||
Something like
|
||||
|
||||
Readonly::Scalar my $EXPL => {
|
||||
pbp_pages => [ 57 ],
|
||||
pbp_section => '5.2',
|
||||
safari_section => something,
|
||||
};
|
||||
|
||||
=item * Include PBP references and Safari sections in the documentation.
|
||||
|
||||
Perhaps these could be injected into the POD at build time, based on the data
|
||||
in the code. But that data is not entirely static, so I'm not sure how it
|
||||
would work for Policies that dynamically determine the PBP references.
|
||||
|
||||
Perhaps it would be good enough to just create a one-off tool that would
|
||||
inject the PBP and/or Safari references into the POD one time, and we could
|
||||
manually deal with Policies that behave oddly.
|
||||
|
||||
Much better would be to put the information in the POD in a structured manner
|
||||
and parse it out in the code, something along the lines of
|
||||
|
||||
=head1 METADATA
|
||||
|
||||
=over
|
||||
|
||||
=item Default Themes
|
||||
|
||||
core bugs pbp
|
||||
|
||||
=item Default Severity
|
||||
|
||||
3
|
||||
|
||||
=item Perl Best Practices Page Numbers
|
||||
|
||||
193, 195
|
||||
|
||||
=back
|
||||
|
||||
and so on.
|
||||
|
||||
|
||||
=item * Add a file Parameter::Behavior.
|
||||
|
||||
|
||||
=item * Allow values of (at least) string-list Parameters to be specified in a file.
|
||||
|
||||
For the benefit of PodSpelling, etc.
|
||||
|
||||
|
||||
=item * Enhance string-list Behavior to allow specification of delimiters.
|
||||
|
||||
For things like RequirePodSections.
|
||||
|
||||
|
||||
=item * Add queries to --list option to F<perlcritic>.
|
||||
|
||||
List Policies based upon severity, theme, and (what I want this second)
|
||||
applies_to.
|
||||
|
||||
=item * Add formatting of --list output.
|
||||
|
||||
Support Jeff Bisbee's use case (he dumps all the policies in severity order
|
||||
with full descriptions and other metadata).
|
||||
|
||||
=item * Support for C<#line 123 "filename"> directives.
|
||||
|
||||
For code generators and template languages that allow inline Perl code.
|
||||
|
||||
Yes, somebody has an in-house templating system where they've written a custom
|
||||
test module that extracts the perl code from a template and critiques it.
|
||||
|
||||
Actually, this would be useful for programs: Module::Build "fixes" shebang
|
||||
lines so that there's the bit about invoking perl if the program is attempted
|
||||
to be run by a Bourne shell, which throws the line numbers off when using
|
||||
Test::P::C on the contents of a C<blib> directory.
|
||||
|
||||
This has been implemented in PPI, but hasn't been released yet. When it does
|
||||
come out, we need to change the line and file reported by Violations.
|
||||
|
||||
|
||||
=item * Enhance statistics.
|
||||
|
||||
- Blank line count
|
||||
|
||||
- POD line count
|
||||
|
||||
- Comment line count
|
||||
|
||||
- Data section count
|
||||
|
||||
Proposed implementation committed 15-Mar-2007 by wyant, about revision 3240.
|
||||
|
||||
|
||||
=item * Detect 5.10 source and enable stuff for that.
|
||||
|
||||
For example, treat C<say> as equivalent to C<print>.
|
||||
|
||||
=item * Detect 5.12 source and enable stuff for that.
|
||||
|
||||
Yes, this is long-term, and is really a list of stuff from 5.011 to enable if
|
||||
it makes it into 5.12, gleaned from the perl511xdelta files:
|
||||
|
||||
'use 5.011;' implies 'use strict;' and 'use feature qw{ :5.11 };' per
|
||||
perl5110delta.
|
||||
|
||||
'sub foo { ... }' (yes, with the subroutine body being an elipsis a.k.a. the
|
||||
'yada yada' operator) compiles but fails at runtime per perl5110delta. PPI
|
||||
seems to parse this sanely as of 1.206.
|
||||
|
||||
'package Foo 1.23;' is equivalent to 'package Foo; our $VERSION = 1.23;' per
|
||||
perl5111delta. PPI seems to parse this sanely as of 1.206.
|
||||
|
||||
Nothing additional found in perl5112delta, which is the most recent as of the
|
||||
addition of this item.
|
||||
|
||||
=item * Detect 5.14 source and enable stuff for that.
|
||||
|
||||
5.13.7 allows references in many places where arrays or hashes used to
|
||||
be required (e.g. C<push $stack, 'foo'> where C<$stack> is an array
|
||||
ref). Not sure what policies are affected.
|
||||
|
||||
Lexical regular expression modifier defaults via (e.g.)
|
||||
C<use re '/smx'>). This also interacts with
|
||||
C<use feature 'unicode_strings'>. 5.13.7.
|
||||
|
||||
=item * Support a means of failing if a Policy isn't installed.
|
||||
|
||||
For example, the self compliance test now depends upon a Policy in the More
|
||||
distribution.
|
||||
|
||||
Something like using a "+" sign in front of the Policy name in its
|
||||
configuration block, analogous to the "-" sign used for disabling a policy,
|
||||
e.g. "C<[+Example::Policy]>".
|
||||
|
||||
|
||||
=item * Threading
|
||||
|
||||
Pretty obviously, Perl::Critic is readily parallelizable, just do a document per
|
||||
thread. ("readily" being conceptual, not necessarily practical) Although
|
||||
there's now C<Policy::prepare_to_scan_document()>, given perl's thread data
|
||||
sharing model, this shouldn't be an issue.
|
||||
|
||||
|
||||
=item * Add support in .run files for regexes for violation descriptions.
|
||||
|
||||
=item * Add support for "## use critic (blah)".
|
||||
|
||||
If I've got:
|
||||
|
||||
## no critic (SomePolicy)
|
||||
|
||||
...
|
||||
|
||||
## no critic (ADifferentPolicy)
|
||||
|
||||
...
|
||||
|
||||
## no critic (YetAnotherPolicy)
|
||||
|
||||
If I want to turn C<YetAnotherPolicy> back on but neither C<SomePolicy> nor
|
||||
C<ADifferentPolicy>, I've got to do this:
|
||||
|
||||
## use critic
|
||||
## no critic (SomePolicy, ADifferentPolicy)
|
||||
|
||||
Why can't I do this:
|
||||
|
||||
## use critic (SomeOtherPolicy)
|
||||
|
||||
|
||||
=item * Create P::C::Node and make P::C::Document a subclass and make use of PPIx::Utilities::Node::split_ppi_node_by_namespace() to provide per-namespace caching of lookups that are now on P::C::Document.
|
||||
|
||||
This is necessary to get P::C::Moose Policies correct.
|
||||
|
||||
|
||||
=item * Use L<version|version> to declare C<$VERSION> numbers throughout P::C
|
||||
|
||||
PBP recommends using the L<version|version> module. I chose not to follow that
|
||||
recommendation because L<version|version> didn't work with the Perl v5.6.1 that I had
|
||||
at $work at that time (and I really wanted to use Perl::Critic at work).
|
||||
But now the L<version|version> has been updated and those bugs may have been fixed,
|
||||
or perhaps we just don't care about running on Perl v5.6.1 any more. So
|
||||
maybe now we can go ahead and use L<version|version>.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 BUGS/LIMITATIONS
|
||||
|
||||
Document bugs for individual Policies in the Policies themselves. Users
|
||||
should be aware of limitations. (And, hey, we might get patches that way.)
|
||||
|
||||
|
||||
=head1 OTHER PBP POLICIES THAT SEEM FEASIBLE TO IMPLEMENT
|
||||
|
||||
=over
|
||||
|
||||
=item * Modules::RequireUseVersion [405-406]
|
||||
|
||||
=item * Modules::RequireThreePartVersion [405-406]
|
||||
|
||||
|
||||
=item * NamingConventions::RequireArrayAndHashReferenceVariablesEndWith_Ref [41-42]
|
||||
|
||||
Check for C<$variable = [...]>, C<$variable = {...}>, C<< $variable->[...] >>, and
|
||||
C<< $variable->{...} >>.
|
||||
|
||||
|
||||
=item * Objects::ProhibitRestrictedHashes [322-323]
|
||||
|
||||
Look for use of the bad methods in Hash::Util.
|
||||
|
||||
|
||||
=item * Objects::ProhibitLValueAccessors [346-349]
|
||||
|
||||
Look for the C<:lvalue> subroutine attribute.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 NON-PBP POLICIES WANTED
|
||||
|
||||
=over
|
||||
|
||||
=item * Subroutines::RequireArgumentValidation
|
||||
|
||||
Enforce the use of Params::Validate or Params::Util or some other
|
||||
argument validation mechanism. This could be one Policy that
|
||||
can be configured for different validation mechanisms, or we could
|
||||
have a separate Policy for each mechanism, and let the user choose
|
||||
which one they want to use (I think I prefer the later).
|
||||
|
||||
|
||||
=item * NamingConventions::ProhibitMisspelledSymbolNames
|
||||
|
||||
The idea behind this policy is to encourage better names for variables
|
||||
and subroutines by enforcing correct spelling and prohibiting the use of
|
||||
home-grown abbreviations. Assuming that the author uses underscores or
|
||||
camel-case, it should be possible to split symbols into words, and then look
|
||||
them up in a dictionary (see PodSpelling). This policy should probably have
|
||||
a similar stopwords feature as well.
|
||||
|
||||
|
||||
=item * Documentation::RequireModuleAbstract
|
||||
|
||||
Require a C<=head1 NAME> POD section with content that matches
|
||||
C<\A \s* [\w:]+ \s+ - \s+ \S>. The single hyphen is the important bit. Also,
|
||||
must be a single line.
|
||||
|
||||
|
||||
=item * Expressions::RequireFatCommasInHashConstructors
|
||||
|
||||
=item * ErrorHandling::RequireLocalizingGlobalErrorVariablesInDESTROY
|
||||
|
||||
Prevent C<$.>, C<$@>, C<$!>, C<$^E>, and C<$?> from being cleared unexpectedly
|
||||
by DESTROY methods.
|
||||
|
||||
package Foo;
|
||||
|
||||
sub DESTROY {
|
||||
die "Died in Foo::DESTROY()";
|
||||
}
|
||||
|
||||
package main;
|
||||
|
||||
eval {
|
||||
my $foo = Foo->new();
|
||||
|
||||
die "Died in eval."
|
||||
}
|
||||
print $@; # "Died in Foo::DESTROY()", not "Died in eval.".
|
||||
|
||||
See L<http://use.perl.org/~Ovid/journal/36767> and
|
||||
L<http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-06/msg00542.html>.
|
||||
|
||||
|
||||
=item * Expressions::ProhibitDecimalWithBitwiseOperator
|
||||
|
||||
=item * Expressions::ProhibitStringsWithBitwiseOperator
|
||||
|
||||
|
||||
=item * InputOutput::ProhibitMagicDiamond
|
||||
|
||||
Steal the idea from L<B::Lint|B::Lint>.
|
||||
|
||||
|
||||
=item * NamingConventions::RequireArrayAndHashReferenceVariablesEndWith_Ref
|
||||
|
||||
|
||||
=item * Programs::RequireShebang
|
||||
|
||||
Anything that is a program should have a shebang line. This includes .t
|
||||
files.
|
||||
|
||||
|
||||
=item * Modules::RequirePackageDeclarationAsFirstStatementInModule
|
||||
|
||||
See L<http://blog.woobling.org/2009/11/scoping-of-current-package.html>.
|
||||
Ouch.
|
||||
|
||||
|
||||
=item * BuiltinFunctions::RequireConstantSprintfFormat
|
||||
|
||||
|
||||
=item * BuiltinFunctions::RequireConstantUnpackFormat
|
||||
|
||||
L<http://diotalevi.isa-geek.net/~josh/yapc-lint/slides/slide5.html>
|
||||
|
||||
|
||||
=item * Miscellanea::ProhibitObnoxiousComments
|
||||
|
||||
Forbid excessive hash marks e.g. "#### This is a loud comment ####".
|
||||
Make the obnoxious pattern configurable
|
||||
|
||||
|
||||
=item * ValuesAndExpressions::RequireNotOperator
|
||||
|
||||
Require the use of "not" instead of "!", except when this would contradict
|
||||
ProhibitMixedBooleanOperators. This may be better suited for
|
||||
Perl::Critic::More.
|
||||
|
||||
|
||||
=item * ValuesAndExpressions::ProhibitUnusedReadonlyConstants
|
||||
|
||||
We'll only be able to look at lexicals. For similar reasons, we can't do
|
||||
anything about L<constant>.
|
||||
|
||||
|
||||
=item * Modules::RequireExplicitImporting
|
||||
|
||||
Require every C<use> statement to have an explicit import list. You could
|
||||
still get around this by calling C<import> directly.
|
||||
|
||||
|
||||
=item * Modules::ForbidImporting
|
||||
|
||||
Require every C<use> to have an explicitly empty import list. This is for
|
||||
folks who like to see fully-qualified function names. Should probably provide
|
||||
a list of exempt modules (like FindBin);
|
||||
|
||||
|
||||
=item * ControlStructures::ProhibitIncludeViaDo
|
||||
|
||||
Forbid C<do "foo.pl">. Not sure about this policy name.
|
||||
|
||||
|
||||
=item * Variables::ProhibitUseVars
|
||||
|
||||
Disallow C<use vars qw(...)> and require C<our $foo> instead. This
|
||||
contradicts Miscellanea::Prohibit5006isms. Maybe verify C<use 5.6> before
|
||||
applying this policy. Low severity.
|
||||
|
||||
|
||||
=item * VariablesAndExpressions::ProhibitQuotedHashKeys
|
||||
|
||||
Forbid quotes around hash keys, unless they are really needed. This is
|
||||
against what Damian says. Suggested by Adam Kennedy. Low severity.
|
||||
|
||||
|
||||
=item * CodeLayout::ProhibitFunctionalNew
|
||||
|
||||
Good: C<< Foo::Bar->new >>, Bad: C<< new Foo::Bar >>
|
||||
|
||||
|
||||
=item * RegularExpressions::ProhibitSWSWSW
|
||||
|
||||
Require C<split> instead of C<m/\s*\w*\s*\w*\s*/>. From MJD's Red Flags.
|
||||
|
||||
|
||||
=item * Documentation::RequireSynopsis
|
||||
|
||||
|
||||
=item * Documentation::RequireLicense
|
||||
|
||||
These are simplified versions of Documentation::RequirePodSections.
|
||||
|
||||
|
||||
=item * Documentation::RequireValidSynopsis
|
||||
|
||||
The Synopsis section must be all indented and must be syntactically valid Perl
|
||||
(as validated by PPI).
|
||||
|
||||
|
||||
=item * Documentation::ProhibitEmptySections
|
||||
|
||||
Any C<=headN> and C<=over> sections must not be empty. This helps catch
|
||||
boilerplate (although Test::Pod should catch empty C<=over> blocks).
|
||||
|
||||
On the other hand, C<=item ...> sections can be empty, since the item label is
|
||||
content.
|
||||
|
||||
|
||||
=item * Miscellaneous::ProhibitBoilerplate
|
||||
|
||||
Complain about copy-and-paste code or docs from h2xs, Module::Starter::*, etc.
|
||||
|
||||
Here's a non-PPI implementation:
|
||||
L<http://search.cpan.org/src/JJORE/Carp-Clan-5.8/t/04boilerplate.t>
|
||||
|
||||
|
||||
=item * NamingConventions::ProhibitPackagesSubroutinesAndBarewordFileHandlesWithTheSameNames
|
||||
|
||||
See
|
||||
L<http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2009-01/msg00685.html>.
|
||||
|
||||
|
||||
=item * BuiltinFunctions::ProhibitExtraneousScalarCall
|
||||
|
||||
Recommend that C<if (scalar @array)> be rewritten as C<if (@array)>.
|
||||
|
||||
|
||||
=item * RegularExpressions::ProhibitMixedDelimiters
|
||||
|
||||
Ban s{foo}(bar)
|
||||
|
||||
|
||||
=item * RegularExpressions::ProhibitScalarAsRegexp
|
||||
|
||||
Ban naked strings as regexps, like:
|
||||
|
||||
print 1 if $str =~ $regexp;
|
||||
|
||||
Instead, it should be:
|
||||
|
||||
print 1 if $str =~ m/$regexp/;
|
||||
|
||||
or
|
||||
|
||||
print 1 if $str =~ m/$regexp/xms;
|
||||
|
||||
|
||||
=item * ValuesAndExpressions::RequireInterpolatedStringyEval
|
||||
|
||||
Ensure that the argument to a stringy eval is not a constant string. That's
|
||||
just wasteful. Real world examples include:
|
||||
|
||||
eval 'use Optional::Module';
|
||||
|
||||
which is better written as
|
||||
|
||||
eval { require Optional::Module; Optional::Module->import };
|
||||
|
||||
for performance gains and compile-time syntax checking.
|
||||
|
||||
Question: This is very similar to BuiltinFunctions::ProhibitStringyEval. What
|
||||
does the new policy buy us? Could we get the same thing with an option on the
|
||||
latter to forbid un-interpolated includes even if C<allow_includes> is turned
|
||||
on?
|
||||
|
||||
|
||||
=item * RegularExpressions::ProhibitUnnecessaryEscapes
|
||||
|
||||
Complain if user puts a backslash escape in front of non-special characters.
|
||||
For example:
|
||||
|
||||
m/\!/;
|
||||
|
||||
Make exceptions for C<\">, C<\'> and C<\`> since those are often inserted to
|
||||
workaround bugs in syntax highlighting.
|
||||
|
||||
Note that this is different inside character classes, where only C<^>, C<]>
|
||||
and C<-> need to be escaped, I think. Caret only needs to be escaped at the
|
||||
beginning, and dash does NOT need to be escaped at the beginning and end. See
|
||||
L<perlreref|perlreref>.
|
||||
|
||||
|
||||
=item * Steal ideas from L<Dunce::Files|Dunce::Files>.
|
||||
|
||||
Can someone expand this entry, please?
|
||||
|
||||
=item * ControlStructures::ProhibitAssigmentInConditional
|
||||
|
||||
=item * ValuesAndExpressions::RequireConstantBeforeEquals
|
||||
|
||||
=item * ValuesAndExpressions::RequireConstantBeforeOperator
|
||||
|
||||
L<http://use.perl.org/~stu42j/journal/36412>
|
||||
|
||||
Just about everyone has been bitten by C<if ($x = 10) { ... }> when they meant
|
||||
to use C<==>. A safer style is C<10 == $x> because omitting the second C<=>
|
||||
yields a noisy compile-time failure instead of silent runtime error.
|
||||
|
||||
ProhibitAssigmentInConditional complains if the condition of a while, until,
|
||||
if or unless is solely an assignment. If it's anything more complex (like
|
||||
C<if (($x=10)){}> or C<while ($x=$y=$z){}>), there is no warning.
|
||||
|
||||
RequireConstantBeforeEquals complains if the left side of an C<==> is a
|
||||
variable while the right side is a constant.
|
||||
|
||||
RequireConstantBeforeOperator complains if the left side of any comparison
|
||||
operator (C<==>, C<eq>, C<<>, etc) is a variable while the right side is a
|
||||
constant.
|
||||
|
||||
|
||||
=item * InputOutput::ProhibitUTF8IOLayer
|
||||
|
||||
http://www.perlfoundation.org/perl5/index.cgi?the_utf8_perlio_layer
|
||||
|
||||
|
||||
=item * BuiltinFunctions::ProhibitExit(?:InModules)?
|
||||
|
||||
Forbid C<exit()> in files that lack a shebang. Inspired by
|
||||
L<http://use.perl.org/~Ovid/journal/36746> and an analogous checker in
|
||||
FindBugs.
|
||||
|
||||
|
||||
=item * Modules::ProhibitRedundantLoading
|
||||
|
||||
Don't allow a package to "use" the same module more than once, unless
|
||||
there is a "no <module>" between them.
|
||||
|
||||
See https://rt.cpan.org/Ticket/Display.html?id=38074.
|
||||
|
||||
|
||||
=item * ErrorHandling::RequireLocalizingEVAL_ERRORInDESTROY
|
||||
|
||||
The opposite side of ErrorHandling::RequireCheckingReturnValueOfEval.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 REFACTORINGS and ENHANCEMENTS
|
||||
|
||||
=over
|
||||
|
||||
=item * Reformat all the POD to use 78 columns instead of 70.
|
||||
|
||||
This thing of having different widths for the documentation and the code is
|
||||
rediculous. Don't do this until after the next non-dev release. Elliot is
|
||||
considering doing a special release only including this change so that the
|
||||
search.cpan.org diff tool doesn't entirely break.
|
||||
|
||||
|
||||
=item * Eliminate use of IO::String
|
||||
|
||||
I'm pretty sure that opening references to scalars is in 5.6, so IO::String
|
||||
isn't necessary.
|
||||
|
||||
|
||||
=item * Give L<Perl::Critic::Command> a proper API.
|
||||
|
||||
Now that we've got the guts of L<perlcritic> in there, we should make the
|
||||
it available to users.
|
||||
|
||||
|
||||
=item * Create constants for the PPI location array elements.
|
||||
|
||||
=item * Some means of detecting "runaway" C<##no critic>
|
||||
|
||||
Elliot was talking to a couple of users at ETech and one of their major
|
||||
concerns was that they were using C<##no critic> and forgetting to do a
|
||||
C<##use critic> after the problematic section. Perhaps an option to
|
||||
F<perlcritic> to scan for such things is in order.
|
||||
|
||||
|
||||
=item * Change API to use named parameters
|
||||
|
||||
Most of the methods on the public classes use named parameters for passing
|
||||
arguments. I'd like to extend that pattern to include all object-methods.
|
||||
Static methods can still use positional parameters.
|
||||
|
||||
|
||||
=item * Enhance P::C::critique() to accept files, directories, or code strings
|
||||
|
||||
Just like F<bin/perlcritic> does now.
|
||||
|
||||
|
||||
=item * Add C<-cache> flag to F<bin/perlcritic>
|
||||
|
||||
If enabled, this turns on L<PPI::Cache|PPI::Cache>:
|
||||
|
||||
require PPI::Cache;
|
||||
my $cache_path = "/tmp/test-perl-critic-cache-$ENV{USER}";
|
||||
mkdir $cache_path, oct 700 if (! -d $cache_path);
|
||||
PPI::Cache->import(path => $cache_path);
|
||||
|
||||
This cache directory should perhaps include the PPI version number! At least
|
||||
until PPI incorporates its own version number in the cache.
|
||||
|
||||
(see F<t/40_criticize.t> for a more robust implementation)
|
||||
|
||||
|
||||
=item * Use hash-lookup instead of C<List::MoreUtils::any> function.
|
||||
|
||||
In several places, Perl::Critic uses C<List::MoreUtils::any> to see if a
|
||||
string is a member of a list. Instead, I suggest using a named subroutine
|
||||
that does a hash-lookup like this:
|
||||
|
||||
my %logical_ops = hashify( qw( ! || && ||= &&= and or not ) );
|
||||
sub is_logical_op { return exists $logical_ops{ $_[0] }; }
|
||||
|
||||
Question: Why?
|
||||
|
||||
Answer: Readability, mostly. Performance, maybe.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
=head1 PPI BUGS
|
||||
|
||||
We're waiting on the following bugs to get fixed in a CPAN release of PPI:
|
||||
|
||||
|
||||
=over
|
||||
|
||||
=item PPI::Token::descendant_of()
|
||||
|
||||
Exists in svn. Replace _descendant_of() in RequireCheckingReturnValueOfEval
|
||||
with that, once it is released, because it's faster and native.
|
||||
|
||||
|
||||
=item Newlines
|
||||
|
||||
PPI does not preserve newlines. That makes
|
||||
CodeLayout::RequireConsistentNewlines impossible to implement under PPI. For
|
||||
now, it's implemented by pulling the source out of the file and skipping PPI.
|
||||
|
||||
It's unlikely that PPI will support mixed newlines anytime soon.
|
||||
|
||||
|
||||
=item Operators
|
||||
|
||||
ValuesAndExpressions::ProhibitMismatchedOperators has two workarounds for PPI
|
||||
bugs with parsing operators. Many of these bugs have been fixed in PPI, so it
|
||||
would be good to check if those workarounds are still needed.
|
||||
|
||||
|
||||
=item Regexp methods
|
||||
|
||||
Not strictly a bug -- the PPI Regexp classes have a dearth of accessor methods
|
||||
as of v1.118, meaning that we have to do messy digging into internals. I
|
||||
wrote Perl::Critic:Utils::PPIRegexp to encapsulate this messiness, but it
|
||||
would be nicer to have an official interface in PPI.
|
||||
|
||||
|
||||
=item QuoteLike::Words in the place of a ForLoop
|
||||
|
||||
PPI incorrectly parses C<<for qw<blah> {}>>.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=pod expandtab shiftround :
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,71 @@
|
|||
# Validate with cpanfile-dump
|
||||
# https://metacpan.org/release/Module-CPANfile
|
||||
# https://metacpan.org/pod/distribution/Module-CPANfile/lib/cpanfile.pod
|
||||
|
||||
requires 'B::Keywords' => '1.05';
|
||||
requires 'Carp' => 0;
|
||||
requires 'Config::Tiny' => 2;
|
||||
requires 'English' => 0;
|
||||
requires 'Exception::Class' => '1.23';
|
||||
requires 'Exporter' => '5.63';
|
||||
requires 'Fatal' => 0;
|
||||
requires 'File::Basename' => 0;
|
||||
requires 'File::Find' => 0;
|
||||
requires 'File::Path' => 0;
|
||||
requires 'File::Spec' => 0;
|
||||
requires 'File::Spec::Unix' => 0;
|
||||
requires 'File::Temp' => 0;
|
||||
requires 'File::Which' => 0;
|
||||
requires 'Getopt::Long' => 0;
|
||||
requires 'IO::String' => 0;
|
||||
requires 'IPC::Open2' => 1;
|
||||
requires 'List::MoreUtils' => '0.19';
|
||||
requires 'List::Util' => 0;
|
||||
requires 'Module::Build' => '0.4204';
|
||||
requires 'Module::Pluggable' => '3.1';
|
||||
requires 'PPI' => '1.265';
|
||||
requires 'PPI::Document' => '1.265';
|
||||
requires 'PPI::Document::File' => '1.265';
|
||||
requires 'PPI::Node' => '1.265';
|
||||
requires 'PPI::Token::Quote::Single' => '1.265';
|
||||
requires 'PPI::Token::Whitespace' => '1.265';
|
||||
requires 'PPIx::QuoteLike' => 0;
|
||||
requires 'PPIx::Regexp' => '0.027'; # Literal { deprecated in re
|
||||
requires 'PPIx::Regexp::Util' => '0.068'; # is_ppi_regexp_element()
|
||||
requires 'PPIx::Utilities::Node' => '1.001';
|
||||
requires 'PPIx::Utilities::Statement' => '1.001';
|
||||
requires 'Perl::Tidy' => 0;
|
||||
requires 'Pod::Parser' => 0;
|
||||
requires 'Pod::PlainText' => 0;
|
||||
requires 'Pod::Select' => 0;
|
||||
requires 'Pod::Spell' => 1;
|
||||
requires 'Pod::Usage' => 0;
|
||||
requires 'Readonly' => '2.00';
|
||||
requires 'Scalar::Util' => 0;
|
||||
requires 'String::Format' => '1.18';
|
||||
requires 'Task::Weaken' => 0;
|
||||
requires 'Term::ANSIColor' => '2.02';
|
||||
requires 'Test::Builder' => '0.92';
|
||||
requires 'Text::ParseWords' => 3;
|
||||
requires 'base' => 0;
|
||||
requires 'charnames' => 0;
|
||||
requires 'overload' => 0;
|
||||
requires 'strict' => 0;
|
||||
requires 'version' => '0.77';
|
||||
requires 'warnings' => 0;
|
||||
|
||||
on 'test' => sub {
|
||||
requires 'Test::Deep' => 0;
|
||||
requires 'Test::More' => 0;
|
||||
|
||||
# For author testing
|
||||
requires 'Devel::EnforceEncapsulation' => 0;
|
||||
requires 'Test::Kwalitee' => 0;
|
||||
requires 'Test::Memory::Cycle' => 0;
|
||||
requires 'Test::Perl::Critic' => 0;
|
||||
requires 'Test::Pod' => 0;
|
||||
requires 'Test::Pod::Coverage' => 0;
|
||||
};
|
||||
|
||||
|
||||
# vi:et:sw=4 ts=4 ft=perl
|
||||
|
|
@ -0,0 +1,300 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use 5.008001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use version; our $VERSION = qv('1.116');
|
||||
|
||||
use Carp qw{ croak };
|
||||
use English qw{ -no_match_vars };
|
||||
use Readonly;
|
||||
|
||||
use File::Spec qw{ };
|
||||
use Perl6::Say;
|
||||
|
||||
use Perl::Critic::Utils qw{ all_perl_files };
|
||||
use Perl::Critic;
|
||||
|
||||
|
||||
if ( ! @ARGV ) {
|
||||
die qq{usage: generatestats path [...]\n};
|
||||
}
|
||||
|
||||
main();
|
||||
|
||||
exit 0;
|
||||
|
||||
|
||||
sub main {
|
||||
foreach my $path ( @ARGV ) {
|
||||
say "Looking at $path.";
|
||||
|
||||
my @files = all_perl_files($path);
|
||||
say 'Analyzing ', scalar @files, ' files.';
|
||||
|
||||
my $results = summarize( \@files, File::Spec->canonpath($path) );
|
||||
|
||||
report($results);
|
||||
|
||||
say; say;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub summarize {
|
||||
my ( $files, $path ) = @_;
|
||||
|
||||
# Force reporting level to be really strict, just so that the statistics
|
||||
# include everything.
|
||||
my $critic = Perl::Critic->new( -severity => 1 );
|
||||
|
||||
my %total_severities;
|
||||
my %total_policies;
|
||||
my %types;
|
||||
my %files;
|
||||
|
||||
foreach my $file ( @{$files} ) {
|
||||
my $relative_path;
|
||||
my $type;
|
||||
|
||||
if ($file eq $path) {
|
||||
$relative_path = $file;
|
||||
} else {
|
||||
my $absolute_path_length = ( length $path ) + 1;
|
||||
|
||||
$relative_path = substr $file, $absolute_path_length;
|
||||
}
|
||||
|
||||
if ($file =~ m/ [.] ([^.]+) \z /xms) {
|
||||
$type = $1;
|
||||
} else {
|
||||
$type = '<program>';
|
||||
}
|
||||
|
||||
$types{$type}{files}++;
|
||||
foreach my $violation ( $critic->critique($file) ) {
|
||||
$files{ $relative_path }{ severities }{ $violation->severity() }++;
|
||||
$files{ $relative_path }{ policies }{ $violation->policy() }++;
|
||||
|
||||
$types{ $type }{ severities }{ $violation->severity() }++;
|
||||
$types{ $type }{ policies }{ $violation->policy() }++;
|
||||
|
||||
$total_severities{ $violation->severity() }++;
|
||||
$total_policies{ $violation->policy() }++;
|
||||
}
|
||||
}
|
||||
|
||||
return {
|
||||
severities => \%total_severities,
|
||||
policies => \%total_policies,
|
||||
types => \%types,
|
||||
files => \%files,
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
sub report {
|
||||
my ( $results ) = @_;
|
||||
|
||||
report_totals( $results );
|
||||
report_types( $results );
|
||||
report_files( $results );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub report_totals {
|
||||
my ( $results ) = @_;
|
||||
|
||||
say;
|
||||
say 'Total violations by severity:';
|
||||
report_severities( $results->{severities} );
|
||||
|
||||
say;
|
||||
say 'Total violations by policy:';
|
||||
report_policies( $results->{policies} );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub report_types {
|
||||
my ( $results ) = @_;
|
||||
my $types = $results->{types};
|
||||
|
||||
say;
|
||||
say 'Total files by type:';
|
||||
foreach my $type ( sort keys %{$types} ) {
|
||||
say qq{\t}, $type, ': ', $types->{$type}{files};
|
||||
}
|
||||
|
||||
foreach my $type ( sort keys %{$types} ) {
|
||||
say;
|
||||
say "Violations in $type files by severity:";
|
||||
report_severities( $types->{$type}{severities} );
|
||||
|
||||
say;
|
||||
say "Violations in $type files by policy:";
|
||||
report_policies( $types->{$type}{policies} );
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub report_files {
|
||||
my ( $results ) = @_;
|
||||
my $files = $results->{files};
|
||||
|
||||
foreach my $file ( sort keys %{$files} ) {
|
||||
say;
|
||||
say "Violations in $file by severity:";
|
||||
report_severities( $files->{$file}{severities} );
|
||||
|
||||
say;
|
||||
say "Violations in $file by policy:";
|
||||
report_policies( $files->{$file}{policies} );
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub report_severities {
|
||||
my ($severities) = @_;
|
||||
|
||||
foreach my $severity ( reverse sort { $a <=> $b } keys %{$severities} ) {
|
||||
say qq{\t}, $severity, ': ', $severities->{$severity};
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub report_policies {
|
||||
my ($policies) = @_;
|
||||
|
||||
foreach my $policy ( sort keys %{$policies} ) {
|
||||
(my $short_policy = $policy) =~ s/ \A Perl::Critic::Policy:: //xms;
|
||||
|
||||
say qq{\t}, $short_policy, ': ', $policies->{$policy};
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords codebase perlartistic
|
||||
|
||||
=head1 NAME
|
||||
|
||||
C<generatestats> - Produce some simple quality statistics of a codebase
|
||||
|
||||
|
||||
=head1 USAGE
|
||||
|
||||
generatestats path [...]
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Scan a body of code and generate some statistics on violations of the
|
||||
installed L<Perl::Critic|Perl::Critic> policies. While there is no means of
|
||||
configuring the policies here, this will take into account your
|
||||
F<.perlcriticrc>, if available.
|
||||
|
||||
|
||||
=head1 REQUIRED ARGUMENTS
|
||||
|
||||
A list of paths to files and directories to find code in.
|
||||
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
None.
|
||||
|
||||
|
||||
=head1 DIAGNOSTICS
|
||||
|
||||
None.
|
||||
|
||||
|
||||
=head1 EXIT STATUS
|
||||
|
||||
0
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
None.
|
||||
|
||||
|
||||
=head1 DEPENDENCIES
|
||||
|
||||
L<Perl::Critic|Perl::Critic>
|
||||
L<Perl6::Say|Perl6::Say>
|
||||
L<Readonly|Readonly>
|
||||
|
||||
|
||||
=head1 INCOMPATIBILITIES
|
||||
|
||||
None reported.
|
||||
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
This is an example program and thus does minimal error handling.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank C<< <perl@galumph.com> >>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011, Elliot Shank.
|
||||
|
||||
This module is free software; you can redistribute it and/or modify it under
|
||||
the same terms as Perl itself. See L<perlartistic|perlartistic>.
|
||||
|
||||
|
||||
=head1 DISCLAIMER OF WARRANTY
|
||||
|
||||
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE
|
||||
SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE
|
||||
STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE
|
||||
SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
|
||||
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
|
||||
PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE,
|
||||
YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
|
||||
|
||||
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY
|
||||
COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE
|
||||
SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE LIABLE TO YOU FOR DAMAGES,
|
||||
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
|
||||
OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO
|
||||
LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
|
||||
THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER
|
||||
SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGES.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,344 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use 5.008001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use version; our $VERSION = qv('1.116');
|
||||
|
||||
use Carp qw{ croak };
|
||||
use English qw{ -no_match_vars };
|
||||
use Readonly;
|
||||
|
||||
use DBI qw{ :sql_types };
|
||||
use File::Spec qw{ };
|
||||
use Perl6::Say;
|
||||
|
||||
use Perl::Critic::Utils qw{ all_perl_files policy_short_name $EMPTY };
|
||||
use Perl::Critic;
|
||||
|
||||
|
||||
if ( ! @ARGV ) {
|
||||
die qq{usage: loadanalysisdb path [...]\n};
|
||||
}
|
||||
|
||||
main();
|
||||
|
||||
exit 0;
|
||||
|
||||
|
||||
sub main {
|
||||
say 'Connecting to database.';
|
||||
say;
|
||||
|
||||
my $database_connection = connect_to_database();
|
||||
my $insert_statement = prepare_insert_statement($database_connection);
|
||||
|
||||
foreach my $path ( @ARGV ) {
|
||||
say "Looking at $path.";
|
||||
|
||||
my @files = all_perl_files($path);
|
||||
say 'Analyzing ', scalar @files, ' files.';
|
||||
|
||||
load( \@files, File::Spec->canonpath($path), $insert_statement );
|
||||
|
||||
say; say;
|
||||
}
|
||||
|
||||
say 'Disconnecting from database.';
|
||||
say;
|
||||
|
||||
close_insert_statement($insert_statement);
|
||||
# Need to do this or DBI emits warning at disconnect
|
||||
$insert_statement = undef;
|
||||
|
||||
disconnect_from_database($database_connection);
|
||||
|
||||
say 'Done.';
|
||||
say;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub load {
|
||||
my ( $files, $path, $insert_statement ) = @_;
|
||||
|
||||
# Force reporting level to be really strict, just so that the database
|
||||
# has everything.
|
||||
my $critic = Perl::Critic->new( -severity => 1 );
|
||||
|
||||
foreach my $file ( @{$files} ) {
|
||||
my $relative_path;
|
||||
|
||||
if ($file eq $path) {
|
||||
$relative_path = $file;
|
||||
} else {
|
||||
my $absolute_path_length = ( length $path ) + 1;
|
||||
|
||||
$relative_path = substr $file, $absolute_path_length;
|
||||
}
|
||||
|
||||
say "Processing $relative_path.";
|
||||
|
||||
foreach my $violation ( $critic->critique($file) ) {
|
||||
my ($line, $column) = @{ $violation->location() };
|
||||
|
||||
execute_insert_statement(
|
||||
$insert_statement,
|
||||
$relative_path,
|
||||
$line,
|
||||
$column,
|
||||
$violation->severity(),
|
||||
policy_short_name( $violation->policy() ),
|
||||
$violation->explanation(),
|
||||
$violation->source(),
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub connect_to_database {
|
||||
my $database_file_name = 'perl_critic_analysis.sqlite';
|
||||
|
||||
my $database_connection =
|
||||
DBI->connect(
|
||||
"dbi:SQLite:dbname=$database_file_name",
|
||||
$EMPTY, # login
|
||||
$EMPTY, # password
|
||||
{
|
||||
AutoCommit => 1, # In real life, this should be 0
|
||||
RaiseError => 1,
|
||||
}
|
||||
);
|
||||
|
||||
defined $database_connection or
|
||||
croak "Could not connect to $database_file_name.";
|
||||
|
||||
return $database_connection;
|
||||
}
|
||||
|
||||
|
||||
sub prepare_insert_statement {
|
||||
my ( $database_connection ) = @_;
|
||||
|
||||
my $insert_statement =
|
||||
$database_connection->prepare(<<'END_SQL');
|
||||
INSERT INTO
|
||||
violation
|
||||
(
|
||||
file_path,
|
||||
line_number,
|
||||
column_number,
|
||||
severity,
|
||||
policy,
|
||||
explanation,
|
||||
source_code
|
||||
)
|
||||
VALUES
|
||||
(?, ?, ?, ?, ?, ?, ?)
|
||||
END_SQL
|
||||
|
||||
|
||||
# The following values are bogus-- these statements are simply to tell
|
||||
# the driver what the parameter types are so that we can use execute()
|
||||
# without calling bind_param() each time. See "Binding Values Without
|
||||
# bind_param()" on pages 126-7 of "Programming the Perl DBI".
|
||||
|
||||
## no critic (ProhibitMagicNumbers)
|
||||
$insert_statement->bind_param( 1, 'x', SQL_VARCHAR);
|
||||
$insert_statement->bind_param( 2, 1, SQL_INTEGER);
|
||||
$insert_statement->bind_param( 3, 1, SQL_INTEGER);
|
||||
$insert_statement->bind_param( 4, 1, SQL_INTEGER);
|
||||
$insert_statement->bind_param( 5, 'x', SQL_VARCHAR);
|
||||
$insert_statement->bind_param( 6, 'x', SQL_VARCHAR);
|
||||
$insert_statement->bind_param( 7, 'x', SQL_VARCHAR);
|
||||
## use critic
|
||||
|
||||
return $insert_statement;
|
||||
}
|
||||
|
||||
|
||||
sub execute_insert_statement { ##no critic(ProhibitManyArgs)
|
||||
my (
|
||||
$statement,
|
||||
$file_path,
|
||||
$line_number,
|
||||
$column_number,
|
||||
$severity,
|
||||
$policy,
|
||||
$explanation,
|
||||
$source_code,
|
||||
)
|
||||
= @_;
|
||||
|
||||
$statement->execute(
|
||||
$file_path,
|
||||
$line_number,
|
||||
$column_number,
|
||||
$severity,
|
||||
$policy,
|
||||
$explanation,
|
||||
$source_code,
|
||||
);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub close_insert_statement {
|
||||
my ( $insert_statement ) = @_;
|
||||
|
||||
$insert_statement->finish();
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub disconnect_from_database {
|
||||
my ( $database_connection ) = @_;
|
||||
|
||||
$database_connection->disconnect();
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords SQLite DBI analyses perlartistic
|
||||
|
||||
=head1 NAME
|
||||
|
||||
C<loadanalysisdb> - Critique a body of code and load the results into a database for later processing.
|
||||
|
||||
|
||||
=head1 USAGE
|
||||
|
||||
loadanalysisdb path [...]
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Scan a body of code and, rather than emit the results in a textual
|
||||
format, put them into a database so that analyses can be made.
|
||||
|
||||
This example doesn't put anything into the database that isn't
|
||||
available from L<Perl::Critic::Violation|Perl::Critic::Violation> in
|
||||
order to keep the code easier to understand. In a full application of
|
||||
the idea presented here, one might want to include the current date
|
||||
and a distribution name in the database so that progress on cleaning
|
||||
up a code corpus can be tracked.
|
||||
|
||||
Note the explanation attribute of
|
||||
L<Perl::Critic::Violation|Perl::Critic::Violation> is constant for
|
||||
most policies, but some of them do provide more specific diagnostics
|
||||
of the code in question.
|
||||
|
||||
|
||||
=head1 REQUIRED ARGUMENTS
|
||||
|
||||
A list of paths to files and directories to find code in.
|
||||
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
None.
|
||||
|
||||
|
||||
=head1 DIAGNOSTICS
|
||||
|
||||
Errors from L<DBI|DBI>.
|
||||
|
||||
|
||||
=head1 EXIT STATUS
|
||||
|
||||
0
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
None.
|
||||
|
||||
|
||||
=head1 DEPENDENCIES
|
||||
|
||||
L<Perl::Critic|Perl::Critic>
|
||||
L<DBD::SQLite|DBD::SQLite>
|
||||
L<Perl6::Say|Perl6::Say>
|
||||
L<Readonly|Readonly>
|
||||
|
||||
An SQLite database named "perl_critic_analysis.sqlite" with the
|
||||
following schema:
|
||||
|
||||
CREATE TABLE violation (
|
||||
file_path VARCHAR(1024),
|
||||
line_number INTEGER,
|
||||
column_number INTEGER,
|
||||
severity INTEGER,
|
||||
policy VARCHAR(512),
|
||||
explanation TEXT,
|
||||
source_code TEXT
|
||||
)
|
||||
|
||||
|
||||
=head1 INCOMPATIBILITIES
|
||||
|
||||
None reported.
|
||||
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
This is an example program and thus does minimal error handling.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank C<< <perl@galumph.com> >>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011, Elliot Shank.
|
||||
|
||||
This module is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself. See L<perlartistic|perlartistic>.
|
||||
|
||||
|
||||
=head1 DISCLAIMER OF WARRANTY
|
||||
|
||||
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
|
||||
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT
|
||||
WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER
|
||||
PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND,
|
||||
EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
|
||||
SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME
|
||||
THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
|
||||
|
||||
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
|
||||
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE LIABLE
|
||||
TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR
|
||||
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
|
||||
SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
|
||||
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
|
||||
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
|
||||
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
|
||||
DAMAGES.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,201 @@
|
|||
##############################################################################
|
||||
# This file is an example of a Perl::Critic configuration file. This
|
||||
# file is usually called ".perlcriticrc" and is usually located in
|
||||
# your home directory or the working directory of your project.
|
||||
# However, you can use the -profile option to tell Perl::Critic use a
|
||||
# different file in another location.
|
||||
#
|
||||
# The area before any of the [Perl::Critic::Policy] sections is used
|
||||
# to set default values for the arguments to the Perl::Critic engine.
|
||||
# If you are using the "perlcritic" program, you can override these
|
||||
# settings at the command-line. Or if you are using the Perl::Critic
|
||||
# library, your API arguments will override these settings as well.
|
||||
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# exclude: Directs Perl::Critic to never apply Policies with names that
|
||||
# match one of the patterns. To specify multiple patterns, separate them
|
||||
# with whitespace. Do not put quotes around anything.
|
||||
|
||||
exclude = Documentation Naming
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# include: Directs Perl::Critic to always apply Policies with names that
|
||||
# match one of the patterns. To specify multiple patterns, separate them
|
||||
# with whitespace. Do not put quotes around anything.
|
||||
|
||||
include = CodeLayout Modules
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# force: Directs Perl::Critic to ignore the special "##no critic"
|
||||
# comments embedded in the source code. The default is 0. If
|
||||
# defined, this should be either 1 or 0.
|
||||
|
||||
force = 1
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# only: Directs Perl::Critic to only choose from Policies that are
|
||||
# explicitly mentioned in this file. Otherwise, Perl::Critic chooses
|
||||
# from all the Perl::Critic::Policy classes that are found on the
|
||||
# local machine. The default is 0. If defined, this should be either
|
||||
# 1 or 0.
|
||||
|
||||
only = 1
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# severity: Sets the default minimum severity level for Policies. The
|
||||
# default is 5. If defined, this should be an integer from 1 to 5,
|
||||
# where 5 is the highest severity.
|
||||
|
||||
severity = 3
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# theme: Sets the default theme. Only Policies that fit into this
|
||||
# them shall be applied. If defined, this should be a valid theme
|
||||
# expression. See the Perl::Critic POD for more details about this.
|
||||
|
||||
theme = danger + risky - pbp
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# top: Directs Perl::Critic to only report the top N Policy violations,
|
||||
# as ranked by their individual severity. If defined, this should be
|
||||
# a positive integer.
|
||||
|
||||
top = 50
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# verbose: Sets the format for printing Policy violations. If
|
||||
# defined, this should be either a format spcecification, or a numeric
|
||||
# verbosity level. See the Perl::Critic POD for more details.
|
||||
|
||||
verbose = 5
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# color-severity-highest: sets the color used for displaying highest
|
||||
# severity violations when coloring is in effect. This should be a color
|
||||
# specification acceptable to Term::ANSIColor. See the Perl::Critic POD
|
||||
# for details. Do not put quotes around the values. The default is 'bold
|
||||
# red'.
|
||||
|
||||
color-severity-highest = bold red underline
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# color-severity-high: sets the color used for displaying high severity
|
||||
# violations when coloring is in effect. This should be a color
|
||||
# specification acceptable to Term::ANSIColor. See the Perl::Critic POD
|
||||
# for details. Do not put quotes around the values. The default is
|
||||
# 'magenta'.
|
||||
|
||||
color-severity-high = bold magenta
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# color-severity-medium: sets the color used for displaying medium
|
||||
# severity violations when coloring is in effect. This should be a color
|
||||
# specification acceptable to Term::ANSIColor. See the Perl::Critic POD
|
||||
# for details. Do not put quotes around the values. The default is ''.
|
||||
|
||||
color-severity-medium = blue
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# color-severity-low: sets the color used for displaying low severity
|
||||
# violations when coloring is in effect. This should be a color
|
||||
# specification acceptable to Term::ANSIColor. See the Perl::Critic POD
|
||||
# for details. Do not put quotes around the values. The default is ''.
|
||||
|
||||
color-severity-low =
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# color-severity-lowest: sets the color used for displaying lowest
|
||||
# severity violations when coloring is in effect. This should be a color
|
||||
# specification acceptable to Term::ANSIColor. See the Perl::Critic POD
|
||||
# for details. Do not put quotes around the values. The default is ''.
|
||||
|
||||
color-severity-lowest =
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# program-extensions: specifies the file name endings for files that should
|
||||
# be interpreted as programs rather than modules. This should be a space-
|
||||
# delimited list of the name endings, with leading '.' if that is desired.
|
||||
# These are case-sensitive. See the Perl::Critic POD for details, but in
|
||||
# general any file beginning with a shebang line, any file whose name ends
|
||||
# '.PL', and any file whose name ends in one of the values specified here
|
||||
# will be considered a program; any other file will be considered a module.
|
||||
# Do not put quotes around the values. The default is ''.
|
||||
|
||||
program-extensions =
|
||||
|
||||
##############################################################################
|
||||
# The rest of the file consists of several named blocks that contain
|
||||
# configuration parameters for each of the Policies. The names of
|
||||
# each blocks correspond to the names of the Policy modules. For
|
||||
# brevity, the "Perl::Critic::Policy" portion of the name can be
|
||||
# omitted. See the POD for the appropriate Policy for a complete
|
||||
# description of the configuration parameters that it supports.
|
||||
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# If you vehmently disagree with a particular Policy, putting a "-" in
|
||||
# front of the Policy name will effectively disables that Policy. It
|
||||
# will never be applied unless you use the "-include" option to apply
|
||||
# it explicitly.
|
||||
|
||||
[-NamingConventions::Capitalization]
|
||||
[-TestingAndDebugging::RequireUseWarnings]
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# If you agree with a Policy, but feel that it's severity level is not
|
||||
# appropriate, then you can change the severity for any Policy. If
|
||||
# defined this should be an integer from 1 to 5, where 5 is the
|
||||
# highest severity.
|
||||
|
||||
[BuiltinFunctions::RequireBlockGrep]
|
||||
severity = 2
|
||||
|
||||
[CodeLayout::ProhibitHardTabs]
|
||||
severity = 1
|
||||
|
||||
[ClassHierarchies::ProhibitAutoloading]
|
||||
severity = 5
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# Policies are also organized into themes. Themes are just names for
|
||||
# arbitrary groups of Policies. You can define new themes and add
|
||||
# them to any Policy. If defined, this should be a string of
|
||||
# whitespace-delimited words.
|
||||
|
||||
[RegularExpressions::RequireExtendedFormatting]
|
||||
add_themes = client_foo
|
||||
severity = 3
|
||||
|
||||
[RegularExpressions::RequireExtendedFormatting]
|
||||
add_themes = client_foo client_bar
|
||||
severity = 3
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# Some Policies also have specialized configuration parameters. In
|
||||
# all cases, these are repsented as simple name=value pairs. See the
|
||||
# POD for the appropriate Policy for a complete discussion of its
|
||||
# configuration parameters.
|
||||
|
||||
[ControlStructures::ProhibitPostfixControls]
|
||||
allow = for if
|
||||
severity = 4
|
||||
|
||||
[Documentation::RequirePodSections]
|
||||
lib_sections = NAME | SYNOPSIS | METHODS | AUTHOR
|
||||
add_themes = my_favorites
|
||||
severity = 4
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# If you set the "only" flag, then Perl::Critic only chooses from
|
||||
# Policies that are mentioned in your configuration file. This is
|
||||
# helpful when you want to use only a very small subset of the
|
||||
# Policies. So just create blocks for any other Policies that you
|
||||
# want to use.
|
||||
|
||||
[ValuesAndExpressions::ProhibitInterpolationOfLiterals]
|
||||
[ValuesAndExpressions::ProhibitLeadingZeros]
|
||||
[InputOutput::ProhibitBarewordFileHandles]
|
||||
[Miscellanea::ProhibitTies]
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,283 @@
|
|||
##############################################################################
|
||||
# This Perl::Critic configuration file sets the Policy severity levels
|
||||
# according to Damian Conway's own personal recommendations. Feel free to
|
||||
# use this as your own, or make modifications.
|
||||
##############################################################################
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::ProhibitReverseSortBlock]
|
||||
severity = 1
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::ClassHierarchies::ProhibitAutoloading]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::CodeLayout::ProhibitHardTabs]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins]
|
||||
severity = 1
|
||||
|
||||
[Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::CodeLayout::RequireTidyCode]
|
||||
severity = 1
|
||||
|
||||
[Perl::Critic::Policy::CodeLayout::RequireTrailingCommas]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::ControlStructures::ProhibitDeepNests]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::Documentation::RequirePodAtEnd]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::Documentation::RequirePodSections]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::ErrorHandling::RequireCarping]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::InputOutput::ProhibitReadlineInForLoop]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::InputOutput::RequireBracedFileHandleWithPrint]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::Miscellanea::ProhibitFormats]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::Miscellanea::ProhibitTies]
|
||||
severity = 4
|
||||
|
||||
[-Perl::Critic::Policy::Miscellanea::RequireRcsKeywords]
|
||||
|
||||
[Perl::Critic::Policy::Modules::ProhibitAutomaticExportation]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::Modules::ProhibitEvilModules]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::Modules::ProhibitMultiplePackages]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::Modules::RequireBarewordIncludes]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::Modules::RequireEndWithOne]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::Modules::RequireExplicitPackage]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::Modules::RequireVersionVar]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs]
|
||||
severity = 1
|
||||
|
||||
[Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars]
|
||||
severity = 1
|
||||
|
||||
[Perl::Critic::Policy::References::ProhibitDoubleSigils]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::Subroutines::ProhibitAmpersandSigils]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::Subroutines::ProhibitExcessComplexity]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::Subroutines::ProtectPrivateSubs]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::Subroutines::RequireFinalReturn]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::TestingAndDebugging::ProhibitProlongedStrictureOverride]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::TestingAndDebugging::RequireTestLabels]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitEscapedCharacters]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals]
|
||||
severity = 1
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitMismatchedOperators]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitVersionStrings]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars]
|
||||
severity = 1
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::Variables::ProhibitLocalVars]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::Variables::ProhibitMatchVars]
|
||||
severity = 4
|
||||
|
||||
[Perl::Critic::Policy::Variables::ProhibitPackageVars]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::Variables::ProhibitPunctuationVars]
|
||||
severity = 2
|
||||
|
||||
[Perl::Critic::Policy::Variables::ProtectPrivateVars]
|
||||
severity = 3
|
||||
|
||||
[Perl::Critic::Policy::Variables::RequireInitializationForLocalVars]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::Variables::RequireLexicalLoopIterators]
|
||||
severity = 5
|
||||
|
||||
[Perl::Critic::Policy::Variables::RequireNegativeIndices]
|
||||
severity = 4
|
||||
|
|
@ -0,0 +1,674 @@
|
|||
;;; perlcritic.el --- minor mode for Perl::Critic integration
|
||||
|
||||
;;; Readme
|
||||
;;
|
||||
;; This is a minor mode for emacs intended to allow you to
|
||||
;; automatically incorporate perlcritic into your daily code
|
||||
;; writing. When enabled it can optionally prevent you from saving
|
||||
;; code that doesn't pass your enabled perlcritic policies.
|
||||
;;
|
||||
;; Even if you don't enable the automatic code checking you can still
|
||||
;; use the automatic checking or the `perlcritic' function.
|
||||
|
||||
|
||||
;;; Installation instructions:
|
||||
;;
|
||||
;; Copy perlcritic.el to your ~/.site-lib directory. If you don't
|
||||
;; have a .site-lib directory create it and add the following line
|
||||
;; to your .emacs file. This location isn't special, you could use
|
||||
;; a different location if you wished.
|
||||
;;
|
||||
;; (add-to-list 'load-path "/home/your-name/.site-lisp")
|
||||
;;
|
||||
;; Add the following lines to your .emacs file. This allows Emacs
|
||||
;; to load your perlcritic library only when needed.
|
||||
;;
|
||||
;; (autoload 'perlcritic "perlcritic" "" t)
|
||||
;; (autoload 'perlcritic-region "perlcritic" "" t)
|
||||
;; (autoload 'perlcritic-mode "perlcritic" "" t)
|
||||
;;
|
||||
;; Add the following to your .emacs file to get perlcritic-mode to
|
||||
;; run automatically for the `cperl-mode' and `perl-mode'.
|
||||
;;
|
||||
;; (eval-after-load "cperl-mode"
|
||||
;; '(add-hook 'cperl-mode-hook 'perlcritic-mode))
|
||||
;; (eval-after-load "perl-mode"
|
||||
;; '(add-hook 'perl-mode-hook 'perlcritic-mode))
|
||||
;;
|
||||
;;
|
||||
;; If you think you need perlcritic loaded all the time you can
|
||||
;; make this unconditional by using the following command instead
|
||||
;; of the above autoloading.
|
||||
;;
|
||||
;; (require 'perlcritic)
|
||||
;;
|
||||
;; Compile the file for extra performance. This is optional. You
|
||||
;; will have to redo this everytime you modify or upgrade your
|
||||
;; perlcritic.el file.
|
||||
;;
|
||||
;; M-x byte-compile-file ~/.site-lib/perlcritic.el
|
||||
;;
|
||||
;; Additional customization can be found in the Perl::Critic group
|
||||
;; in the Tools section in the Programming section of your Emacs'
|
||||
;; customization menus.
|
||||
|
||||
|
||||
;;; TODO
|
||||
;;
|
||||
;; Find out how to get perlcritic customization stuff into the
|
||||
;; customization menus without having to load perlcritic.el
|
||||
;; first.
|
||||
;;
|
||||
;; This needs an installer. Is there anything I can use in
|
||||
;; ExtUtils::MakeMaker, Module::Build, or Module::Install?
|
||||
;; Alien::?
|
||||
;;
|
||||
;; XEmacs compatibility. I use GNU Emacs and don't test in
|
||||
;; XEmacs. I'm happy to do what it takes to be compatible but
|
||||
;; someone will have to point things out to me.
|
||||
;;
|
||||
;; Make all documentation strings start with a sentence that fits
|
||||
;; on one line. See "Tips for Documentation Strings" in the Emacs
|
||||
;; Lisp manual.
|
||||
;;
|
||||
;; Any FIXME, TODO, or XXX tags below.
|
||||
|
||||
|
||||
;;; Change Log:
|
||||
;; 0.10
|
||||
;; * Synched up regexp alist with Perl::Critic::Utils and accounted for all
|
||||
;; past patterns too.
|
||||
;; 0.09
|
||||
;; * Added documentation for perlcritic-top, perlcritic-include,
|
||||
;; perlcritic-exclude, perlcritic-force, perlcritic-verbose.
|
||||
;; * Added emacs/vim editor hints to the bottom.
|
||||
;; * Corrected indentation.
|
||||
;; 0.08
|
||||
;; * Fixed perlcritic-compilation-error-regexp-alist for all
|
||||
;; severity levels.
|
||||
;; * Added documentation strings for functions.
|
||||
;; 0.07
|
||||
;; * Moved perlcritic-compilation-error-regexp-alist so it is in the
|
||||
;; source before it's used. This only seems to matter when
|
||||
;; perlcritic.el is compiled to bytecode.
|
||||
;; * Added perlcritic-exclude, perlcritic-include
|
||||
|
||||
;; 0.06
|
||||
;; * Code cleanliness.
|
||||
;; * Comment cleanliness.
|
||||
;; * Nice error message when perlcritic warns.
|
||||
;; * Documented perlcritic-top, perlcritic-verbose.
|
||||
;; * Regular expressions for the other standard -verbose levels.
|
||||
;; * Reversed Changes list so the most recent is first.
|
||||
;; * Standard emacs library declarations.
|
||||
;; * Added autoloading metadata.
|
||||
;; 0.05
|
||||
;; * perlcritic-bin invocation now shown in output.
|
||||
;; * Fixed indentation.
|
||||
;; * perlcritic-region is now interactive.
|
||||
;; 0.04
|
||||
;; * Removed a roque file-level (setq perlcritic-top 1)
|
||||
;; * Moved cl library to compile-time.
|
||||
;; 0.03
|
||||
;; * compile.el integration. This makes for hotlink happiness.
|
||||
;; * Better sanity when starting the *perlcritic* buffer.
|
||||
;; 0.02
|
||||
;; * perlcritic-severity-level added.
|
||||
;; * Touched up the installation documentation.
|
||||
;; * perlcritic-pass-required is now buffer local.
|
||||
;; 0.01
|
||||
;; * It's new. I copied much of this from perl-lint-mode.
|
||||
|
||||
;;; Copyright and license
|
||||
;;
|
||||
;; 2006 Joshua ben Jore <jjore@cpan.org>
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the same terms as Perl itself
|
||||
|
||||
|
||||
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;; Customization and variables.
|
||||
(defgroup perlcritic nil "Perl::Critic"
|
||||
:prefix "perlcritic-"
|
||||
:group 'tools)
|
||||
|
||||
(defcustom perlcritic-bin "perlcritic"
|
||||
"The perlcritic program used by `perlcritic'."
|
||||
:type 'string
|
||||
:group 'perlcritic)
|
||||
|
||||
(defcustom perlcritic-pass-required nil
|
||||
"When \\[perlcritic-mode] is enabled then this boolean controls
|
||||
whether your file can be saved when there are perlcritic warnings.
|
||||
|
||||
This variable is automatically buffer-local and may be overridden on a
|
||||
per-file basis with File Variables."
|
||||
:type '(radio
|
||||
(const :tag "Require no warnings from perlcritic to save" t)
|
||||
(const :tag "Allow warnings from perlcritic when saving" nil))
|
||||
:group 'perlcritic)
|
||||
(make-variable-buffer-local 'perlcritic-pass-required)
|
||||
|
||||
(defcustom perlcritic-profile nil
|
||||
"Specify an alternate .perlcriticrc file. This is only used if
|
||||
non-nil."
|
||||
:type '(string)
|
||||
:group 'perlcritic)
|
||||
(make-variable-buffer-local 'perlcritic-profile)
|
||||
|
||||
(defcustom perlcritic-noprofile nil
|
||||
"Disables the use of any .perlcriticrc file."
|
||||
:type '(boolean)
|
||||
:group 'perlcritic)
|
||||
(make-variable-buffer-local 'perlcritic-noprofile)
|
||||
|
||||
(defcustom perlcritic-severity nil
|
||||
"Directs perlcritic to only report violations of Policies with a
|
||||
severity greater than N. Severity values are integers ranging from
|
||||
1 (least severe) to 5 (most severe). The default is 5. For a given
|
||||
-profile, decreasing the -severity will usually produce more
|
||||
violations. Users can redefine the severity for any Policy in their
|
||||
.perlcriticrc file.
|
||||
|
||||
This variable is automatically buffer-local and may be overridden on a
|
||||
per-file basis with File Variables."
|
||||
:type '(radio
|
||||
(const :tag "Show only the most severe: 5" 5)
|
||||
(const :tag "4" 4)
|
||||
(const :tag "3" 3)
|
||||
(const :tag "2" 2)
|
||||
(const :tag "Show everything including the least severe: 1" 1)
|
||||
(const :tag "Default from .perlcriticrc" nil))
|
||||
:group 'perlcritic)
|
||||
(make-variable-buffer-local 'perlcritic-severity)
|
||||
|
||||
(defcustom perlcritic-top nil
|
||||
"Directs \"perlcritic\" to report only the top N Policy violations in
|
||||
each file, ranked by their severity. If the -severity option is not
|
||||
explicitly given, the -top option implies that the minimum severity
|
||||
level is 1. Users can redefine the severity for any Policy in their
|
||||
.perlcriticrc file.
|
||||
|
||||
This variable is automatically buffer-local and may be overridden on a
|
||||
per-file basis with File Variables."
|
||||
:type '(integer)
|
||||
:group 'perlcritic)
|
||||
(make-variable-buffer-local 'perlcritic-top)
|
||||
|
||||
(defcustom perlcritic-include nil
|
||||
"Directs \"perlcritic\" to apply additional Policies that match the regex \"/PATTERN/imx\".
|
||||
Use this option to override your profile and/or the severity settings.
|
||||
|
||||
For example:
|
||||
|
||||
layout
|
||||
|
||||
This would cause \"perlcritic\" to apply all the \"CodeLayout::*\" policies
|
||||
even if they have a severity level that is less than the default level of 5,
|
||||
or have been disabled in your .perlcriticrc file. You can specify multiple
|
||||
`perlcritic-include' options and you can use it in conjunction with the
|
||||
`perlcritic-exclude' option. Note that `perlcritic-exclude' takes precedence
|
||||
over `perlcritic-include' when a Policy matches both patterns. You can set
|
||||
the default value for this option in your .perlcriticrc file."
|
||||
:type '(string)
|
||||
:group 'perlcritic)
|
||||
(make-variable-buffer-local 'perlcritic-include)
|
||||
|
||||
(defcustom perlcritic-exclude nil
|
||||
"Directs \"perlcritic\" to not apply any Policy that matches the regex
|
||||
\"/PATTERN/imx\". Use this option to temporarily override your profile and/or
|
||||
the severity settings at the command-line. For example:
|
||||
|
||||
strict
|
||||
|
||||
This would cause \"perlcritic\" to not apply the \"RequireUseStrict\" and
|
||||
\"ProhibitNoStrict\" Policies even though they have the highest severity
|
||||
level. You can specify multiple `perlcritic-exclude' options and you can use
|
||||
it in conjunction with the `perlcritic-include' option. Note that
|
||||
`perlcritic-exclude' takes precedence over `perlcritic-include' when a Policy
|
||||
matches both patterns. You can set the default value for this option in your
|
||||
.perlcriticrc file."
|
||||
:type '(string)
|
||||
:group 'perlcritic)
|
||||
(make-variable-buffer-local 'perlcritic-exclude)
|
||||
|
||||
|
||||
(defcustom perlcritic-force nil
|
||||
"Directs \"perlcritic\" to ignore the magical \"## no critic\"
|
||||
pseudo-pragmas in the source code. You can set the default value for this
|
||||
option in your .perlcriticrc file."
|
||||
:type '(boolean)
|
||||
:group 'perlcritic)
|
||||
(make-variable-buffer-local 'perlcritic-force)
|
||||
|
||||
(defcustom perlcritic-verbose nil
|
||||
"Sets the numeric verbosity level or format for reporting violations. If
|
||||
given a number (\"N\"), \"perlcritic\" reports violations using one of the
|
||||
predefined formats described below. If the `perlcritic-verbose' option is not
|
||||
specified, it defaults to either 4 or 5, depending on whether multiple files
|
||||
were given as arguments to \"perlcritic\". You can set the default value for
|
||||
this option in your .perlcriticrc file.
|
||||
|
||||
Verbosity Format Specification
|
||||
----------- -------------------------------------------------------------
|
||||
1 \"%f:%l:%c:%m\n\",
|
||||
2 \"%f: (%l:%c) %m\n\",
|
||||
3 \"%m at %f line %l\n\",
|
||||
4 \"%m at line %l, column %c. %e. (Severity: %s)\n\",
|
||||
5 \"%f: %m at line %l, column %c. %e. (Severity: %s)\n\",
|
||||
6 \"%m at line %l, near ’%r’. (Severity: %s)\n\",
|
||||
7 \"%f: %m at line %l near ’%r’. (Severity: %s)\n\",
|
||||
8 \"[%p] %m at line %l, column %c. (Severity: %s)\n\",
|
||||
9 \"[%p] %m at line %l, near ’%r’. (Severity: %s)\n\",
|
||||
10 \"%m at line %l, column %c.\n %p (Severity: %s)\n%d\n\",
|
||||
11 \"%m at line %l, near ’%r’.\n %p (Severity: %s)\n%d\n\"
|
||||
|
||||
Formats are a combination of literal and escape characters similar to the way
|
||||
\"sprintf\" works. See String::Format for a full explanation of the
|
||||
formatting capabilities. Valid escape characters are:
|
||||
|
||||
Escape Meaning
|
||||
------- ----------------------------------------------------------------
|
||||
%c Column number where the violation occurred
|
||||
%d Full diagnostic discussion of the violation
|
||||
%e Explanation of violation or page numbers in PBP
|
||||
%F Just the name of the file where the violation occurred.
|
||||
%f Path to the file where the violation occurred.
|
||||
%l Line number where the violation occurred
|
||||
%m Brief description of the violation
|
||||
%P Full name of the Policy module that created the violation
|
||||
%p Name of the Policy without the Perl::Critic::Policy:: prefix
|
||||
%r The string of source code that caused the violation
|
||||
%s The severity level of the violation
|
||||
|
||||
The purpose of these formats is to provide some compatibility with text
|
||||
editors that have an interface for parsing certain kinds of input.
|
||||
|
||||
|
||||
This variable is automatically buffer-local and may be overridden on a
|
||||
per-file basis with File Variables."
|
||||
:type '(integer)
|
||||
:group 'perlcritic)
|
||||
(make-variable-buffer-local 'perlcritic-verbose)
|
||||
|
||||
;; TODO: Enable strings in perlcritic-verbose.
|
||||
;; (defcustom perlcritic-verbose-regexp nil
|
||||
;; "An optional regexp to match the warning output.
|
||||
;;
|
||||
;; This is used when `perlcritic-verbose' has a regexp instead of one of
|
||||
;; the standard verbose levels.")
|
||||
;; (make-local-variable 'perlcritic-verbose-regexp)
|
||||
|
||||
|
||||
;; compile.el requires that something be the "filename." I've tagged
|
||||
;; the severity with that. It happens to make it get highlighted in
|
||||
;; red. The following advice on COMPILATION-FIND-FILE makes sure that
|
||||
;; the "filename" is getting ignored when perlcritic is using it.
|
||||
|
||||
;; These patterns are defined in Perl::Critic::Utils
|
||||
|
||||
(defvar perlcritic-error-error-regexp-alist nil
|
||||
"Alist that specified how to match errors in perlcritic output.")
|
||||
(setq perlcritic-error-error-regexp-alist
|
||||
'(;; Verbose level 1
|
||||
;; "%f:%l:%c:%m\n"
|
||||
("^\\([^\n]+\\):\\([0-9]+\\):\\([0-9]+\\)" 1 2 3 1)
|
||||
|
||||
;; Verbose level 2
|
||||
;; "%f: (%l:%c) %m\n"
|
||||
("^\\([^\n]+\\): (\\([0-9]+\\):\\([0-9]+\\))" 1 2 3 1)
|
||||
|
||||
;; Verbose level 3
|
||||
;; "%m at %f line %l\n"
|
||||
("^[^\n]+ at \\([^\n]+\\) line \\([0-9]+\\)" 1 2 nil 1)
|
||||
;; "%m at line %l, column %c. %e. (Severity: %s)\n"
|
||||
("^[^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)." nil 2 3 1)
|
||||
|
||||
;; Verbose level 4
|
||||
;; "%m at line %l, column %c. %e. (Severity: %s)\n"
|
||||
("^[^\n]+\\( \\)at line \\([0-9]+\\), column \\([0-9]+\\)" nil 2 3)
|
||||
;; "%f: %m at line %l, column %c. %e. (Severity: %s)\n"
|
||||
("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\), column \\([0-9]+\\)" 1 2 3)
|
||||
|
||||
;; Verbose level 5
|
||||
;; "%m at line %l, near '%r'. (Severity: %s)\n"
|
||||
("^[^\n]+ at line\\( \\)\\([0-9]+\\)," nil 2)
|
||||
;; "%f: %m at line %l, column %c. %e. (Severity: %s)\n"
|
||||
("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\), column \\([0-9]+\\)" 1 2 3)
|
||||
|
||||
;; Verbose level 6
|
||||
;; "%m at line %l, near '%r'. (Severity: %s)\\n"
|
||||
("^[^\n]+ at line\\( \\)\\([0-9]+\\)" nil 2)
|
||||
;; "%f: %m at line %l near '%r'. (Severity: %s)\n"
|
||||
("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\)" 1 2)
|
||||
|
||||
;; Verbose level 7
|
||||
;; "%f: %m at line %l near '%r'. (Severity: %s)\n"
|
||||
("^\\([^\n]+\\): [^\n]+ at line \\([0-9]+\\)" 1 2)
|
||||
;; "[%p] %m at line %l, column %c. (Severity: %s)\n"
|
||||
("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" nil 2 3)
|
||||
|
||||
;; Verbose level 8
|
||||
;; "[%p] %m at line %l, column %c. (Severity: %s)\n"
|
||||
("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" nil 2 3)
|
||||
;; "[%p] %m at line %l, near '%r'. (Severity: %s)\n"
|
||||
("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\)" nil 2)
|
||||
|
||||
;; Verbose level 9
|
||||
;; "%m at line %l, column %c.\n %p (Severity: %s)\n%d\n"
|
||||
("^[^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" nil 2 3)
|
||||
;; "[%p] %m at line %l, near '%r'. (Severity: %s)\n"
|
||||
("^\\[[^\n]+\\] [^\n]+ at line\\( \\)\\([0-9]+\\)" nil 2)
|
||||
|
||||
;; Verbose level 10
|
||||
;; "%m at line %l, near '%r'.\n %p (Severity: %s)\n%d\n"
|
||||
("^[^\n]+ at line\\( \\)\\([0-9]+\\)" nil 2)
|
||||
;; "%m at line %l, column %c.\n %p (Severity: %s)\n%d\n"
|
||||
("^[^\n]+ at line\\( \\)\\([0-9]+\\), column \\([0-9]+\\)" nil 2 3)
|
||||
|
||||
;; Verbose level 11
|
||||
;; "%m at line %l, near '%r'.\n %p (Severity: %s)\n%d\n"
|
||||
("^[^\n]+ at line\\( \\)\\([0-9]+\\)" nil 2)
|
||||
))
|
||||
|
||||
|
||||
|
||||
;; The Emacs Lisp manual says to do this with the cl library.
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(define-compilation-mode perlcritic-error-mode "perlcritic-error"
|
||||
"..."
|
||||
(set (make-local-variable 'perlcritic-buffer) src-buf)
|
||||
(ad-activate #'compilation-find-file))
|
||||
|
||||
;;;###autoload
|
||||
(defun perlcritic ()
|
||||
"\\[perlcritic]] returns a either nil or t depending on whether the
|
||||
current buffer passes perlcritic's check. If there are any warnings
|
||||
those are displayed in a separate buffer."
|
||||
(interactive)
|
||||
(save-restriction
|
||||
(widen)
|
||||
(perlcritic-region (point-min) (point-max))))
|
||||
|
||||
;;;###autoload
|
||||
(defun perlcritic-region (start end)
|
||||
"\\[perlcritic-region] returns a either nil or t depending on
|
||||
whether the region passes perlcritic's check. If there are any
|
||||
warnings those are displayed in a separate buffer."
|
||||
|
||||
(interactive "r")
|
||||
|
||||
;; Kill the perlcritic buffer so I can make a new one.
|
||||
(if (get-buffer "*perlcritic*")
|
||||
(kill-buffer "*perlcritic*"))
|
||||
|
||||
;; In the following lines I'll be switching between buffers
|
||||
;; freely. This upper save-excursion will keep things sane.
|
||||
(save-excursion
|
||||
(let ((src-buf (current-buffer))
|
||||
(err-buf (get-buffer-create "*perlcritic*")))
|
||||
|
||||
(set-buffer src-buf)
|
||||
(let ((perlcritic-args (loop for p in (list
|
||||
;; Add new bin/perlcritic
|
||||
;; parameters here!
|
||||
(perlcritic--param-profile)
|
||||
(perlcritic--param-noprofile)
|
||||
(perlcritic--param-severity)
|
||||
(perlcritic--param-top)
|
||||
(perlcritic--param-include)
|
||||
(perlcritic--param-exclude)
|
||||
(perlcritic--param-force)
|
||||
(perlcritic--param-verbose))
|
||||
unless (null p)
|
||||
append p)))
|
||||
;
|
||||
(message "Perl critic...running")
|
||||
;; Seriously. Is this the nicest way to call
|
||||
;; CALL-PROCESS-REGION with variadic arguments? This blows!
|
||||
;; (apply FUNCTION (append STATIC-PART DYNAMIC-PART))
|
||||
(let ((rc (apply 'call-process-region
|
||||
(nconc (list start end
|
||||
perlcritic-bin nil
|
||||
(list err-buf t)
|
||||
nil)
|
||||
perlcritic-args))))
|
||||
|
||||
;; Figure out whether we're ok or not. perlcritic has to
|
||||
;; return zero and the output buffer has to be empty except
|
||||
;; for that "... source OK" line. Different versions of the
|
||||
;; perlcritic script will print different things when
|
||||
;; they're ok. I expect to see things like "some-file source
|
||||
;; OK", "SCALAR=(0x123457) source OK", "STDIN source OK",
|
||||
;; and "source OK".
|
||||
(let ((perlcritic-ok (and (numberp rc)
|
||||
(zerop rc)
|
||||
(progn
|
||||
(set-buffer err-buf)
|
||||
(goto-char (point-min))
|
||||
(delete-matching-lines "source OK$")
|
||||
(zerop (buffer-size))))))
|
||||
;; Either clean up or finish setting up my output.
|
||||
(if perlcritic-ok
|
||||
;; Ok!
|
||||
(progn
|
||||
(kill-buffer err-buf)
|
||||
(message "Perl critic...ok"))
|
||||
|
||||
|
||||
;; Not ok!
|
||||
(message "Perl critic...not ok")
|
||||
|
||||
;; Set up the output buffer now I know it'll be used. I
|
||||
;; scooped the guts out of compile-internal. It is
|
||||
;; CRITICAL that the errors start at least two lines
|
||||
;; from the top. compile.el normally assumes the first
|
||||
;; line is an informational `cd somedirectory' command
|
||||
;; and the second line shows the program's invocation.
|
||||
;;
|
||||
;; Since I have the space available I've put the
|
||||
;; program's invocation here. Maybe it'd make sense to
|
||||
;; put the buffer's directory here somewhere too.
|
||||
(set-buffer err-buf)
|
||||
(goto-char (point-min))
|
||||
(insert (reduce (lambda (a b) (concat a " " b))
|
||||
(nconc (list perlcritic-bin)
|
||||
perlcritic-args))
|
||||
"\n"
|
||||
;; TODO: instead of a blank line, print the
|
||||
;; buffer's directory+file.
|
||||
"\n")
|
||||
(goto-char (point-min))
|
||||
;; TODO: get `recompile' to work.
|
||||
|
||||
;; just an fyi. compilation-mode will delete my local
|
||||
;; variables so be sure to call it *first*.
|
||||
(perlcritic-error-mode)
|
||||
;; (ad-deactivate #'compilation-find-file)
|
||||
(display-buffer err-buf))
|
||||
|
||||
;; Return our success or failure.
|
||||
perlcritic-ok))))))
|
||||
|
||||
|
||||
|
||||
|
||||
;;; Parameters for use by perlcritic-region.
|
||||
(defun perlcritic--param-profile ()
|
||||
"A private method that supplies the -profile FILENAME parameter for
|
||||
\\[perlcritic-region]"
|
||||
(if perlcritic-profile (list "-profile" perlcritic-profile)))
|
||||
|
||||
(defun perlcritic--param-noprofile ()
|
||||
"A private method that supplies the -noprofile parameter for
|
||||
\\[perlcritic-region]"
|
||||
(if perlcritic-noprofile (list "-noprofile")))
|
||||
|
||||
(defun perlcritic--param-force ()
|
||||
"A private method that supplies the -force parameter for
|
||||
\\[perlcritic-region]"
|
||||
(if perlcritic-force (list "-force")))
|
||||
|
||||
(defun perlcritic--param-severity ()
|
||||
"A private method that supplies the -severity NUMBER parameter for
|
||||
\\[perlcritic-region]"
|
||||
(cond ((stringp perlcritic-severity)
|
||||
(list "-severity" perlcritic-severity))
|
||||
((numberp perlcritic-severity)
|
||||
(list "-severity" (number-to-string perlcritic-severity)))
|
||||
(t nil)))
|
||||
|
||||
(defun perlcritic--param-top ()
|
||||
"A private method that supplies the -top NUMBER parameter for
|
||||
\\[perlcritic-region]"
|
||||
(cond ((stringp perlcritic-top)
|
||||
(list "-top" perlcritic-top))
|
||||
((numberp perlcritic-top)
|
||||
(list "-top" (number-to-string perlcritic-top)))
|
||||
(t nil)))
|
||||
|
||||
(defun perlcritic--param-include ()
|
||||
"A private method that supplies the -include REGEXP parameter for
|
||||
\\[perlcritic-region]"
|
||||
(if perlcritic-include
|
||||
(list "-include" perlcritic-include)
|
||||
nil))
|
||||
|
||||
(defun perlcritic--param-exclude ()
|
||||
"A private method that supplies the -exclude REGEXP parameter for
|
||||
\\[perlcritic-region]"
|
||||
(if perlcritic-exclude
|
||||
(list "-exclude" perlcritic-exclude)
|
||||
nil))
|
||||
|
||||
(defun perlcritic--param-verbose ()
|
||||
"A private method that supplies the -verbose NUMBER parameter for
|
||||
\\[perlcritic-region]"
|
||||
(cond ((stringp perlcritic-verbose)
|
||||
(list "-verbose" perlcritic-verbose))
|
||||
((numberp perlcritic-verbose)
|
||||
(list "-verbose" (number-to-string perlcritic-verbose)))
|
||||
(t nil)))
|
||||
|
||||
|
||||
;; Interactive functions for use by the user to modify parameters on
|
||||
;; an adhoc basis. I'm sure there's room for significant niceness
|
||||
;; here. Suggest something. Please.
|
||||
(defun perlcritic-profile (profile)
|
||||
"Sets perlcritic's -profile FILENAME parameter."
|
||||
(interactive "sperlcritic -profile: ")
|
||||
(setq perlcritic-profile (if (string= profile "") nil profile)))
|
||||
|
||||
(defun perlcritic-noprofile (noprofile)
|
||||
"Toggles perlcritic's -noprofile parameter."
|
||||
(interactive (list (yes-or-no-p "Enable perlcritic -noprofile? ")))
|
||||
(setq perlcritic-noprofile noprofile))
|
||||
|
||||
(defun perlcritic-force (force)
|
||||
"Toggles perlcritic's -force parameter."
|
||||
(interactive (list (yes-or-no-p "Enable perlcritic -force? ")))
|
||||
(setq perlcritic-force force))
|
||||
|
||||
(defun perlcritic-severity (severity)
|
||||
"Sets perlcritic's -severity NUMBER parameter."
|
||||
(interactive "nperlcritic -severity: ")
|
||||
(setq perlcritic-severity severity))
|
||||
|
||||
(defun perlcritic-top (top)
|
||||
"Sets perlcritic's -top NUMBER parameter."
|
||||
(interactive "nperlcritic -top: ")
|
||||
(setq perlcritic-top top))
|
||||
|
||||
(defun perlcritic-include (include)
|
||||
"Sets perlcritic's -include REGEXP parameter."
|
||||
(interactive "sperlcritic -include: ")
|
||||
(setq perlcritic-include include))
|
||||
|
||||
(defun perlcritic-exclude (exclude)
|
||||
"Sets perlcritic's -exclude REGEXP parameter."
|
||||
(interactive "sperlcritic -exclude: ")
|
||||
(setq perlcritic-exclude exclude))
|
||||
|
||||
(defun perlcritic-verbose (verbose)
|
||||
"Sets perlcritic's -verbose NUMBER parameter."
|
||||
(interactive "nperlcritic -verbose: ")
|
||||
(setq perlcritic-verbose verbose))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; Hooks compile.el's compilation-find-file to enable our file-less
|
||||
;; operation. We feed `perlcritic-bin' from STDIN, not from a file.
|
||||
(defadvice compilation-find-file (around perlcritic-find-file)
|
||||
"Lets perlcritic lookup into the buffer we just came from and don't
|
||||
require that the perl document exist in a file anywhere."
|
||||
(let ((debug-buffer (marker-buffer marker)))
|
||||
(if (local-variable-p 'perlcritic-buffer debug-buffer)
|
||||
(setq ad-return-value perlcritic-buffer)
|
||||
ad-do-it)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; All the scaffolding of having a minor mode.
|
||||
(defvar perlcritic-mode nil
|
||||
"Toggle `perlcritic-mode'")
|
||||
(make-variable-buffer-local 'perlcritic-mode)
|
||||
|
||||
(defun perlcritic-write-hook ()
|
||||
"Check perlcritic during `write-file-hooks' for `perlcritic-mode'"
|
||||
(if perlcritic-mode
|
||||
(save-excursion
|
||||
(widen)
|
||||
(mark-whole-buffer)
|
||||
(let ((perlcritic-ok (perlcritic)))
|
||||
(if perlcritic-pass-required
|
||||
;; Impede saving if we're not ok.
|
||||
(not perlcritic-ok)
|
||||
;; Don't impede saving. We might not be ok but that
|
||||
;; doesn't matter now.
|
||||
nil)))
|
||||
;; Don't impede saving. We're not in perlcritic-mode.
|
||||
nil))
|
||||
|
||||
;;;###autoload
|
||||
(defun perlcritic-mode (&optional arg)
|
||||
"Perl::Critic checking minor mode."
|
||||
(interactive "P")
|
||||
|
||||
;; Enable/disable perlcritic-mode
|
||||
(setq perlcritic-mode (if (null arg)
|
||||
;; Nothing! Just toggle it.
|
||||
(not perlcritic-mode)
|
||||
;; Set it.
|
||||
(> (prefix-numeric-value arg) 0)))
|
||||
|
||||
(if perlcritic-mode
|
||||
(add-hook 'write-file-hooks 'perlcritic-write-hook nil "local")
|
||||
(remove-hook 'write-file-hooks 'perlcritic-write-hook)))
|
||||
|
||||
;; Make a nice name for perl critic mode. This string will appear at
|
||||
;; the bottom of the screen.
|
||||
(if (not (assq 'perlcritic-mode minor-mode-alist))
|
||||
(setq minor-mode-alist
|
||||
(cons '(perlcritic-mode " Critic")
|
||||
minor-mode-alist)))
|
||||
|
||||
(provide 'perlcritic)
|
||||
|
||||
;; Local Variables:
|
||||
;; mode: emacs-lisp
|
||||
;; tab-width: 8
|
||||
;; fill-column: 78
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
;; ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
||||
;;; perlcritic.el ends here
|
||||
|
|
@ -0,0 +1,85 @@
|
|||
# $Id: AssertOS.pm,v 1.5 2008/10/27 20:31:21 drhyde Exp $
|
||||
|
||||
package #
|
||||
Devel::AssertOS;
|
||||
|
||||
use Devel::CheckOS;
|
||||
|
||||
use strict;
|
||||
|
||||
use vars qw($VERSION);
|
||||
|
||||
$VERSION = '1.1';
|
||||
|
||||
# localising prevents the warningness leaking out of this module
|
||||
local $^W = 1; # use warnings is a 5.6-ism
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Devel::AssertOS - require that we are running on a particular OS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Devel::AssertOS is a utility module for Devel::CheckOS and
|
||||
Devel::AssertOS::*. It is nothing but a magic C<import()> that lets you
|
||||
do this:
|
||||
|
||||
use Devel::AssertOS qw(Linux FreeBSD Cygwin);
|
||||
|
||||
which will die unless the platform the code is running on is Linux, FreeBSD
|
||||
or Cygwin.
|
||||
|
||||
=cut
|
||||
|
||||
sub import {
|
||||
shift;
|
||||
die("Devel::AssertOS needs at least one parameter\n") unless(@_);
|
||||
Devel::CheckOS::die_if_os_isnt(@_);
|
||||
}
|
||||
|
||||
=head1 BUGS and FEEDBACK
|
||||
|
||||
I welcome feedback about my code, including constructive criticism.
|
||||
Bug reports should be made using L<http://rt.cpan.org/> or by email.
|
||||
|
||||
You will need to include in your bug report the exact value of $^O, what
|
||||
the OS is called (eg Windows Vista 64 bit Ultimate Home Edition), and,
|
||||
if relevant, what "OS family" it should be in and who wrote it.
|
||||
|
||||
If you are feeling particularly generous you can encourage me in my
|
||||
open source endeavours by buying me something from my wishlist:
|
||||
L<http://www.cantrell.org.uk/david/wishlist/>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
$^O in L<perlvar>
|
||||
|
||||
L<perlport>
|
||||
|
||||
L<Devel::CheckOS>
|
||||
|
||||
L<Devel::AssertOS::Extending>
|
||||
|
||||
The use-devel-assertos script
|
||||
|
||||
L<Module::Install::AssertOS>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David Cantrell E<lt>F<david@cantrell.org.uk>E<gt>
|
||||
|
||||
Thanks to David Golden for suggesting that I add this utility module.
|
||||
|
||||
=head1 COPYRIGHT and LICENCE
|
||||
|
||||
Copyright 2007 David Cantrell
|
||||
|
||||
This software is free-as-in-speech software, and may be used, distributed, and modified under the terms of either the GNU General Public Licence version 2 or the Artistic Licence. It's up to you which one you use. The full text of the licences can be found in the files GPL2.txt and ARTISTIC.txt, respectively.
|
||||
|
||||
=head1 CONSPIRACY
|
||||
|
||||
This module is also free-as-in-mason software.
|
||||
|
||||
=cut
|
||||
|
||||
$^O;
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
# $Id: Solaris.pm,v 1.3 2008/10/27 20:31:21 drhyde Exp $
|
||||
|
||||
package #
|
||||
Devel::AssertOS::Solaris;
|
||||
|
||||
use Devel::CheckOS;
|
||||
|
||||
$VERSION = '1.1';
|
||||
|
||||
sub os_is { $^O eq 'solaris' ? 1 : 0; }
|
||||
|
||||
Devel::CheckOS::die_unsupported() unless(os_is());
|
||||
|
||||
=head1 COPYRIGHT and LICENCE
|
||||
|
||||
Copyright 2007 - 2008 David Cantrell
|
||||
|
||||
This software is free-as-in-speech software, and may be used, distributed, and modified under the terms of either the GNU General Public Licence version 2 or the Artistic Licence. It's up to you which one you use. The full text of the licences can be found in the files GPL2.txt and ARTISTIC.txt, respectively.
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,332 @@
|
|||
# $Id: CheckOS.pm,v 1.32 2008/11/11 23:49:49 drhyde Exp $
|
||||
|
||||
package #
|
||||
Devel::CheckOS;
|
||||
|
||||
use strict;
|
||||
use Exporter;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
|
||||
|
||||
$VERSION = '1.61';
|
||||
|
||||
# localising prevents the warningness leaking out of this module
|
||||
local $^W = 1; # use warnings is a 5.6-ism
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT_OK = qw(os_is os_isnt die_if_os_is die_if_os_isnt die_unsupported list_platforms list_family_members);
|
||||
%EXPORT_TAGS = (
|
||||
all => \@EXPORT_OK,
|
||||
booleans => [qw(os_is os_isnt die_unsupported)],
|
||||
fatal => [qw(die_if_os_is die_if_os_isnt)]
|
||||
);
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Devel::CheckOS - check what OS we're running on
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A learned sage once wrote on IRC:
|
||||
|
||||
$^O is stupid and ugly, it wears its pants as a hat
|
||||
|
||||
Devel::CheckOS provides a more friendly interface to $^O, and also lets
|
||||
you check for various OS "families" such as "Unix", which includes things
|
||||
like Linux, Solaris, AIX etc.
|
||||
|
||||
It spares perl the embarrassment of wearing its pants on its head by
|
||||
covering them with a splendid Fedora.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Devel::CheckOS qw(os_is);
|
||||
print "Hey, I know this, it's a Unix system\n" if(os_is('Unix'));
|
||||
|
||||
print "You've got Linux 2.6\n" if(os_is('Linux::v2_6'));
|
||||
|
||||
=head1 USING IT IN Makefile.PL or Build.PL
|
||||
|
||||
If you want to use this from Makefile.PL or Build.PL, do
|
||||
not simply copy the module into your distribution as this may cause
|
||||
problems when PAUSE and search.cpan.org index the distro. Instead, use
|
||||
the use-devel-assertos script.
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
Devel::CheckOS implements the following functions, which load subsidiary
|
||||
OS-specific modules on demand to do the real work. They can be exported
|
||||
by listing their names after C<use Devel::CheckOS>. You can also export
|
||||
groups of functions thus:
|
||||
|
||||
use Devel::CheckOS qw(:booleans); # export the boolean functions
|
||||
# and 'die_unsupported'
|
||||
|
||||
use Devel::CheckOS qw(:fatal); # export those that die on no match
|
||||
|
||||
use Devel::CheckOS qw(:all); # export everything
|
||||
|
||||
=head2 Boolean functions
|
||||
|
||||
=head3 os_is
|
||||
|
||||
Takes a list of OS names. If the current platform matches any of them,
|
||||
it returns true, otherwise it returns false. The names can be a mixture
|
||||
of OSes and OS families, eg ...
|
||||
|
||||
os_is(qw(Unix VMS)); # Unix is a family, VMS is an OS
|
||||
|
||||
=cut
|
||||
|
||||
sub os_is {
|
||||
my @targets = @_;
|
||||
my $rval = 0;
|
||||
foreach my $target (@targets) {
|
||||
die("Devel::CheckOS: $target isn't a legal OS name\n")
|
||||
unless($target =~ /^\w+(::\w+)*$/);
|
||||
eval "use Devel::AssertOS::$target";
|
||||
if(!$@) {
|
||||
no strict 'refs';
|
||||
$rval = 1 if(&{"Devel::AssertOS::${target}::os_is"}());
|
||||
}
|
||||
}
|
||||
return $rval;
|
||||
}
|
||||
|
||||
=head3 os_isnt
|
||||
|
||||
If the current platform matches any of the parameters it returns false,
|
||||
otherwise it returns true.
|
||||
|
||||
=cut
|
||||
|
||||
sub os_isnt {
|
||||
my @targets = @_;
|
||||
my $rval = 1;
|
||||
foreach my $target (@targets) {
|
||||
$rval = 0 if(os_is($target));
|
||||
}
|
||||
return $rval;
|
||||
}
|
||||
|
||||
=head2 Fatal functions
|
||||
|
||||
=head3 die_if_os_isnt
|
||||
|
||||
As C<os_is()>, except that it dies instead of returning false. The die()
|
||||
message matches what the CPAN-testers look for to determine if a module
|
||||
doesn't support a particular platform.
|
||||
|
||||
=cut
|
||||
|
||||
sub die_if_os_isnt {
|
||||
os_is(@_) ? 1 : die_unsupported();
|
||||
}
|
||||
|
||||
=head3 die_if_os_is
|
||||
|
||||
As C<os_isnt()>, except that it dies instead of returning false.
|
||||
|
||||
=cut
|
||||
|
||||
sub die_if_os_is {
|
||||
os_isnt(@_) ? 1 : die_unsupported();
|
||||
}
|
||||
|
||||
=head2 And some utility functions ...
|
||||
|
||||
=head3 die_unsupported
|
||||
|
||||
This function simply dies with the message "OS unsupported", which is what
|
||||
the CPAN testers look for to figure out whether a platform is supported or
|
||||
not.
|
||||
|
||||
=cut
|
||||
|
||||
sub die_unsupported { die("OS unsupported\n"); }
|
||||
|
||||
=head3 list_platforms
|
||||
|
||||
When called in list context,
|
||||
return a list of all the platforms for which the corresponding
|
||||
Devel::AssertOS::* module is available. This includes both OSes and OS
|
||||
families, and both those bundled with this module and any third-party
|
||||
add-ons you have installed.
|
||||
|
||||
In scalar context, returns a hashref keyed by platform with the filename
|
||||
of the most recent version of the supporting module that is available to you.
|
||||
This is to make sure that the use-devel-assertos script Does The Right Thing
|
||||
in the case where you have installed the module in one version of perl, then
|
||||
upgraded perl, and installed it again in the new version. Sometimes the old
|
||||
version of perl and all its modules will still be hanging around and perl
|
||||
"helpfully" includes the old perl's search path in its own.
|
||||
|
||||
Unfortunately, on some platforms this list may have file case
|
||||
broken. eg, some platforms might return 'freebsd' instead of 'FreeBSD'.
|
||||
This is because they have case-insensitive filesystems so things
|
||||
should Just Work anyway.
|
||||
|
||||
=cut
|
||||
|
||||
my ($re_Devel, $re_AssertOS);
|
||||
|
||||
sub list_platforms {
|
||||
eval " # only load these if needed
|
||||
use File::Find::Rule;
|
||||
use File::Spec;
|
||||
";
|
||||
|
||||
die($@) if($@);
|
||||
if (!$re_Devel) {
|
||||
my $case_flag = File::Spec->case_tolerant ? '(?i)' : '';
|
||||
$re_Devel = qr/$case_flag ^Devel$/x;
|
||||
$re_AssertOS = qr/$case_flag ^AssertOS$/x;
|
||||
}
|
||||
|
||||
# sort by mtime, so oldest last
|
||||
my @modules = sort {
|
||||
(stat($a->{file}))[9] <=> (stat($b->{file}))[9]
|
||||
} map {
|
||||
my (undef, $dir_part, $file_part) = File::Spec->splitpath($_);
|
||||
$file_part =~ s/\.pm$//;
|
||||
my (@dirs) = grep {+length} File::Spec->splitdir($dir_part);
|
||||
foreach my $i (reverse 1..$#dirs) {
|
||||
next unless $dirs[$i] =~ $re_AssertOS
|
||||
&& $dirs[$i - 1] =~ $re_Devel;
|
||||
splice @dirs, 0, $i + 1;
|
||||
last;
|
||||
}
|
||||
{
|
||||
module => join('::', @dirs, $file_part),
|
||||
file => File::Spec->canonpath($_)
|
||||
}
|
||||
} File::Find::Rule->file()->name('*.pm')->in(
|
||||
grep { -d }
|
||||
map { File::Spec->catdir($_, qw(Devel AssertOS)) }
|
||||
@INC
|
||||
);
|
||||
|
||||
my %modules = map {
|
||||
$_->{module} => $_->{file}
|
||||
} @modules;
|
||||
|
||||
if(wantarray()) {
|
||||
return sort keys %modules;
|
||||
} else {
|
||||
return \%modules;
|
||||
}
|
||||
}
|
||||
|
||||
=head3 list_family_members
|
||||
|
||||
Takes the name of an OS 'family' and returns a list of all its members.
|
||||
In list context, you get a list, in scalar context you get an arrayref.
|
||||
|
||||
If called on something that isn't a family, you get an empty list (or
|
||||
a ref to an empty array).
|
||||
|
||||
=cut
|
||||
|
||||
sub list_family_members {
|
||||
my $family = shift() ||
|
||||
die(__PACKAGE__."::list_family_members needs a parameter\n");
|
||||
|
||||
# this will die if it's the wrong OS, but the module is loaded ...
|
||||
eval qq{use Devel::AssertOS::$family};
|
||||
# ... so we can now query it
|
||||
my @members = eval qq{
|
||||
no strict 'refs';
|
||||
&{"Devel::AssertOS::${family}::matches"}()
|
||||
};
|
||||
return wantarray() ? @members : \@members;
|
||||
}
|
||||
|
||||
=head1 PLATFORMS SUPPORTED
|
||||
|
||||
To see the list of platforms for which information is available, run this:
|
||||
|
||||
perl -MDevel::CheckOS -e 'print join(", ", Devel::CheckOS::list_platforms())'
|
||||
|
||||
Note that capitalisation is important. These are the names of the
|
||||
underlying Devel::AssertOS::* modules
|
||||
which do the actual platform detection, so they have to
|
||||
be 'legal' filenames and module names, which unfortunately precludes
|
||||
funny characters, so platforms like OS/2 are mis-spelt deliberately.
|
||||
Sorry.
|
||||
|
||||
Also be aware that not all of them have been properly tested. I don't
|
||||
have access to most of them and have had to work from information
|
||||
gleaned from L<perlport> and a few other places. For a complete list of
|
||||
OS families, see L<Devel::CheckOS::Families>.
|
||||
|
||||
If you want to add your own OSes or families, see L<Devel::AssertOS::Extending>
|
||||
and please feel free to upload the results to the CPAN.
|
||||
|
||||
=head1 BUGS and FEEDBACK
|
||||
|
||||
I welcome feedback about my code, including constructive criticism.
|
||||
Bug reports should be made using L<http://rt.cpan.org/> or by email.
|
||||
|
||||
You will need to include in your bug report the exact value of $^O, what
|
||||
the OS is called (eg Windows Vista 64 bit Ultimate Home Edition), and,
|
||||
if relevant, what "OS family" it should be in and who wrote it.
|
||||
|
||||
If you are feeling particularly generous you can encourage me in my
|
||||
open source endeavours by buying me something from my wishlist:
|
||||
L<http://www.cantrell.org.uk/david/wishlist/>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
$^O in L<perlvar>
|
||||
|
||||
L<perlport>
|
||||
|
||||
L<Devel::AssertOS>
|
||||
|
||||
L<Devel::AssertOS::Extending>
|
||||
|
||||
L<Probe::Perl>
|
||||
|
||||
The use-devel-assertos script
|
||||
|
||||
L<Module::Install::AssertOS>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David Cantrell E<lt>F<david@cantrell.org.uk>E<gt>
|
||||
|
||||
Thanks to David Golden for the name and ideas about the interface, and
|
||||
to the cpan-testers-discuss mailing list for prompting me to write it
|
||||
in the first place.
|
||||
|
||||
Thanks to Ken Williams, from whose L<Module::Build> I lifted some of the
|
||||
information about what should be in the Unix family.
|
||||
|
||||
Thanks to Billy Abbott for finding some bugs for me on VMS.
|
||||
|
||||
Thanks to Matt Kraai for information about QNX.
|
||||
|
||||
Thanks to Kenichi Ishigaki and Gabor Szabo for reporting a bug on Windows,
|
||||
and to the former for providing a patch.
|
||||
|
||||
=head1 CVS
|
||||
|
||||
L<http://drhyde.cvs.sourceforge.net/drhyde/perlmodules/Devel-CheckOS/>
|
||||
|
||||
=head1 COPYRIGHT and LICENCE
|
||||
|
||||
Copyright 2007 David Cantrell
|
||||
|
||||
This software is free-as-in-speech software, and may be used, distributed, and modified under the terms of either the GNU General Public Licence version 2 or the Artistic Licence. It's up to you which one you use. The full text of the licences can be found in the files GPL2.txt and ARTISTIC.txt, respectively.
|
||||
|
||||
=head1 HATS
|
||||
|
||||
I recommend buying a Fedora from L<http://hatsdirect.com/>.
|
||||
|
||||
=head1 CONSPIRACY
|
||||
|
||||
This module is also free-as-in-mason software.
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,189 @@
|
|||
package Perl::Critic::BuildUtilities;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use English q<-no_match_vars>;
|
||||
|
||||
our $VERSION = '1.126';
|
||||
|
||||
use Exporter 'import';
|
||||
|
||||
our @EXPORT_OK = qw<
|
||||
required_module_versions
|
||||
build_required_module_versions
|
||||
emit_tar_warning_if_necessary
|
||||
get_PL_files
|
||||
>;
|
||||
|
||||
|
||||
use Devel::CheckOS qw< os_is >;
|
||||
|
||||
|
||||
sub required_module_versions {
|
||||
return (
|
||||
'B::Keywords' => 1.05,
|
||||
'Carp' => 0,
|
||||
'Config::Tiny' => 2,
|
||||
'English' => 0,
|
||||
'Exception::Class' => 1.23,
|
||||
'Exporter' => 5.63,
|
||||
'Fatal' => 0,
|
||||
'File::Basename' => 0,
|
||||
'File::Find' => 0,
|
||||
'File::Path' => 0,
|
||||
'File::Spec' => 0,
|
||||
'File::Spec::Unix' => 0,
|
||||
'File::Temp' => 0,
|
||||
'File::Which' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'IO::String' => 0,
|
||||
'IPC::Open2' => 1,
|
||||
'List::MoreUtils' => 0.19,
|
||||
'List::Util' => 0,
|
||||
'Module::Build' => 0.4204,
|
||||
'Module::Pluggable' => 3.1,
|
||||
'PPI' => '1.265',
|
||||
'PPI::Document' => '1.265',
|
||||
'PPI::Document::File' => '1.265',
|
||||
'PPI::Node' => '1.265',
|
||||
'PPI::Token::Quote::Single' => '1.265',
|
||||
'PPI::Token::Whitespace' => '1.265',
|
||||
'PPIx::QuoteLike' => 0,
|
||||
'PPIx::Regexp' => '0.027', # Literal { deprecated in re
|
||||
'PPIx::Regexp::Util' => '0.068', # is_ppi_regexp_element()
|
||||
'PPIx::Utilities::Node' => '1.001',
|
||||
'PPIx::Utilities::Statement' => '1.001',
|
||||
'Perl::Tidy' => 0,
|
||||
'Pod::Parser' => 0,
|
||||
'Pod::PlainText' => 0,
|
||||
'Pod::Select' => 0,
|
||||
'Pod::Spell' => 1,
|
||||
'Pod::Usage' => 0,
|
||||
'Readonly' => 2.00,
|
||||
'Scalar::Util' => 0,
|
||||
'String::Format' => '1.18',
|
||||
'Task::Weaken' => 0,
|
||||
'Term::ANSIColor' => '2.02',
|
||||
'Test::Builder' => 0.92,
|
||||
'Text::ParseWords' => 3,
|
||||
'base' => 0,
|
||||
'charnames' => 0,
|
||||
'overload' => 0,
|
||||
'perl' => 5.006001,
|
||||
'strict' => 0,
|
||||
'version' => 0.77,
|
||||
'warnings' => 0,
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
sub build_required_module_versions {
|
||||
return (
|
||||
'lib' => 0,
|
||||
'Test::Deep' => 0,
|
||||
'Test::More' => 0,
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
my @TARGET_FILES = qw<
|
||||
t/ControlStructures/ProhibitNegativeExpressionsInUnlessAndUntilConditions.run
|
||||
t/NamingConventions/Capitalization.run
|
||||
t/Variables/RequireLocalizedPunctuationVars.run
|
||||
>;
|
||||
|
||||
sub get_PL_files {
|
||||
my %PL_files = map { ( "$_.PL" => $_ ) } @TARGET_FILES;
|
||||
|
||||
return \%PL_files;
|
||||
}
|
||||
|
||||
sub emit_tar_warning_if_necessary {
|
||||
if ( os_is( qw<Solaris> ) ) {
|
||||
print <<'END_OF_TAR_WARNING';
|
||||
NOTE: tar(1) on some Solaris systems cannot deal well with long file
|
||||
names.
|
||||
|
||||
If you get warnings about missing files below, please ensure that you
|
||||
extracted the Perl::Critic tarball using GNU tar.
|
||||
|
||||
END_OF_TAR_WARNING
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::BuildUtilities - Common bits of compiling Perl::Critic.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Various utilities used in assembling Perl::Critic, primary for use by
|
||||
*.PL programs that generate code.
|
||||
|
||||
|
||||
=head1 IMPORTABLE SUBROUTINES
|
||||
|
||||
=over
|
||||
|
||||
=item C<get_PL_files()>
|
||||
|
||||
Returns a reference to a hash with a mapping from the name of a .PL
|
||||
program to an array of the parameters to be passed to it, suited for
|
||||
use by L<Module::Build::API/"PL_files"> or
|
||||
L<ExtUtils::MakeMaker/"PL_FILES">. May print to C<STDOUT> messages
|
||||
about what it is doing.
|
||||
|
||||
|
||||
=item C<dump_unlisted_or_optional_module_versions()>
|
||||
|
||||
Prints to C<STDOUT> a list of all the unlisted (e.g. things in core
|
||||
like L<Exporter|Exporter>), optional (e.g.
|
||||
L<File::Which|File::Which>), or potentially indirect (e.g.
|
||||
L<Readonly::XS|Readonly::XS>) dependencies, plus their versions, if
|
||||
they're installed.
|
||||
|
||||
|
||||
=item C<emit_tar_warning_if_necessary()>
|
||||
|
||||
On some Solaris systems, C<tar(1)> can't deal with long file names and
|
||||
thus files are not correctly extracted from the tarball. So this
|
||||
prints a warning if the current system is Solaris.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank C<< <perl@galumph.com> >>
|
||||
|
||||
|
||||
=head1 LICENCE AND COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011, Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,158 @@
|
|||
package Perl::Critic::Module::Build;
|
||||
|
||||
use 5.006001;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.126';
|
||||
|
||||
use Carp;
|
||||
use English qw< $OS_ERROR $EXECUTABLE_NAME -no_match_vars >;
|
||||
|
||||
|
||||
use base 'Perl::Critic::Module::Build::Standard';
|
||||
|
||||
|
||||
sub ACTION_policysummary {
|
||||
my ($self) = @_;
|
||||
|
||||
require Perl::Critic::PolicySummaryGenerator;
|
||||
Perl::Critic::PolicySummaryGenerator->import(
|
||||
qw< generate_policy_summary >
|
||||
);
|
||||
|
||||
my $policy_summary_file = generate_policy_summary();
|
||||
$self->add_to_cleanup( $policy_summary_file );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub ACTION_nytprof {
|
||||
my ($self) = @_;
|
||||
|
||||
$self->depends_on('build');
|
||||
$self->_run_nytprof();
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub authortest_dependencies {
|
||||
my ($self) = @_;
|
||||
|
||||
$self->depends_on('policysummary');
|
||||
$self->SUPER::authortest_dependencies();
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub _run_nytprof {
|
||||
my ($self) = @_;
|
||||
|
||||
eval { require Devel::NYTProf; 1 }
|
||||
or croak 'Devel::NYTProf is required to run nytprof';
|
||||
|
||||
eval { require File::Which; File::Which->import('which'); 1 }
|
||||
or croak 'File::Which is required to run nytprof';
|
||||
|
||||
my $nytprofhtml = which('nytprofhtml')
|
||||
or croak 'Could not find nytprofhtml in your PATH';
|
||||
|
||||
my $this_perl = $EXECUTABLE_NAME;
|
||||
my @perl_args = qw(-Iblib/lib -d:NYTProf blib/script/perlcritic);
|
||||
my @perlcritic_args =
|
||||
qw<
|
||||
--noprofile
|
||||
--severity=1
|
||||
--theme=core
|
||||
--exclude=TidyCode
|
||||
--exclude=PodSpelling
|
||||
--exclude=RcsKeywords
|
||||
blib
|
||||
>;
|
||||
warn "Running: $this_perl @perl_args @perlcritic_args\n";
|
||||
|
||||
my $status_perlcritic = system $this_perl, @perl_args, @perlcritic_args;
|
||||
croak "perlcritic failed with status $status_perlcritic"
|
||||
if $status_perlcritic == 1;
|
||||
|
||||
my $status_nytprofhtml = system $nytprofhtml;
|
||||
croak "nytprofhtml failed with status $status_nytprofhtml"
|
||||
if $status_nytprofhtml;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Module::Build - Customization of L<Module::Build> for L<Perl::Critic>.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is a custom subclass of L<Module::Build> (actually,
|
||||
L<Perl::Critic::Module::Build::Standard>) that enhances existing functionality
|
||||
and adds more for the benefit of installing and developing L<Perl::Critic>.
|
||||
The following actions have been added or redefined:
|
||||
|
||||
|
||||
=head1 ACTIONS
|
||||
|
||||
=over
|
||||
|
||||
=item policysummary
|
||||
|
||||
Generates the F<PolicySummary.pod> file. This should only be used by
|
||||
C<Perl::Critic> developers. This action is also invoked by the C<authortest>
|
||||
action, so the F<PolicySummary.pod> file will be generated whenever you create
|
||||
a distribution with the C<dist> or C<distdir> targets.
|
||||
|
||||
|
||||
=item nytprof
|
||||
|
||||
Runs perlcritic under the L<Devel::NYTProf> profiler and generates
|
||||
an HTML report in F<nytprof/index.html>.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
package Perl::Critic::Module::Build::Standard;
|
||||
|
||||
use 5.006001;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.126';
|
||||
|
||||
use Carp;
|
||||
use English qw< $OS_ERROR -no_match_vars >;
|
||||
|
||||
|
||||
use base 'Module::Build';
|
||||
|
||||
|
||||
sub ACTION_authortest {
|
||||
my ($self) = @_;
|
||||
|
||||
$self->authortest_dependencies();
|
||||
$self->depends_on('test');
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub ACTION_authortestcover {
|
||||
my ($self) = @_;
|
||||
|
||||
$self->authortest_dependencies();
|
||||
$self->depends_on('testcover');
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub ACTION_distdir {
|
||||
my ($self, @arguments) = @_;
|
||||
|
||||
$self->depends_on('authortest');
|
||||
|
||||
return $self->SUPER::ACTION_distdir(@arguments);
|
||||
}
|
||||
|
||||
|
||||
sub ACTION_manifest {
|
||||
my ($self, @arguments) = @_;
|
||||
|
||||
# Make sure we get rid of files that no longer exist.
|
||||
if (-e 'MANIFEST') {
|
||||
unlink 'MANIFEST' or die "Can't unlink MANIFEST: $OS_ERROR";
|
||||
}
|
||||
|
||||
return $self->SUPER::ACTION_manifest(@arguments);
|
||||
}
|
||||
|
||||
|
||||
sub tap_harness_args {
|
||||
my ($self) = @_;
|
||||
|
||||
return $self->_tap_harness_args() if $ENV{RUNNING_UNDER_TEAMCITY};
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub _tap_harness_args {
|
||||
return {formatter_class => 'TAP::Formatter::TeamCity', merge => 1};
|
||||
}
|
||||
|
||||
|
||||
sub authortest_dependencies {
|
||||
my ($self) = @_;
|
||||
|
||||
$self->depends_on('build');
|
||||
$self->depends_on('manifest');
|
||||
$self->depends_on('distmeta');
|
||||
|
||||
$self->test_files( qw< t xt > );
|
||||
$self->recursive_test_files(1);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Module::Build::Standard - Customization of L<Module::Build> for L<Perl::Critic> distributions.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is a custom subclass of L<Module::Build> that enhances existing
|
||||
functionality and adds more for the benefit of installing and
|
||||
developing L<Perl::Critic>. The following actions have been added
|
||||
or redefined:
|
||||
|
||||
|
||||
=head1 ACTIONS
|
||||
|
||||
=over
|
||||
|
||||
=item authortest
|
||||
|
||||
Runs the regular tests plus the author tests (those in F<xt>).
|
||||
It used to be the case that author tests were run if an environment
|
||||
variable was set or if a F<.svn> directory existed. What ended up
|
||||
happening was that people that had that environment variable set for
|
||||
other purposes or who had done a checkout of the code repository would
|
||||
run those tests, which would fail, and we'd get bug reports for
|
||||
something not expected to run elsewhere. Now, you've got to
|
||||
explicitly ask for the author tests to be run.
|
||||
|
||||
|
||||
=item authortestcover
|
||||
|
||||
As C<authortest> is to the standard C<test> action, C<authortestcover>
|
||||
is to the standard C<testcover> action.
|
||||
|
||||
|
||||
=item distdir
|
||||
|
||||
In addition to the standard action, this adds a dependency upon the
|
||||
C<authortest> action so you can't do a release without passing the
|
||||
author tests.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
In addition to the above actions:
|
||||
|
||||
|
||||
=head2 C<authortest_dependencies()>
|
||||
|
||||
Sets up dependencies upon the C<build>, C<manifest>, and C<distmeta> actions,
|
||||
adds F<xt> to the set of test directories, and turns on the recursive
|
||||
search for tests.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,210 @@
|
|||
package Perl::Critic::PolicySummaryGenerator;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Exporter 'import';
|
||||
|
||||
use lib qw< blib lib >;
|
||||
use Carp qw< confess >;
|
||||
use English qw< -no_match_vars >;
|
||||
|
||||
use Perl::Critic::Config;
|
||||
use Perl::Critic::Exception::IO ();
|
||||
use Perl::Critic::PolicyFactory (-test => 1);
|
||||
use Perl::Critic::Utils qw< :characters >;
|
||||
use Perl::Critic::Utils::POD qw< get_module_abstract_from_file >;
|
||||
|
||||
use Exception::Class (); # Must be after P::C::Exception::*
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
our $VERSION = '1.126';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
our @EXPORT_OK = qw< generate_policy_summary >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub generate_policy_summary {
|
||||
|
||||
print "\n\nGenerating Perl::Critic::PolicySummary.\n";
|
||||
|
||||
|
||||
my $configuration =
|
||||
Perl::Critic::Config->new(-profile => $EMPTY, -severity => 1, -theme => 'core');
|
||||
|
||||
my @policies = $configuration->all_policies_enabled_or_not();
|
||||
my $policy_summary = 'lib/Perl/Critic/PolicySummary.pod';
|
||||
|
||||
## no critic (RequireBriefOpen)
|
||||
open my $pod_file, '>', $policy_summary
|
||||
or confess "Could not open $policy_summary: $ERRNO";
|
||||
|
||||
print {$pod_file} <<'END_HEADER';
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::PolicySummary - Descriptions of the Policy modules included with L<Perl::Critic|Perl::Critic> itself.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The following Policy modules are distributed with Perl::Critic. (There are
|
||||
additional Policies that can be found in add-on distributions.) The Policy
|
||||
modules have been categorized according to the table of contents in Damian
|
||||
Conway's book B<Perl Best Practices>. Since most coding standards take the
|
||||
form "do this..." or "don't do that...", I have adopted the convention of
|
||||
naming each module C<RequireSomething> or C<ProhibitSomething>. Each Policy
|
||||
is listed here with its default severity. If you don't agree with the default
|
||||
severity, you can change it in your F<.perlcriticrc> file (try C<perlcritic
|
||||
--profile-proto> for a starting version). See the documentation of each
|
||||
module for its specific details.
|
||||
|
||||
|
||||
=head1 POLICIES
|
||||
|
||||
END_HEADER
|
||||
|
||||
|
||||
my $format = <<'END_POLICY';
|
||||
=head2 L<%s|%s>
|
||||
|
||||
%s [Default severity %d]
|
||||
|
||||
END_POLICY
|
||||
|
||||
eval {
|
||||
foreach my $policy (@policies) {
|
||||
my $module_abstract = $policy->get_raw_abstract();
|
||||
|
||||
printf
|
||||
{$pod_file}
|
||||
$format,
|
||||
$policy->get_short_name(),
|
||||
$policy->get_long_name(),
|
||||
$module_abstract,
|
||||
$policy->default_severity();
|
||||
}
|
||||
|
||||
1;
|
||||
}
|
||||
or do {
|
||||
# Yes, an assignment and not equality test.
|
||||
if (my $exception = $EVAL_ERROR) {
|
||||
if ( ref $exception ) {
|
||||
$exception->show_trace(1);
|
||||
}
|
||||
|
||||
print {*STDERR} "$exception\n";
|
||||
}
|
||||
else {
|
||||
print {*STDERR} "Failed printing abstracts for an unknown reason.\n";
|
||||
}
|
||||
|
||||
exit 1;
|
||||
};
|
||||
|
||||
|
||||
print {$pod_file} <<'END_FOOTER';
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
This is part of L<Perl::Critic|Perl::Critic> version 1.126.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
END_FOOTER
|
||||
|
||||
|
||||
close $pod_file or confess "Could not close $policy_summary: $ERRNO";
|
||||
|
||||
print "Done.\n\n";
|
||||
|
||||
return $policy_summary;
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::PolicySummaryGenerator - Create F<PolicySummary.pod> file.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains subroutines for generating the
|
||||
L<Perl::Critic::PolicySummary> POD file. This file contains a brief
|
||||
summary of all the Policies that ship with L<Perl::Critic>. These
|
||||
summaries are extracted from the C<NAME> section of the POD for each
|
||||
Policy module.
|
||||
|
||||
This library should be used at author-time to generate the
|
||||
F<PolicySummary.pod> file B<before> releasing a new distribution. See
|
||||
also the C<policysummary> action in L<Perl::Critic::Module::Build>.
|
||||
|
||||
|
||||
=head1 IMPORTABLE SUBROUTINES
|
||||
|
||||
=over
|
||||
|
||||
=item C<generate_policy_summary()>
|
||||
|
||||
Generates the F<PolicySummary.pod> file which contains a brief summary of all
|
||||
the Policies in this distro. Returns the relative path this file. Unlike
|
||||
most of the other subroutines here, this subroutine should be used when
|
||||
creating a distribution, not when building or installing an existing
|
||||
distribution.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2009-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,410 @@
|
|||
package Perl::Critic::Annotation;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw(confess);
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use Perl::Critic::PolicyFactory;
|
||||
use Perl::Critic::Utils qw(:characters hashify);
|
||||
use Readonly;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
Readonly::Scalar my $LAST_ELEMENT => -1;
|
||||
|
||||
#=============================================================================
|
||||
# CLASS methods
|
||||
|
||||
sub create_annotations {
|
||||
my ($class, $doc) = @_;
|
||||
|
||||
my @annotations = ();
|
||||
my $comment_elements_ref = $doc->find('PPI::Token::Comment') || return;
|
||||
my $annotation_rx = qr{\A (?: [#]! .*? )? \s* [#][#] \s* no \s+ critic}xms;
|
||||
for my $annotation_element ( grep { $_ =~ $annotation_rx } @{$comment_elements_ref} ) {
|
||||
push @annotations, Perl::Critic::Annotation->new( -element => $annotation_element);
|
||||
}
|
||||
|
||||
return @annotations;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub new {
|
||||
my ($class, @args) = @_;
|
||||
my $self = bless {}, $class;
|
||||
$self->_init(@args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
#=============================================================================
|
||||
# OBJECT methods
|
||||
|
||||
sub _init {
|
||||
my ($self, %args) = @_;
|
||||
my $annotation_element = $args{-element} || confess '-element argument is required';
|
||||
$self->{_element} = $annotation_element;
|
||||
|
||||
my %disabled_policies = _parse_annotation( $annotation_element );
|
||||
$self->{_disables_all_policies} = %disabled_policies ? 0 : 1;
|
||||
$self->{_disabled_policies} = \%disabled_policies;
|
||||
|
||||
# Grab surrounding nodes to determine the context.
|
||||
# This determines whether the annotation applies to
|
||||
# the current line or the block that follows.
|
||||
my $annotation_line = $annotation_element->logical_line_number();
|
||||
my $parent = $annotation_element->parent();
|
||||
my $grandparent = $parent ? $parent->parent() : undef;
|
||||
|
||||
# Handle case when it appears on the shebang line. In this
|
||||
# situation, it only affects the first line, not the whole doc
|
||||
if ( $annotation_element =~ m{\A [#]!}xms) {
|
||||
$self->{_effective_range} = [$annotation_line, $annotation_line];
|
||||
return $self;
|
||||
}
|
||||
|
||||
# Handle single-line usage on simple statements. In this
|
||||
# situation, it only affects the line that it appears on.
|
||||
if ( _is_single_line_annotation_on_simple_statement( $annotation_element )
|
||||
) {
|
||||
$self->{_effective_range} = [$annotation_line, $annotation_line];
|
||||
return $self;
|
||||
}
|
||||
|
||||
# Handle single-line usage on compound statements. In this
|
||||
# situation -- um -- I'm not sure how this works, but it does.
|
||||
if ( ref $parent eq 'PPI::Structure::Block' ) {
|
||||
if ( ref $grandparent eq 'PPI::Statement::Compound'
|
||||
|| ref $grandparent eq 'PPI::Statement::Sub' ) {
|
||||
if ( $parent->logical_line_number() == $annotation_line ) {
|
||||
my $grandparent_line = $grandparent->logical_line_number();
|
||||
$self->{_effective_range} = [$grandparent_line, $grandparent_line];
|
||||
return $self;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# Handle multi-line usage. This is either a "no critic" ..
|
||||
# "use critic" region or a block where "no critic" is in effect
|
||||
# until the end of the scope. The start is the always the "no
|
||||
# critic" which we already found. So now we have to search for the end.
|
||||
my $end = $annotation_element;
|
||||
my $use_critic = qr{\A \s* [#][#] \s* use \s+ critic}xms;
|
||||
|
||||
SIB:
|
||||
while ( my $esib = $end->next_sibling() ) {
|
||||
$end = $esib; # keep track of last sibling encountered in this scope
|
||||
last SIB if $esib->isa('PPI::Token::Comment') && $esib =~ $use_critic;
|
||||
}
|
||||
|
||||
# PPI parses __END__ as a PPI::Statement::End, and everything following is
|
||||
# a child of that statement. That means if we encounter an __END__, we
|
||||
# need to descend into it and continue the analysis.
|
||||
if ( $end->isa( 'PPI::Statement::End' ) and my $kid = $end->child( 0 ) ) {
|
||||
$end = $kid;
|
||||
SIB:
|
||||
while ( my $esib = $end->next_sibling() ) {
|
||||
$end = $esib;
|
||||
last SIB if $esib->isa( 'PPI::Token::Comment' ) &&
|
||||
$esib->content() =~ $use_critic;
|
||||
}
|
||||
}
|
||||
|
||||
# We either found an end or hit the end of the scope.
|
||||
my $ending_line = $end->logical_line_number();
|
||||
$self->{_effective_range} = [$annotation_line, $ending_line];
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub element {
|
||||
my ($self) = @_;
|
||||
return $self->{_element};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub effective_range {
|
||||
my $self = shift;
|
||||
return @{ $self->{_effective_range} };
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub disabled_policies {
|
||||
my $self = shift;
|
||||
return keys %{ $self->{_disabled_policies} };
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub disables_policy {
|
||||
my ($self, $policy_name) = @_;
|
||||
return 1 if $self->{_disabled_policies}->{$policy_name};
|
||||
return 1 if $self->disables_all_policies();
|
||||
return 0;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub disables_all_policies {
|
||||
my ($self) = @_;
|
||||
return $self->{_disables_all_policies};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub disables_line {
|
||||
my ($self, $line_number) = @_;
|
||||
my $effective_range = $self->{_effective_range};
|
||||
return 1 if $line_number >= $effective_range->[0]
|
||||
and $line_number <= $effective_range->[$LAST_ELEMENT];
|
||||
return 0;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
# Recognize a single-line annotation on a simple statement.
|
||||
sub _is_single_line_annotation_on_simple_statement {
|
||||
my ( $annotation_element ) = @_;
|
||||
my $annotation_line = $annotation_element->logical_line_number();
|
||||
|
||||
# If there is no sibling, we are clearly not a single-line annotation of
|
||||
# any sort.
|
||||
my $sib = $annotation_element->sprevious_sibling()
|
||||
or return 0;
|
||||
|
||||
# The easy case: the sibling (whatever it is) is on the same line as the
|
||||
# annotation.
|
||||
$sib->logical_line_number() == $annotation_line
|
||||
and return 1;
|
||||
|
||||
# If the sibling is a node, we may have an annotation on one line of a
|
||||
# statement that was split over multiple lines. So we descend through the
|
||||
# children, keeping the last significant child of each, until we bottom
|
||||
# out. If the ultimate significant descendant is on the same line as the
|
||||
# annotation, we accept the annotation as a single-line annotation.
|
||||
if ( $sib->isa( 'PPI::Node' ) &&
|
||||
$sib->logical_line_number() < $annotation_line
|
||||
) {
|
||||
my $neighbor = $sib;
|
||||
while ( $neighbor->isa( 'PPI::Node' )
|
||||
and my $kid = $neighbor->schild( $LAST_ELEMENT ) ) {
|
||||
$neighbor = $kid;
|
||||
}
|
||||
if ( $neighbor &&
|
||||
$neighbor->logical_line_number() == $annotation_line
|
||||
) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
# We do not understand any other sort of single-line annotation. Accepting
|
||||
# the annotation as such (if it is) is Someone Else's Problem.
|
||||
return 0;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _parse_annotation {
|
||||
|
||||
my ($annotation_element) = @_;
|
||||
|
||||
#############################################################################
|
||||
# This regex captures the list of Policy name patterns that are to be
|
||||
# disabled. It is generally assumed that the element has already been
|
||||
# verified as a no-critic annotation. So if this regex does not match,
|
||||
# then it implies that all Policies are to be disabled.
|
||||
#
|
||||
my $no_critic = qr{\#\# \s* no \s+ critic \s* (?:qw)? [(["'] ([\s\w:,]+) }xms;
|
||||
# -------------------------- ------- ----- -----------
|
||||
# | | | |
|
||||
# "## no critic" with optional spaces | | |
|
||||
# | | |
|
||||
# Policy list may be prefixed with "qw" | |
|
||||
# | |
|
||||
# Optional Policy list must begin with one of these |
|
||||
# |
|
||||
# Capture entire Policy list (with delimiters) here
|
||||
#
|
||||
#############################################################################
|
||||
|
||||
my @disabled_policy_names = ();
|
||||
if ( my ($patterns_string) = $annotation_element =~ $no_critic ) {
|
||||
|
||||
# Compose the specified modules into a regex alternation. Wrap each
|
||||
# in a no-capturing group to permit "|" in the modules specification.
|
||||
|
||||
my @policy_name_patterns = grep { $_ ne $EMPTY }
|
||||
split m{\s *[,\s] \s*}xms, $patterns_string;
|
||||
my $re = join $PIPE, map {"(?:$_)"} @policy_name_patterns;
|
||||
my @site_policy_names = Perl::Critic::PolicyFactory::site_policy_names();
|
||||
@disabled_policy_names = grep {m/$re/ixms} @site_policy_names;
|
||||
|
||||
# It is possible that the Policy patterns listed in the annotation do not
|
||||
# match any of the site policy names. This could happen when running
|
||||
# on a machine that does not have the same set of Policies as the author.
|
||||
# So we must return something here, otherwise all Policies will be
|
||||
# disabled. We probably need to add a mechanism to (optionally) warn
|
||||
# about this, just to help the author avoid writing invalid Policy names.
|
||||
|
||||
if (not @disabled_policy_names) {
|
||||
@disabled_policy_names = @policy_name_patterns;
|
||||
}
|
||||
}
|
||||
|
||||
return hashify(@disabled_policy_names);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Annotation - A "## no critic" annotation in a document.
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Perl::Critic::Annotation;
|
||||
$annotation = Perl::Critic::Annotation->new( -element => $no_critic_ppi_element );
|
||||
|
||||
$bool = $annotation->disables_line( $number );
|
||||
$bool = $annotation->disables_policy( $policy_object );
|
||||
$bool = $annotation->disables_all_policies();
|
||||
|
||||
($start, $end) = $annotation->effective_range();
|
||||
@disabled_policy_names = $annotation->disabled_policies();
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
C<Perl::Critic::Annotation> represents a single C<"## no critic">
|
||||
annotation in a L<PPI::Document>. The Annotation takes care of parsing
|
||||
the annotation and keeps track of which lines and Policies it affects.
|
||||
It is intended to encapsulate the details of the no-critic
|
||||
annotations, and to provide a way for Policy objects to interact with
|
||||
the annotations (via a L<Perl::Critic::Document|Perl::Critic::Document>).
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a non-public class. Its interface is subject
|
||||
to change without notice.
|
||||
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item create_annotations( -doc => $doc )
|
||||
|
||||
Given a L<Perl::Critic::Document|Perl::Critic::Document>, finds all the C<"## no critic">
|
||||
annotations and constructs a new C<Perl::Critic::Annotation> for each
|
||||
one and returns them. The order of the returned objects is not
|
||||
defined. It is generally expected that clients will use this
|
||||
interface rather than calling the C<Perl::Critic::Annotation>
|
||||
constructor directly.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 CONSTRUCTOR
|
||||
|
||||
=over
|
||||
|
||||
=item C<< new( -element => $ppi_annotation_element ) >>
|
||||
|
||||
Returns a reference to a new Annotation object. The B<-element>
|
||||
argument is required and should be a C<PPI::Token::Comment> that
|
||||
conforms to the C<"## no critic"> syntax.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<< disables_line( $line ) >>
|
||||
|
||||
Returns true if this Annotation disables C<$line> for any (or all)
|
||||
Policies.
|
||||
|
||||
|
||||
=item C<< disables_policy( $policy_object ) >>
|
||||
|
||||
=item C<< disables_policy( $policy_name ) >>
|
||||
|
||||
Returns true if this Annotation disables C<$polciy_object> or
|
||||
C<$policy_name> at any (or all) lines.
|
||||
|
||||
|
||||
=item C<< disables_all_policies() >>
|
||||
|
||||
Returns true if this Annotation disables all Policies at any (or all)
|
||||
lines. If this method returns true, C<disabled_policies> will return
|
||||
an empty list.
|
||||
|
||||
|
||||
=item C<< effective_range() >>
|
||||
|
||||
Returns a two-element list, representing the first and last line
|
||||
numbers where this Annotation has effect.
|
||||
|
||||
|
||||
=item C<< disabled_policies() >>
|
||||
|
||||
Returns a list of the names of the Policies that are affected by this
|
||||
Annotation. If this list is empty, then it means that all Policies
|
||||
are affected by this Annotation, and C<disables_all_policies()> should
|
||||
return true.
|
||||
|
||||
|
||||
=item C<< element() >>
|
||||
|
||||
Returns the L<PPI::Element|PPI::Element> where this annotation started. This is
|
||||
typically an instance of L<PPI::Token::Comment|PPI::Token::Comment>.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,314 @@
|
|||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::CORE_DEVELOPER - Hints for working on the Perl::Critic core.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This document is a grab-bag of notes for those who are working on the
|
||||
underpinnings of Perl::Critic. They are intended to be informative,
|
||||
but unfortunately can not really be considered authoritative. It is in
|
||||
the nature of the task being described that the user of this document
|
||||
will end up working out the details for him- or herself based on the
|
||||
actual work being performed. B<Caveat lector.>
|
||||
|
||||
|
||||
=head1 BECOMING A CORE DEVELOPER
|
||||
|
||||
Here are my thoughts on how to get started. Note that the steps are
|
||||
not numbered because I'm not sure there is a clear order to them. The
|
||||
items with two stars in front of them are from the mailing list; the
|
||||
ones with one star are my opinion. Although sometimes I have felt it
|
||||
helpful to comment on the two-star items, just to make things
|
||||
thoroughly unclear.
|
||||
|
||||
* If you're unsure of yourself, install Perl::Critic, then download
|
||||
the source and rummage around in it.
|
||||
|
||||
** Subscribe to the developers' mailing list. There are instructions
|
||||
in L<Perl::Critic/EXTENDING THE CRITIC>. The F<commits> mailing list
|
||||
is another good one.
|
||||
|
||||
** If you are working on a GitHub issue, you should update the ticket to
|
||||
say that you are, to keep other people from duplicating your effort.
|
||||
|
||||
* I personally would update GitHub at the point I was reasonably confident
|
||||
I could hack it, just to prevent myself from having to update GitHub
|
||||
again in a week or so saying "oops, bit off more than I could chew."
|
||||
But that's me talking.
|
||||
|
||||
* Development requires using Module::Build rather than
|
||||
ExtUtils::MakeMaker. In other words,
|
||||
|
||||
$ perl Build.PL
|
||||
$ ./Build
|
||||
$ ./Build test
|
||||
|
||||
* You need to run the suite of author tests by running
|
||||
|
||||
$ ./Build authortest
|
||||
|
||||
(but not 'make authortest', which is one of the reasons you should
|
||||
start with F<Build.PL> rather than F<Makefile.PL>) These should run
|
||||
cleanly before you declare your work done. My advice, though, is not
|
||||
to worry about them until your code is functionally correct.
|
||||
|
||||
|
||||
=head2 Modules required for authortest
|
||||
|
||||
The authortest requires a B<bunch> of modules above and beyond those
|
||||
required to run C<Perl::Critic>. The list probably depends on which
|
||||
C<Perl::Critic> you are testing, so the following should not be
|
||||
considered definitive. You need the following in addition to B<all>
|
||||
optional modules for Perl::Critic itself.
|
||||
|
||||
Devel::EnforceEncapsulation
|
||||
Perl::Critic::More
|
||||
Test::Kwalitee
|
||||
Test::Memory::Cycle
|
||||
Test::Perl::Critic
|
||||
Test::Pod
|
||||
Test::Pod::Coverage
|
||||
Test::Without::Module
|
||||
|
||||
You can find out what the optional modules are by looking at
|
||||
C<recommended_module_versions()> in
|
||||
F<inc/Perl/Critic/BuildUtilities.pm>.
|
||||
|
||||
In the absence of C<Test::Memory::Cycle>, the relevant tests are
|
||||
simply skipped. In the absence of the other modules, the tests die
|
||||
horribly. Of course, either way they do not get run, so the
|
||||
difference is mainly one of aesthetics.
|
||||
|
||||
Under Perl 5.12 and above, L<Devel::Cycle|Devel::Cycle> 1.11 needs to
|
||||
be patched to handle a C<Regexp> as a first-class Perl object. See
|
||||
L<https://rt.cpan.org/Public/Bug/Display.html?id=56681> for the
|
||||
details.
|
||||
|
||||
|
||||
=head1 ADDING A GLOBAL CONFIGURATION ITEM
|
||||
|
||||
Perlcritic handles global configuration items and command line options
|
||||
in very similar ways. These notes will cover adding both a global
|
||||
configuration item and a corresponding, same-named command option.
|
||||
These notes can not, of course, cover implementing the functionality
|
||||
of the new item, just the mechanics of getting the item into
|
||||
Perl::Critic.
|
||||
|
||||
|
||||
=head2 Naming Conventions
|
||||
|
||||
All names are lower-case, except for the names of constants (if any),
|
||||
which are upper-case. When a name contains multiple words, dashes
|
||||
will be used to separate the words in the configuration item name and
|
||||
the command line option, and underscores will be used in the accessor
|
||||
and attribute value names, and constant names if any.
|
||||
|
||||
For example, if "new item" is being added, the configuration item is
|
||||
"new-item", the command option is "--new-item", the accessors are
|
||||
C<new_item()>, and the value of the attribute will be stored in
|
||||
C<< $self->{_new_item} >>. If there are constants involved, their
|
||||
names will start with C<NEW_ITEM_>. These names will be used in the
|
||||
following discussion.
|
||||
|
||||
|
||||
=head2 Implementation
|
||||
|
||||
There are several files that must be modified to get your new
|
||||
configuration item and/or command line option.
|
||||
|
||||
|
||||
=head3 F<lib/Perl/Critic/Utils/Constants.pm>
|
||||
|
||||
If there are manifest constants connected with your implementation
|
||||
they go here. You may well at least have a
|
||||
|
||||
$NEW_ITEM_DEFAULT
|
||||
|
||||
to define. All the constants for your new item must be exported, and
|
||||
should be exported not only individually but all together with export
|
||||
tag
|
||||
|
||||
new_item
|
||||
|
||||
|
||||
=head3 F<lib/Perl/Critic/Command.pm>
|
||||
|
||||
If your new item is a command option, its L<Getopt::Long|Getopt::Long>
|
||||
specification must be defined in C<_get_option_specification()>. If
|
||||
your new configuration item does not have a corresponding command
|
||||
option, you do not need to make any changes to this file.
|
||||
|
||||
|
||||
=head3 F<lib/Perl/Critic/OptionsProcessor.pm>
|
||||
|
||||
If your new item is a global configuration item, you need to add the
|
||||
code to handle it here. Specifically:
|
||||
|
||||
You must add code to the C<_init()> method to store the value of your
|
||||
item as an attribute value, defaulting it if necessary. Using our
|
||||
naming convention, a single-valued item would be stored like this:
|
||||
|
||||
$self->{_new_item} = dor(delete $args{'new-item'},
|
||||
$NEW_ITEM_DEFAULT);
|
||||
|
||||
If the item has synonyms (e.g. both 'color' and 'colour' meaning the
|
||||
same thing), the C<dor()> call must check for all of them. If the
|
||||
item took a list of values, they would be parsed apart and stored as
|
||||
an array reference.
|
||||
|
||||
You must also add and document an accessor for your new item. This
|
||||
would look something like this:
|
||||
|
||||
sub new_item {
|
||||
my ($self) = @_;
|
||||
return $self->{_new_item};
|
||||
}
|
||||
|
||||
In the case of multi-valued items, the accessor must return the array
|
||||
reference, so the above specimen code works in that case also.
|
||||
|
||||
Note that no validation is done here -- this class is simply a bridge
|
||||
between the physical F<.perlcriticrc> file and
|
||||
L<Perl::Critic::Config|Perl::Critic::Config>, which is where the
|
||||
action is.
|
||||
|
||||
If your new item is a command option without a corresponding global
|
||||
configuration item, you do not need to modify this file.
|
||||
|
||||
|
||||
=head3 F<lib/Perl/Critic/Config.pm>
|
||||
|
||||
You must write a C<_validate_and_store_new_item()> method to validate
|
||||
and store the value of the new item. The signature of this method
|
||||
depends on the details of your new item, but it must include at least
|
||||
the value of the item, B<even if> there is no corresponding global
|
||||
configuration item. If it is possible to get validation failures, it
|
||||
will also need an errors object to add the validation exception to.
|
||||
Because the details vary, the best way to proceed is probably to find
|
||||
a method similar to the one you want to write, and implement from
|
||||
there. The C<_validate_and_store_top()> method is a reasonable
|
||||
starting point for an item having a single value. The validated value
|
||||
needs to be stored in C<< $self->{_new_item} >>.
|
||||
|
||||
You must call C<_validate_and_store_new_item()> in the C<_init()>
|
||||
method.
|
||||
|
||||
You must write and document an accessor method for the value of the
|
||||
new item. The typical accessor method for a single-valued item is
|
||||
|
||||
sub new_item {
|
||||
my ($self) = @_;
|
||||
return $self->{_new_item};
|
||||
}
|
||||
|
||||
but the accessor for a multi-valued item must return a list:
|
||||
|
||||
sub new_item {
|
||||
my ($self) = @_;
|
||||
return @{ $self->{_new_item} };
|
||||
}
|
||||
|
||||
Last, you must document the item itself.
|
||||
|
||||
|
||||
=head3 F<lib/Perl/Critic/ProfilePrototype.pm>
|
||||
|
||||
If your new item has a corresponding global configuration item, you
|
||||
must update the C<to_string()> method to include the item in the
|
||||
string. Your implementation of the item must be such that the
|
||||
generated string is the same as the input string for the item, except
|
||||
for whitespace.
|
||||
|
||||
If your new item has no corresponding global configuration item, you
|
||||
do not need to change this file.
|
||||
|
||||
|
||||
=head3 F<bin/perlcriticrc>
|
||||
|
||||
If your new item has a corresponding command option, you must document
|
||||
it here. If it does not, you do not need to change this file.
|
||||
|
||||
|
||||
=head3 F<examples/perlcriticrc>
|
||||
|
||||
If your new item has a corresponding global configuration item, you
|
||||
must add it here. If it does not, you do not need to change this file.
|
||||
|
||||
|
||||
=head2 Testing
|
||||
|
||||
The following test files must be considered for modification:
|
||||
|
||||
t/00_modules.t
|
||||
t/01_config.t
|
||||
t/01_config_bad_perlcritic.t
|
||||
t/04_options_processor.t
|
||||
t/07_command.t
|
||||
t/10_user_profile.t
|
||||
t/16_roundtrip_defaults.t
|
||||
|
||||
Depending on your new item, you may not need to change all of these,
|
||||
but you should at least review them. Depending on what your new item
|
||||
actually does, other test files may need to be modified as well.
|
||||
|
||||
|
||||
=head1 DEPRECATING AND REMOVING A PUBLIC SUBROUTINE OR METHOD
|
||||
|
||||
This is something to be done cautiously. The code in question may only
|
||||
exist to serve Perl::Critic, but if it is documented as public it may
|
||||
well be in use "in the wild", either in add-ons to Perl::Critic or by
|
||||
users of Perl::Critic.
|
||||
|
||||
Before deprecating public code, the potential deprecator must discuss
|
||||
the issues on the Perl::Critic developers' mailing list. There are
|
||||
instructions on how to subscribe to this list in
|
||||
L<Perl::Critic/EXTENDING THE CRITIC>.
|
||||
|
||||
Once agreement is reached, the technical details of the deprecation
|
||||
are fairly simple.
|
||||
|
||||
You must insert something like the following in the code to be
|
||||
deprecated:
|
||||
|
||||
warnings::warnif(
|
||||
'deprecated',
|
||||
'Perl::Critic::Utils::foo() deprecated, use blah::foo() instead.',
|
||||
);
|
||||
|
||||
You should have the deprecated subroutine delegate its functionality
|
||||
to the new subroutine, if that is practical (it may not be).
|
||||
|
||||
You must update the documentation to say that the old code is
|
||||
deprecated, and what the replacement is.
|
||||
|
||||
After the old code has been deprecated for a couple production
|
||||
releases, it can be removed.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Thomas R. Wyant, III F<wyant at cpan dot org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2009-2011 Thomas R. Wyant, III
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=70 ft=pod expandtab shiftround :
|
||||
|
|
@ -0,0 +1,733 @@
|
|||
package Perl::Critic::Command;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use English qw< -no_match_vars >;
|
||||
use Readonly;
|
||||
|
||||
use Getopt::Long qw< GetOptions >;
|
||||
use List::Util qw< first max >;
|
||||
use Pod::Usage qw< pod2usage >;
|
||||
|
||||
use Perl::Critic::Exception::Parse ();
|
||||
use Perl::Critic::Utils qw<
|
||||
:characters :severities policy_short_name
|
||||
$DEFAULT_VERBOSITY $DEFAULT_VERBOSITY_WITH_FILE_NAME
|
||||
>;
|
||||
use Perl::Critic::Utils::Constants qw< $_MODULE_VERSION_TERM_ANSICOLOR >;
|
||||
use Perl::Critic::Violation qw<>;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exporter 'import';
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< run >;
|
||||
|
||||
Readonly::Hash our %EXPORT_TAGS => (
|
||||
all => [ @EXPORT_OK ],
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DEFAULT_VIOLATIONS_FOR_TOP => 20;
|
||||
|
||||
Readonly::Scalar my $EXIT_SUCCESS => 0;
|
||||
Readonly::Scalar my $EXIT_NO_FILES => 1;
|
||||
Readonly::Scalar my $EXIT_HAD_VIOLATIONS => 2;
|
||||
Readonly::Scalar my $EXIT_HAD_FILE_PROBLEMS => 3;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
my @files = ();
|
||||
my $critic = undef;
|
||||
my $output = \*STDOUT;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _out {
|
||||
my @lines = @_;
|
||||
return print {$output} @lines;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub run {
|
||||
my %options = _get_options();
|
||||
@files = _get_input(@ARGV);
|
||||
|
||||
my ($violations, $had_error_in_file) = _critique(\%options, @files);
|
||||
|
||||
return $EXIT_HAD_FILE_PROBLEMS if $had_error_in_file;
|
||||
return $EXIT_NO_FILES if not defined $violations;
|
||||
return $EXIT_HAD_VIOLATIONS if $violations;
|
||||
|
||||
return $EXIT_SUCCESS;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_options {
|
||||
|
||||
my %opts = _parse_command_line();
|
||||
_dispatch_special_requests( %opts );
|
||||
_validate_options( %opts );
|
||||
|
||||
# Convert severity shortcut options. If multiple shortcuts
|
||||
# are given, the lowest one wins. If an explicit --severity
|
||||
# option has been given, then the shortcuts are ignored. The
|
||||
# @SEVERITY_NAMES variable is exported by Perl::Critic::Utils.
|
||||
$opts{-severity} ||= first { exists $opts{"-$_"} } @SEVERITY_NAMES;
|
||||
$opts{-severity} ||= first { exists $opts{"-$_"} } ($SEVERITY_LOWEST .. $SEVERITY_HIGHEST);
|
||||
|
||||
|
||||
# If --top is specified, default the severity level to 1, unless an
|
||||
# explicit severity is defined. This provides us flexibility to
|
||||
# report top-offenders across just some or all of the severity levels.
|
||||
# We also default the --top count to twenty if none is given
|
||||
if ( exists $opts{-top} ) {
|
||||
$opts{-severity} ||= 1;
|
||||
$opts{-top} ||= $DEFAULT_VIOLATIONS_FOR_TOP;
|
||||
}
|
||||
|
||||
#Override profile, if --noprofile is specified
|
||||
if ( exists $opts{-noprofile} ) {
|
||||
$opts{-profile} = $EMPTY;
|
||||
}
|
||||
|
||||
return %opts;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _parse_command_line {
|
||||
my %opts;
|
||||
my @opt_specs = _get_option_specification();
|
||||
Getopt::Long::Configure('no_ignore_case');
|
||||
GetOptions( \%opts, @opt_specs ) || pod2usage(); #Exits
|
||||
|
||||
# I've adopted the convention of using key-value pairs for
|
||||
# arguments to most functions. And to increase legibility,
|
||||
# I have also adopted the familiar command-line practice
|
||||
# of denoting argument names with a leading dash (-).
|
||||
my %dashed_opts = map { ( "-$_" => $opts{$_} ) } keys %opts;
|
||||
return %dashed_opts;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _dispatch_special_requests {
|
||||
my (%opts) = @_;
|
||||
if ( $opts{-help} ) { pod2usage( -verbose => 0 ) } # Exits
|
||||
if ( $opts{-options} ) { pod2usage( -verbose => 1 ) } # Exits
|
||||
if ( $opts{-man} ) { pod2usage( -verbose => 2 ) } # Exits
|
||||
if ( $opts{-version} ) { _display_version() } # Exits
|
||||
if ( $opts{-list} ) { _render_all_policy_listing() } # Exits
|
||||
if ( $opts{'-list-enabled'} ) { _render_policy_listing(%opts) } # Exits
|
||||
if ( $opts{'-list-themes'} ) { _render_theme_listing() } # Exits
|
||||
if ( $opts{'-profile-proto'} ) { _render_profile_prototype() } # Exits
|
||||
if ( $opts{-doc} ) { _render_policy_docs( %opts ) } # Exits
|
||||
return 1;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _validate_options {
|
||||
my (%opts) = @_;
|
||||
my $msg = $EMPTY;
|
||||
|
||||
|
||||
if ( $opts{-noprofile} && $opts{-profile} ) {
|
||||
$msg .= qq{Warning: Cannot use -noprofile with -profile option.\n};
|
||||
}
|
||||
|
||||
if ( $opts{-verbose} && $opts{-verbose} !~ m{(?: \d+ | %[mfFlcCedrpPs] )}xms) {
|
||||
$msg .= qq<Warning: --verbose arg "$opts{-verbose}" looks odd. >;
|
||||
$msg .= qq<Perhaps you meant to say "--verbose 3 $opts{-verbose}."\n>;
|
||||
}
|
||||
|
||||
if ( exists $opts{-top} && $opts{-top} < 0 ) {
|
||||
$msg .= qq<Warning: --top argument "$opts{-top}" is negative. >;
|
||||
$msg .= qq<Perhaps you meant to say "$opts{-top} --top".\n>;
|
||||
}
|
||||
|
||||
if (
|
||||
exists $opts{-severity}
|
||||
&& (
|
||||
$opts{-severity} < $SEVERITY_LOWEST
|
||||
|| $opts{-severity} > $SEVERITY_HIGHEST
|
||||
)
|
||||
) {
|
||||
$msg .= qq<Warning: --severity arg "$opts{-severity}" out of range. >;
|
||||
$msg .= qq<Severities range from "$SEVERITY_LOWEST" (lowest) to >;
|
||||
$msg .= qq<"$SEVERITY_HIGHEST" (highest).\n>;
|
||||
}
|
||||
|
||||
|
||||
if ( $msg ) {
|
||||
pod2usage( -exitstatus => 1, -message => $msg, -verbose => 0); #Exits
|
||||
}
|
||||
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_input {
|
||||
|
||||
my @args = @_;
|
||||
|
||||
if ( !@args || (@args == 1 && $args[0] eq q{-}) ) {
|
||||
|
||||
# Reading code from STDIN. All the code is slurped into
|
||||
# a string. PPI will barf if the string is just whitespace.
|
||||
my $code_string = do { local $RS = undef; <> };
|
||||
|
||||
# Notice if STDIN was closed (pipe error, etc)
|
||||
if ( ! defined $code_string ) {
|
||||
$code_string = $EMPTY;
|
||||
}
|
||||
|
||||
$code_string =~ m{ \S+ }xms || die qq{Nothing to critique.\n};
|
||||
return \$code_string; #Convert to SCALAR ref for PPI
|
||||
}
|
||||
else {
|
||||
|
||||
# Test to make sure all the specified files or directories
|
||||
# actually exist. If any one of them is bogus, then die.
|
||||
if ( my $nonexistent = first { ! -e } @args ) {
|
||||
my $msg = qq{No such file or directory: '$nonexistent'};
|
||||
pod2usage( -exitstatus => 1, -message => $msg, -verbose => 0);
|
||||
}
|
||||
|
||||
# Reading code from files or dirs. If argument is a file,
|
||||
# then we process it as-is (even though it may not actually
|
||||
# be Perl code). If argument is a directory, recursively
|
||||
# search the directory for files that look like Perl code.
|
||||
return map { (-d) ? Perl::Critic::Utils::all_perl_files($_) : $_ } @args;
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
sub _critique {
|
||||
|
||||
my ( $opts_ref, @files_to_critique ) = @_;
|
||||
@files_to_critique || die "No perl files were found.\n";
|
||||
|
||||
# Perl::Critic has lots of dependencies, so loading is delayed
|
||||
# until it is really needed. This hack reduces startup time for
|
||||
# doing other things like getting the version number or dumping
|
||||
# the man page. Arguably, those things are pretty rare, but hey,
|
||||
# why not save a few seconds if you can.
|
||||
|
||||
require Perl::Critic;
|
||||
$critic = Perl::Critic->new( %{$opts_ref} );
|
||||
$critic->policies() || die "No policies selected.\n";
|
||||
|
||||
_set_up_pager($critic->config()->pager());
|
||||
|
||||
my $number_of_violations = undef;
|
||||
my $had_error_in_file = 0;
|
||||
|
||||
for my $file (@files_to_critique) {
|
||||
|
||||
eval {
|
||||
my @violations = $critic->critique($file);
|
||||
$number_of_violations += scalar @violations;
|
||||
|
||||
if (not $opts_ref->{'-statistics-only'}) {
|
||||
_render_report( $file, $opts_ref, @violations )
|
||||
}
|
||||
1;
|
||||
}
|
||||
or do {
|
||||
if ( my $exception = Perl::Critic::Exception::Parse->caught() ) {
|
||||
$had_error_in_file = 1;
|
||||
warn qq<Problem while critiquing "$file": $EVAL_ERROR\n>;
|
||||
}
|
||||
elsif ($EVAL_ERROR) {
|
||||
# P::C::Exception::Fatal includes the stack trace in its
|
||||
# stringification.
|
||||
die qq<Fatal error while critiquing "$file": $EVAL_ERROR\n>;
|
||||
}
|
||||
else {
|
||||
die qq<Fatal error while critiquing "$file". Unfortunately, >,
|
||||
q<$@/$EVAL_ERROR >, ## no critic (RequireInterpolationOfMetachars)
|
||||
qq<is empty, so the reason can't be shown.\n>;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $opts_ref->{-statistics} or $opts_ref->{'-statistics-only'} ) {
|
||||
my $stats = $critic->statistics();
|
||||
_report_statistics( $opts_ref, $stats );
|
||||
}
|
||||
|
||||
return $number_of_violations, $had_error_in_file;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
sub _render_report {
|
||||
my ( $file, $opts_ref, @violations ) = @_;
|
||||
|
||||
# Only report the files, if asked.
|
||||
my $number_of_violations = scalar @violations;
|
||||
if ( $opts_ref->{'-files-with-violations'} ||
|
||||
$opts_ref->{'-files-without-violations'} ) {
|
||||
not ref $file
|
||||
and $opts_ref->{$number_of_violations ? '-files-with-violations' :
|
||||
'-files-without-violations'}
|
||||
and _out "$file\n";
|
||||
return $number_of_violations;
|
||||
}
|
||||
|
||||
# Only report the number of violations, if asked.
|
||||
if( $opts_ref->{-count} ){
|
||||
ref $file || _out "$file: ";
|
||||
_out "$number_of_violations\n";
|
||||
return $number_of_violations;
|
||||
}
|
||||
|
||||
# Hail all-clear unless we should shut up.
|
||||
if( !@violations && !$opts_ref->{-quiet} ) {
|
||||
ref $file || _out "$file ";
|
||||
_out "source OK\n";
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Otherwise, format and print violations
|
||||
my $verbosity = $critic->config->verbose();
|
||||
# $verbosity can be numeric or string, so use "eq" for comparison;
|
||||
$verbosity =
|
||||
($verbosity eq $DEFAULT_VERBOSITY && @files > 1)
|
||||
? $DEFAULT_VERBOSITY_WITH_FILE_NAME
|
||||
: $verbosity;
|
||||
my $fmt = Perl::Critic::Utils::verbosity_to_format( $verbosity );
|
||||
if (not -f $file) { $fmt =~ s< \%[fF] ><STDIN>xms; } #HACK!
|
||||
Perl::Critic::Violation::set_format( $fmt );
|
||||
|
||||
my $color = $critic->config->color();
|
||||
_out $color ? _colorize_by_severity(@violations) : @violations;
|
||||
|
||||
return $number_of_violations;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _set_up_pager {
|
||||
my ($pager_command) = @_;
|
||||
return if not $pager_command;
|
||||
return if not _at_tty();
|
||||
|
||||
open my $pager, q<|->, $pager_command ## no critic (InputOutput::RequireBriefOpen)
|
||||
or die qq<Unable to pipe to pager "$pager_command": $ERRNO\n>;
|
||||
|
||||
$output = $pager;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _report_statistics {
|
||||
my ($opts_ref, $statistics) = @_;
|
||||
|
||||
if (
|
||||
not $opts_ref->{'-statistics-only'}
|
||||
and (
|
||||
$statistics->total_violations()
|
||||
or not $opts_ref->{-quiet} and $statistics->modules()
|
||||
)
|
||||
) {
|
||||
_out "\n"; # There's prior output that we want to separate from.
|
||||
}
|
||||
|
||||
my $files = _commaify($statistics->modules());
|
||||
my $subroutines = _commaify($statistics->subs());
|
||||
my $statements = _commaify($statistics->statements_other_than_subs());
|
||||
my $lines = _commaify($statistics->lines());
|
||||
my $width = max map { length } $files, $subroutines, $statements;
|
||||
|
||||
_out sprintf "%*s %s.\n", $width, $files, 'files';
|
||||
_out sprintf "%*s %s.\n", $width, $subroutines, 'subroutines/methods';
|
||||
_out sprintf "%*s %s.\n", $width, $statements, 'statements';
|
||||
|
||||
my $lines_of_blank = _commaify( $statistics->lines_of_blank() );
|
||||
my $lines_of_comment = _commaify( $statistics->lines_of_comment() );
|
||||
my $lines_of_data = _commaify( $statistics->lines_of_data() );
|
||||
my $lines_of_perl = _commaify( $statistics->lines_of_perl() );
|
||||
my $lines_of_pod = _commaify( $statistics->lines_of_pod() );
|
||||
|
||||
$width =
|
||||
max map { length }
|
||||
$lines_of_blank, $lines_of_comment, $lines_of_data,
|
||||
$lines_of_perl, $lines_of_pod;
|
||||
_out sprintf "\n%s %s:\n", $lines, 'lines, consisting of';
|
||||
_out sprintf " %*s %s.\n", $width, $lines_of_blank, 'blank lines';
|
||||
_out sprintf " %*s %s.\n", $width, $lines_of_comment, 'comment lines';
|
||||
_out sprintf " %*s %s.\n", $width, $lines_of_data, 'data lines';
|
||||
_out sprintf " %*s %s.\n", $width, $lines_of_perl, 'lines of Perl code';
|
||||
_out sprintf " %*s %s.\n", $width, $lines_of_pod, 'lines of POD';
|
||||
|
||||
my $average_sub_mccabe = $statistics->average_sub_mccabe();
|
||||
if (defined $average_sub_mccabe) {
|
||||
_out
|
||||
sprintf
|
||||
"\nAverage McCabe score of subroutines was %.2f.\n",
|
||||
$average_sub_mccabe;
|
||||
}
|
||||
|
||||
_out "\n";
|
||||
|
||||
_out _commaify($statistics->total_violations()), " violations.\n";
|
||||
|
||||
my $violations_per_file = $statistics->violations_per_file();
|
||||
if (defined $violations_per_file) {
|
||||
_out
|
||||
sprintf
|
||||
"Violations per file was %.3f.\n",
|
||||
$violations_per_file;
|
||||
}
|
||||
my $violations_per_statement = $statistics->violations_per_statement();
|
||||
if (defined $violations_per_statement) {
|
||||
_out
|
||||
sprintf
|
||||
"Violations per statement was %.3f.\n",
|
||||
$violations_per_statement;
|
||||
}
|
||||
my $violations_per_line = $statistics->violations_per_line_of_code();
|
||||
if (defined $violations_per_line) {
|
||||
_out
|
||||
sprintf
|
||||
"Violations per line of code was %.3f.\n",
|
||||
$violations_per_line;
|
||||
}
|
||||
|
||||
if ( $statistics->total_violations() ) {
|
||||
_out "\n";
|
||||
|
||||
my %severity_violations = %{ $statistics->violations_by_severity() };
|
||||
my @severities = reverse sort keys %severity_violations;
|
||||
$width =
|
||||
max
|
||||
map { length _commaify( $severity_violations{$_} ) }
|
||||
@severities;
|
||||
foreach my $severity (@severities) {
|
||||
_out
|
||||
sprintf
|
||||
"%*s severity %d violations.\n",
|
||||
$width,
|
||||
_commaify( $severity_violations{$severity} ),
|
||||
$severity;
|
||||
}
|
||||
|
||||
_out "\n";
|
||||
|
||||
my %policy_violations = %{ $statistics->violations_by_policy() };
|
||||
my @policies = sort keys %policy_violations;
|
||||
$width =
|
||||
max
|
||||
map { length _commaify( $policy_violations{$_} ) }
|
||||
@policies;
|
||||
foreach my $policy (@policies) {
|
||||
_out
|
||||
sprintf
|
||||
"%*s violations of %s.\n",
|
||||
$width,
|
||||
_commaify($policy_violations{$policy}),
|
||||
policy_short_name($policy);
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
# Only works for integers.
|
||||
sub _commaify {
|
||||
my ( $number ) = @_;
|
||||
|
||||
while ($number =~ s/ \A ( [-+]? \d+ ) ( \d{3} ) /$1,$2/xms) {
|
||||
# nothing
|
||||
}
|
||||
|
||||
return $number;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_option_specification {
|
||||
|
||||
return qw<
|
||||
5 4 3 2 1
|
||||
version
|
||||
brutal
|
||||
count|C
|
||||
cruel
|
||||
doc=s
|
||||
exclude=s@
|
||||
force!
|
||||
gentle
|
||||
harsh
|
||||
help|?|H
|
||||
include=s@
|
||||
list
|
||||
list-enabled
|
||||
list-themes
|
||||
man
|
||||
color|colour!
|
||||
noprofile
|
||||
only!
|
||||
options
|
||||
pager=s
|
||||
profile|p=s
|
||||
profile-proto
|
||||
quiet
|
||||
severity=i
|
||||
single-policy|s=s
|
||||
stern
|
||||
statistics!
|
||||
statistics-only!
|
||||
profile-strictness=s
|
||||
theme=s
|
||||
top:i
|
||||
allow-unsafe
|
||||
verbose=s
|
||||
color-severity-highest|colour-severity-highest|color-severity-5|colour-severity-5=s
|
||||
color-severity-high|colour-severity-high|color-severity-4|colour-severity-4=s
|
||||
color-severity-medium|colour-severity-medium|color-severity-3|colour-severity-3=s
|
||||
color-severity-low|colour-severity-low|color-severity-2|colour-severity-2=s
|
||||
color-severity-lowest|colour-severity-lowest|color-severity-1|colour-severity-1=s
|
||||
files-with-violations|l
|
||||
files-without-violations|L
|
||||
program-extensions=s@
|
||||
>;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _colorize_by_severity {
|
||||
my @violations = @_;
|
||||
return @violations if _this_is_windows() && !eval 'require Win32::Console::ANSI; 1';
|
||||
return @violations if not eval {
|
||||
require Term::ANSIColor;
|
||||
Term::ANSIColor->VERSION( $_MODULE_VERSION_TERM_ANSICOLOR );
|
||||
1;
|
||||
};
|
||||
|
||||
my $config = $critic->config();
|
||||
my %color_of = (
|
||||
$SEVERITY_HIGHEST => $config->color_severity_highest(),
|
||||
$SEVERITY_HIGH => $config->color_severity_high(),
|
||||
$SEVERITY_MEDIUM => $config->color_severity_medium(),
|
||||
$SEVERITY_LOW => $config->color_severity_low(),
|
||||
$SEVERITY_LOWEST => $config->color_severity_lowest(),
|
||||
);
|
||||
|
||||
return map { _colorize( "$_", $color_of{$_->severity()} ) } @violations;
|
||||
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _colorize {
|
||||
my ($string, $color) = @_;
|
||||
return $string if not defined $color;
|
||||
return $string if $color eq $EMPTY;
|
||||
# $terminator is a purely cosmetic change to make the color end at the end
|
||||
# of the line rather than right before the next line. It is here because
|
||||
# if you use background colors, some console windows display a little
|
||||
# fragment of colored background before the next uncolored (or
|
||||
# differently-colored) line.
|
||||
my $terminator = chomp $string ? "\n" : $EMPTY;
|
||||
return Term::ANSIColor::colored( $string, $color ) . $terminator;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _this_is_windows {
|
||||
return 1 if $OSNAME =~ m/MSWin32/xms;
|
||||
return 0;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _at_tty {
|
||||
return -t STDOUT; ## no critic (ProhibitInteractiveTest);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _render_all_policy_listing {
|
||||
# Force P-C parameters, to catch all Policies on this site
|
||||
my %pc_params = (-profile => $EMPTY, -severity => $SEVERITY_LOWEST);
|
||||
return _render_policy_listing( %pc_params );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _render_policy_listing {
|
||||
my %pc_params = @_;
|
||||
|
||||
require Perl::Critic::PolicyListing;
|
||||
require Perl::Critic;
|
||||
|
||||
my @policies = Perl::Critic->new( %pc_params )->policies();
|
||||
my $listing = Perl::Critic::PolicyListing->new( -policies => \@policies );
|
||||
_out $listing;
|
||||
|
||||
exit $EXIT_SUCCESS;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _render_theme_listing {
|
||||
|
||||
require Perl::Critic::ThemeListing;
|
||||
require Perl::Critic;
|
||||
|
||||
my %pc_params = (-profile => $EMPTY, -severity => $SEVERITY_LOWEST);
|
||||
my @policies = Perl::Critic->new( %pc_params )->policies();
|
||||
my $listing = Perl::Critic::ThemeListing->new( -policies => \@policies );
|
||||
_out $listing;
|
||||
|
||||
exit $EXIT_SUCCESS;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _render_profile_prototype {
|
||||
|
||||
require Perl::Critic::ProfilePrototype;
|
||||
require Perl::Critic;
|
||||
|
||||
my %pc_params = (-profile => $EMPTY, -severity => $SEVERITY_LOWEST);
|
||||
my @policies = Perl::Critic->new( %pc_params )->policies();
|
||||
my $prototype = Perl::Critic::ProfilePrototype->new( -policies => \@policies );
|
||||
_out $prototype;
|
||||
|
||||
exit $EXIT_SUCCESS;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _render_policy_docs {
|
||||
|
||||
my (%opts) = @_;
|
||||
my $pattern = delete $opts{-doc};
|
||||
|
||||
require Perl::Critic;
|
||||
$critic = Perl::Critic->new(%opts);
|
||||
_set_up_pager($critic->config()->pager());
|
||||
|
||||
require Perl::Critic::PolicyFactory;
|
||||
my @site_policies = Perl::Critic::PolicyFactory->site_policy_names();
|
||||
my @matching_policies = grep { /$pattern/ixms } @site_policies;
|
||||
|
||||
# "-T" means don't send to pager
|
||||
my @perldoc_output = map {`perldoc -T $_`} @matching_policies; ## no critic (ProhibitBacktick)
|
||||
_out @perldoc_output;
|
||||
|
||||
exit $EXIT_SUCCESS;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _display_version {
|
||||
_out "$VERSION\n";
|
||||
exit $EXIT_SUCCESS;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
Twitter
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Command - Guts of L<perlcritic|perlcritic>.
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Perl::Critic::Command qw< run >;
|
||||
|
||||
local @ARGV = qw< --statistics-only lib bin >;
|
||||
run();
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is the implementation of the L<perlcritic|perlcritic> command. You can use
|
||||
this to run the command without going through a command interpreter.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. However, its interface is
|
||||
experimental, and will likely change.
|
||||
|
||||
|
||||
=head1 IMPORTABLE SUBROUTINES
|
||||
|
||||
=over
|
||||
|
||||
=item C<run()>
|
||||
|
||||
Does the equivalent of the L<perlcritic|perlcritic> command. Unfortunately, at
|
||||
present, this doesn't take any parameters but uses C<@ARGV> to get its
|
||||
input instead. Count on this changing; don't count on the current
|
||||
interface.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 TO DO
|
||||
|
||||
Make C<run()> take parameters. The equivalent of C<@ARGV> should be
|
||||
passed as a reference.
|
||||
|
||||
Turn this into an object.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,882 @@
|
|||
package Perl::Critic::Document;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw< confess >;
|
||||
|
||||
use List::Util qw< reduce >;
|
||||
use Scalar::Util qw< blessed refaddr weaken >;
|
||||
use version;
|
||||
|
||||
use PPI::Document;
|
||||
use PPI::Document::File;
|
||||
use PPIx::Utilities::Node qw< split_ppi_node_by_namespace >;
|
||||
|
||||
use Perl::Critic::Annotation;
|
||||
use Perl::Critic::Exception::Parse qw< throw_parse >;
|
||||
use Perl::Critic::Utils qw< :booleans :characters shebang_line >;
|
||||
|
||||
use PPIx::Regexp 0.010 qw< >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
our $AUTOLOAD;
|
||||
sub AUTOLOAD { ## no critic (ProhibitAutoloading,ArgUnpacking)
|
||||
my ( $function_name ) = $AUTOLOAD =~ m/ ([^:\']+) \z /xms;
|
||||
return if $function_name eq 'DESTROY';
|
||||
my $self = shift;
|
||||
return $self->{_doc}->$function_name(@_);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub new {
|
||||
my ($class, @args) = @_;
|
||||
|
||||
my $self = bless {}, $class;
|
||||
|
||||
$self->_init_common();
|
||||
$self->_init_from_external_source(@args);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _new_for_parent_document {
|
||||
my ($class, $ppi_document, $parent_document) = @_;
|
||||
|
||||
my $self = bless {}, $class;
|
||||
|
||||
$self->_init_common();
|
||||
|
||||
$self->{_doc} = $ppi_document;
|
||||
$self->{_is_module} = $parent_document->is_module();
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _init_common {
|
||||
my ($self) = @_;
|
||||
|
||||
$self->{_annotations} = [];
|
||||
$self->{_suppressed_violations} = [];
|
||||
$self->{_disabled_line_map} = {};
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _init_from_external_source { ## no critic (Subroutines::RequireArgUnpacking)
|
||||
my $self = shift;
|
||||
my %args;
|
||||
|
||||
if (@_ == 1) {
|
||||
warnings::warnif(
|
||||
'deprecated',
|
||||
'Perl::Critic::Document->new($source) deprecated, use Perl::Critic::Document->new(-source => $source) instead.' ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
|
||||
);
|
||||
%args = ('-source' => shift);
|
||||
} else {
|
||||
%args = @_;
|
||||
}
|
||||
|
||||
my $source_code = $args{'-source'};
|
||||
|
||||
# $source_code can be a file name, or a reference to a
|
||||
# PPI::Document, or a reference to a scalar containing source
|
||||
# code. In the last case, PPI handles the translation for us.
|
||||
|
||||
my $ppi_document =
|
||||
_is_ppi_doc($source_code)
|
||||
? $source_code
|
||||
: ref $source_code
|
||||
? PPI::Document->new($source_code)
|
||||
: PPI::Document::File->new($source_code);
|
||||
|
||||
# Bail on error
|
||||
if (not defined $ppi_document) {
|
||||
my $errstr = PPI::Document::errstr();
|
||||
my $file = ref $source_code ? undef : $source_code;
|
||||
throw_parse
|
||||
message => qq<Can't parse code: $errstr>,
|
||||
file_name => $file;
|
||||
}
|
||||
|
||||
$self->{_doc} = $ppi_document;
|
||||
$self->index_locations();
|
||||
$self->_disable_shebang_fix();
|
||||
$self->{_filename_override} = $args{'-filename-override'};
|
||||
$self->{_is_module} = $self->_determine_is_module(\%args);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _is_ppi_doc {
|
||||
my ($ref) = @_;
|
||||
return blessed($ref) && $ref->isa('PPI::Document');
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub ppi_document {
|
||||
my ($self) = @_;
|
||||
return $self->{_doc};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub isa { ## no critic ( Subroutines::ProhibitBuiltinHomonyms )
|
||||
my ($self, @args) = @_;
|
||||
return $self->SUPER::isa(@args)
|
||||
|| ( (ref $self) && $self->{_doc} && $self->{_doc}->isa(@args) );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub find {
|
||||
my ($self, $wanted, @more_args) = @_;
|
||||
|
||||
# This method can only find elements by their class names. For
|
||||
# other types of searches, delegate to the PPI::Document
|
||||
if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
|
||||
return $self->{_doc}->find($wanted, @more_args);
|
||||
}
|
||||
|
||||
# Build the class cache if it doesn't exist. This happens at most
|
||||
# once per Perl::Critic::Document instance. %elements of will be
|
||||
# populated as a side-effect of calling the $finder_sub coderef
|
||||
# that is produced by the caching_finder() closure.
|
||||
if ( !$self->{_elements_of} ) {
|
||||
|
||||
my %cache = ( 'PPI::Document' => [ $self ] );
|
||||
|
||||
# The cache refers to $self, and $self refers to the cache. This
|
||||
# creates a circular reference that leaks memory (i.e. $self is not
|
||||
# destroyed until execution is complete). By weakening the reference,
|
||||
# we allow perl to collect the garbage properly.
|
||||
weaken( $cache{'PPI::Document'}->[0] );
|
||||
|
||||
my $finder_coderef = _caching_finder( \%cache );
|
||||
$self->{_doc}->find( $finder_coderef );
|
||||
$self->{_elements_of} = \%cache;
|
||||
}
|
||||
|
||||
# find() must return false-but-defined on fail
|
||||
return $self->{_elements_of}->{$wanted} || q{};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub find_first {
|
||||
my ($self, $wanted, @more_args) = @_;
|
||||
|
||||
# This method can only find elements by their class names. For
|
||||
# other types of searches, delegate to the PPI::Document
|
||||
if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
|
||||
return $self->{_doc}->find_first($wanted, @more_args);
|
||||
}
|
||||
|
||||
my $result = $self->find($wanted);
|
||||
return $result ? $result->[0] : $result;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub find_any {
|
||||
my ($self, $wanted, @more_args) = @_;
|
||||
|
||||
# This method can only find elements by their class names. For
|
||||
# other types of searches, delegate to the PPI::Document
|
||||
if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
|
||||
return $self->{_doc}->find_any($wanted, @more_args);
|
||||
}
|
||||
|
||||
my $result = $self->find($wanted);
|
||||
return $result ? 1 : $result;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub namespaces {
|
||||
my ($self) = @_;
|
||||
|
||||
return keys %{ $self->_nodes_by_namespace() };
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub subdocuments_for_namespace {
|
||||
my ($self, $namespace) = @_;
|
||||
|
||||
my $subdocuments = $self->_nodes_by_namespace()->{$namespace};
|
||||
|
||||
return $subdocuments ? @{$subdocuments} : ();
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub ppix_regexp_from_element {
|
||||
my ( $self, $element ) = @_;
|
||||
|
||||
if ( blessed( $element ) && $element->isa( 'PPI::Element' ) ) {
|
||||
my $addr = refaddr( $element );
|
||||
return $self->{_ppix_regexp_from_element}{$addr}
|
||||
if exists $self->{_ppix_regexp_from_element}{$addr};
|
||||
return ( $self->{_ppix_regexp_from_element}{$addr} =
|
||||
PPIx::Regexp->new( $element,
|
||||
default_modifiers =>
|
||||
$self->_find_use_re_modifiers_in_scope_from_element(
|
||||
$element ),
|
||||
) );
|
||||
} else {
|
||||
return PPIx::Regexp->new( $element );
|
||||
}
|
||||
}
|
||||
|
||||
sub _find_use_re_modifiers_in_scope_from_element {
|
||||
my ( $self, $elem ) = @_;
|
||||
my @found;
|
||||
foreach my $use_re ( @{ $self->find( 'PPI::Statement::Include' ) || [] } )
|
||||
{
|
||||
're' eq $use_re->module()
|
||||
or next;
|
||||
$self->element_is_in_lexical_scope_after_statement_containing(
|
||||
$elem, $use_re )
|
||||
or next;
|
||||
my $prefix = 'no' eq $use_re->type() ? q{-} : $EMPTY;
|
||||
push @found,
|
||||
map { "$prefix$_" }
|
||||
grep { m{ \A / }smx }
|
||||
map {
|
||||
$_->isa( 'PPI::Token::Quote' ) ? $_->string() :
|
||||
$_->isa( 'PPI::Token::QuoteLike::Words' ) ? $_->literal() :
|
||||
$_->content() }
|
||||
$use_re->schildren();
|
||||
}
|
||||
return \@found;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
# This got hung on the Perl::Critic::Document, rather than living in
|
||||
# Perl::Critic::Utils::PPI, because of the possibility that caching of scope
|
||||
# objects would turn out to be desirable.
|
||||
|
||||
sub element_is_in_lexical_scope_after_statement_containing {
|
||||
my ( $self, $inner_elem, $outer_elem ) = @_;
|
||||
|
||||
# If the outer element defines a scope, we're true if and only if
|
||||
# the outer element contains the inner element.
|
||||
$outer_elem->scope()
|
||||
and return $inner_elem->descendant_of( $outer_elem );
|
||||
|
||||
# In the more general case:
|
||||
|
||||
# The last element of the statement containing the outer element
|
||||
# must be before the inner element. If not, we know we're false,
|
||||
# without walking the parse tree.
|
||||
|
||||
my $stmt = $outer_elem->statement()
|
||||
or return;
|
||||
my $last_elem = $stmt->last_element()
|
||||
or return;
|
||||
|
||||
my $stmt_loc = $last_elem->location()
|
||||
or return;
|
||||
|
||||
my $inner_loc = $inner_elem->location()
|
||||
or return;
|
||||
|
||||
$stmt_loc->[0] > $inner_loc->[0]
|
||||
and return;
|
||||
$stmt_loc->[0] == $inner_loc->[0]
|
||||
and $stmt_loc->[1] > $inner_loc->[1]
|
||||
and return;
|
||||
|
||||
# Since we know the inner element is after the outer element, find
|
||||
# the element that defines the scope of the statement that contains
|
||||
# the outer element.
|
||||
|
||||
my $parent = $stmt;
|
||||
while ( ! $parent->scope() ) {
|
||||
$parent = $parent->parent()
|
||||
or return;
|
||||
}
|
||||
|
||||
# We're true if and only if the scope of the outer element contains
|
||||
# the inner element.
|
||||
|
||||
return $inner_elem->descendant_of( $parent );
|
||||
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub filename {
|
||||
my ($self) = @_;
|
||||
|
||||
if (defined $self->{_filename_override}) {
|
||||
return $self->{_filename_override};
|
||||
}
|
||||
else {
|
||||
my $doc = $self->{_doc};
|
||||
return $doc->can('filename') ? $doc->filename() : undef;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub highest_explicit_perl_version {
|
||||
my ($self) = @_;
|
||||
|
||||
my $highest_explicit_perl_version =
|
||||
$self->{_highest_explicit_perl_version};
|
||||
|
||||
if ( not exists $self->{_highest_explicit_perl_version} ) {
|
||||
my $includes = $self->find( \&_is_a_version_statement );
|
||||
|
||||
if ($includes) {
|
||||
# Note: this doesn't use List::Util::max() because that function
|
||||
# doesn't use the overloaded ">=" etc of a version object. The
|
||||
# reduce() style lets version.pm take care of all comparing.
|
||||
#
|
||||
# For reference, max() ends up looking at the string converted to
|
||||
# an NV, or something like that. An underscore like "5.005_04"
|
||||
# provokes a warning and is chopped off at "5.005" thus losing the
|
||||
# minor part from the comparison.
|
||||
#
|
||||
# An underscore "5.005_04" is supposed to mean an alpha release
|
||||
# and shouldn't be used in a perl version. But it's shown in
|
||||
# perlfunc under "use" (as a number separator), and appears in
|
||||
# several modules supplied with perl 5.10.0 (like version.pm
|
||||
# itself!). At any rate if version.pm can understand it then
|
||||
# that's enough for here.
|
||||
$highest_explicit_perl_version =
|
||||
reduce { $a >= $b ? $a : $b }
|
||||
map { version->new( $_->version() ) }
|
||||
@{$includes};
|
||||
}
|
||||
else {
|
||||
$highest_explicit_perl_version = undef;
|
||||
}
|
||||
|
||||
$self->{_highest_explicit_perl_version} =
|
||||
$highest_explicit_perl_version;
|
||||
}
|
||||
|
||||
return $highest_explicit_perl_version if $highest_explicit_perl_version;
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub uses_module {
|
||||
my ($self, $module_name) = @_;
|
||||
|
||||
return exists $self->_modules_used()->{$module_name};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub process_annotations {
|
||||
my ($self) = @_;
|
||||
|
||||
my @annotations = Perl::Critic::Annotation->create_annotations($self);
|
||||
$self->add_annotation(@annotations);
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub line_is_disabled_for_policy {
|
||||
my ($self, $line, $policy) = @_;
|
||||
my $policy_name = ref $policy || $policy;
|
||||
|
||||
# HACK: This Policy is special. If it is active, it cannot be
|
||||
# disabled by a "## no critic" annotation. Rather than create a general
|
||||
# hook in Policy.pm for enabling this behavior, we chose to hack
|
||||
# it here, since this isn't the kind of thing that most policies do
|
||||
|
||||
return 0 if $policy_name eq
|
||||
'Perl::Critic::Policy::Miscellanea::ProhibitUnrestrictedNoCritic';
|
||||
|
||||
return 1 if $self->{_disabled_line_map}->{$line}->{$policy_name};
|
||||
return 1 if $self->{_disabled_line_map}->{$line}->{ALL};
|
||||
return 0;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub add_annotation {
|
||||
my ($self, @annotations) = @_;
|
||||
|
||||
# Add annotation to our private map for quick lookup
|
||||
for my $annotation (@annotations) {
|
||||
|
||||
my ($start, $end) = $annotation->effective_range();
|
||||
my @affected_policies = $annotation->disables_all_policies ?
|
||||
qw(ALL) : $annotation->disabled_policies();
|
||||
|
||||
# TODO: Find clever way to do this with hash slices
|
||||
for my $line ($start .. $end) {
|
||||
for my $policy (@affected_policies) {
|
||||
$self->{_disabled_line_map}->{$line}->{$policy} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
push @{ $self->{_annotations} }, @annotations;
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub annotations {
|
||||
my ($self) = @_;
|
||||
return @{ $self->{_annotations} };
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub add_suppressed_violation {
|
||||
my ($self, $violation) = @_;
|
||||
push @{$self->{_suppressed_violations}}, $violation;
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub suppressed_violations {
|
||||
my ($self) = @_;
|
||||
return @{ $self->{_suppressed_violations} };
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub is_program {
|
||||
my ($self) = @_;
|
||||
|
||||
return not $self->is_module();
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub is_module {
|
||||
my ($self) = @_;
|
||||
|
||||
return $self->{_is_module};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# PRIVATE functions & methods
|
||||
|
||||
sub _is_a_version_statement {
|
||||
my (undef, $element) = @_;
|
||||
|
||||
return 0 if not $element->isa('PPI::Statement::Include');
|
||||
return 1 if $element->version();
|
||||
return 0;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _caching_finder {
|
||||
my $cache_ref = shift; # These vars will persist for the life
|
||||
my %isa_cache = (); # of the code ref that this sub returns
|
||||
|
||||
|
||||
# Gather up all the PPI elements and sort by @ISA. Note: if any
|
||||
# instances used multiple inheritance, this implementation would
|
||||
# lead to multiple copies of $element in the $elements_of lists.
|
||||
# However, PPI::* doesn't do multiple inheritance, so we are safe
|
||||
|
||||
return sub {
|
||||
my (undef, $element) = @_;
|
||||
my $classes = $isa_cache{ref $element};
|
||||
if ( !$classes ) {
|
||||
$classes = [ ref $element ];
|
||||
# Use a C-style loop because we append to the classes array inside
|
||||
for ( my $i = 0; $i < @{$classes}; $i++ ) { ## no critic(ProhibitCStyleForLoops)
|
||||
no strict 'refs'; ## no critic(ProhibitNoStrict)
|
||||
push @{$classes}, @{"$classes->[$i]::ISA"};
|
||||
$cache_ref->{$classes->[$i]} ||= [];
|
||||
}
|
||||
$isa_cache{$classes->[0]} = $classes;
|
||||
}
|
||||
|
||||
for my $class ( @{$classes} ) {
|
||||
push @{$cache_ref->{$class}}, $element;
|
||||
}
|
||||
|
||||
return 0; # 0 tells find() to keep traversing, but not to store this $element
|
||||
};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _disable_shebang_fix {
|
||||
my ($self) = @_;
|
||||
|
||||
# When you install a program using ExtUtils::MakeMaker or Module::Build, it
|
||||
# inserts some magical code into the top of the file (just after the
|
||||
# shebang). This code allows people to call your program using a shell,
|
||||
# like `sh my_script`. Unfortunately, this code causes several Policy
|
||||
# violations, so we disable them as if they had "## no critic" annotations.
|
||||
|
||||
my $first_stmnt = $self->schild(0) || return;
|
||||
|
||||
# Different versions of MakeMaker and Build use slightly different shebang
|
||||
# fixing strings. This matches most of the ones I've found in my own Perl
|
||||
# distribution, but it may not be bullet-proof.
|
||||
|
||||
my $fixin_rx = qr<^eval 'exec .* \$0 \$[{]1[+]"\$@"}'\s*[\r\n]\s*if.+;>ms; ## no critic (ExtendedFormatting)
|
||||
if ( $first_stmnt =~ $fixin_rx ) {
|
||||
my $line = $first_stmnt->location->[0];
|
||||
$self->{_disabled_line_map}->{$line}->{ALL} = 1;
|
||||
$self->{_disabled_line_map}->{$line + 1}->{ALL} = 1;
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _determine_is_module {
|
||||
my ($self, $args) = @_;
|
||||
|
||||
my $file_name = $self->filename();
|
||||
if (
|
||||
defined $file_name
|
||||
and ref $args->{'-program-extensions'} eq 'ARRAY'
|
||||
) {
|
||||
foreach my $ext ( @{ $args->{'-program-extensions'} } ) {
|
||||
my $regex =
|
||||
ref $ext eq 'Regexp'
|
||||
? $ext
|
||||
: qr< @{ [ quotemeta $ext ] } \z >xms;
|
||||
|
||||
return $FALSE if $file_name =~ m/$regex/smx;
|
||||
}
|
||||
}
|
||||
|
||||
return $FALSE if shebang_line($self);
|
||||
return $FALSE if defined $file_name && $file_name =~ m/ [.] PL \z /smx;
|
||||
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _nodes_by_namespace {
|
||||
my ($self) = @_;
|
||||
|
||||
my $nodes = $self->{_nodes_by_namespace};
|
||||
|
||||
return $nodes if $nodes;
|
||||
|
||||
my $ppi_document = $self->ppi_document();
|
||||
if (not $ppi_document) {
|
||||
return $self->{_nodes_by_namespace} = {};
|
||||
}
|
||||
|
||||
my $raw_nodes_map = split_ppi_node_by_namespace($ppi_document);
|
||||
|
||||
my %wrapped_nodes;
|
||||
while ( my ($namespace, $raw_nodes) = each %{$raw_nodes_map} ) {
|
||||
$wrapped_nodes{$namespace} = [
|
||||
map { __PACKAGE__->_new_for_parent_document($_, $self) }
|
||||
@{$raw_nodes}
|
||||
];
|
||||
}
|
||||
|
||||
return $self->{_nodes_by_namespace} = \%wrapped_nodes;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
# Note: must use exists on return value to determine membership because all
|
||||
# the values are false, unlike the result of hashify().
|
||||
sub _modules_used {
|
||||
my ($self) = @_;
|
||||
|
||||
my $mapping = $self->{_modules_used};
|
||||
|
||||
return $mapping if $mapping;
|
||||
|
||||
my $includes = $self->find('PPI::Statement::Include');
|
||||
if (not $includes) {
|
||||
return $self->{_modules_used} = {};
|
||||
}
|
||||
|
||||
my %mapping;
|
||||
for my $module (
|
||||
grep { $_ } map { $_->module() || $_->pragma() } @{$includes}
|
||||
) {
|
||||
# Significanly ess memory than $h{$k} => 1. Thanks Mr. Lembark.
|
||||
$mapping{$module} = ();
|
||||
}
|
||||
|
||||
return $self->{_modules_used} = \%mapping;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords pre-caches
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Document - Caching wrapper around a PPI::Document.
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use PPI::Document;
|
||||
use Perl::Critic::Document;
|
||||
my $doc = PPI::Document->new('Foo.pm');
|
||||
$doc = Perl::Critic::Document->new(-source => $doc);
|
||||
## Then use the instance just like a PPI::Document
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Perl::Critic does a lot of iterations over the PPI document tree via
|
||||
the C<PPI::Document::find()> method. To save some time, this class
|
||||
pre-caches a lot of the common C<find()> calls in a single traversal.
|
||||
Then, on subsequent requests we return the cached data.
|
||||
|
||||
This is implemented as a facade, where method calls are handed to the
|
||||
stored C<PPI::Document> instance.
|
||||
|
||||
|
||||
=head1 CAVEATS
|
||||
|
||||
This facade does not implement the overloaded operators from
|
||||
L<PPI::Document|PPI::Document> (that is, the C<use overload ...>
|
||||
work). Therefore, users of this facade must not rely on that syntactic
|
||||
sugar. So, for example, instead of C<my $source = "$doc";> you should
|
||||
write C<< my $source = $doc->content(); >>
|
||||
|
||||
Perhaps there is a CPAN module out there which implements a facade
|
||||
better than we do here?
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 CONSTRUCTOR
|
||||
|
||||
=over
|
||||
|
||||
=item C<< new(-source => $source_code, '-filename-override' => $filename, '-program-extensions' => [program_extensions]) >>
|
||||
|
||||
Create a new instance referencing a PPI::Document instance. The
|
||||
C<$source_code> can be the name of a file, a reference to a scalar
|
||||
containing actual source code, or a L<PPI::Document|PPI::Document> or
|
||||
L<PPI::Document::File|PPI::Document::File>.
|
||||
|
||||
In the event that C<$source_code> is a reference to a scalar containing actual
|
||||
source code or a L<PPI::Document|PPI::Document>, the resulting
|
||||
L<Perl::Critic::Document|Perl::Critic::Document> will not have a filename.
|
||||
This may cause L<Perl::Critic::Document|Perl::Critic::Document> to incorrectly
|
||||
classify the source code as a module or script. To avoid this problem, you
|
||||
can optionally set the C<-filename-override> to force the
|
||||
L<Perl::Critic::Document|Perl::Critic::Document> to have a particular
|
||||
C<$filename>. Do not use this option if C<$source_code> is already the name
|
||||
of a file, or is a reference to a L<PPI::Document::File|PPI::Document::File>.
|
||||
|
||||
The '-program-extensions' argument is optional, and is a reference to a list
|
||||
of strings and/or regular expressions. The strings will be made into regular
|
||||
expressions matching the end of a file name, and any document whose file name
|
||||
matches one of the regular expressions will be considered a program.
|
||||
|
||||
If -program-extensions is not specified, or if it does not determine the
|
||||
document type, the document will be considered to be a program if the source
|
||||
has a shebang line or its file name (if any) matches C<< m/ [.] PL \z /smx >>.
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<< ppi_document() >>
|
||||
|
||||
Accessor for the wrapped PPI::Document instance. Note that altering
|
||||
this instance in any way can cause unpredictable failures in
|
||||
Perl::Critic's subsequent analysis because some caches may fall out of
|
||||
date.
|
||||
|
||||
|
||||
=item C<< find($wanted) >>
|
||||
|
||||
=item C<< find_first($wanted) >>
|
||||
|
||||
=item C<< find_any($wanted) >>
|
||||
|
||||
Caching wrappers around the PPI methods. If C<$wanted> is a simple PPI class
|
||||
name, then the cache is employed. Otherwise we forward the call to the
|
||||
corresponding method of the C<PPI::Document> instance.
|
||||
|
||||
|
||||
=item C<< namespaces() >>
|
||||
|
||||
Returns a list of the namespaces (package names) in the document.
|
||||
|
||||
|
||||
=item C<< subdocuments_for_namespace($namespace) >>
|
||||
|
||||
Returns a list of sub-documents containing the elements in the given
|
||||
namespace. For example, given that the current document is for the source
|
||||
|
||||
foo();
|
||||
package Foo;
|
||||
package Bar;
|
||||
package Foo;
|
||||
|
||||
this method will return two L<Perl::Critic::Document|Perl::Critic::Document>s
|
||||
for a parameter of C<"Foo">. For more, see
|
||||
L<PPIx::Utilities::Node/split_ppi_node_by_namespace>.
|
||||
|
||||
|
||||
=item C<< ppix_regexp_from_element($element) >>
|
||||
|
||||
Caching wrapper around C<< PPIx::Regexp->new($element) >>. If
|
||||
C<$element> is a C<PPI::Element> the cache is employed, otherwise it
|
||||
just returns the results of C<< PPIx::Regexp->new() >>. In either case,
|
||||
it returns C<undef> unless the argument is something that
|
||||
L<PPIx::Regexp|PPIx::Regexp> actually understands.
|
||||
|
||||
=item C<< element_is_in_lexical_scope_after_statement_containing( $inner, $outer ) >>
|
||||
|
||||
Is the C<$inner> element in lexical scope after the statement containing
|
||||
the C<$outer> element?
|
||||
|
||||
In the case where C<$outer> is itself a scope-defining element, returns true
|
||||
if C<$outer> contains C<$inner>. In any other case, C<$inner> must be
|
||||
after the last element of the statement containing C<$outer>, and the
|
||||
innermost scope for C<$outer> also contains C<$inner>.
|
||||
|
||||
This is not the same as asking whether C<$inner> is visible from
|
||||
C<$outer>.
|
||||
|
||||
|
||||
=item C<< filename() >>
|
||||
|
||||
Returns the filename for the source code if applicable
|
||||
(PPI::Document::File) or C<undef> otherwise (PPI::Document).
|
||||
|
||||
|
||||
=item C<< isa( $classname ) >>
|
||||
|
||||
To be compatible with other modules that expect to get a
|
||||
PPI::Document, the Perl::Critic::Document class masquerades as the
|
||||
PPI::Document class.
|
||||
|
||||
|
||||
=item C<< highest_explicit_perl_version() >>
|
||||
|
||||
Returns a L<version|version> object for the highest Perl version
|
||||
requirement declared in the document via a C<use> or C<require>
|
||||
statement. Returns nothing if there is no version statement.
|
||||
|
||||
|
||||
=item C<< uses_module($module_or_pragma_name) >>
|
||||
|
||||
Answers whether there is a C<use>, C<require>, or C<no> of the given name in
|
||||
this document. Note that there is no differentiation of modules vs. pragmata
|
||||
here.
|
||||
|
||||
|
||||
=item C<< process_annotations() >>
|
||||
|
||||
Causes this Document to scan itself and mark which lines &
|
||||
policies are disabled by the C<"## no critic"> annotations.
|
||||
|
||||
|
||||
=item C<< line_is_disabled_for_policy($line, $policy_object) >>
|
||||
|
||||
Returns true if the given C<$policy_object> or C<$policy_name> has
|
||||
been disabled for at C<$line> in this Document. Otherwise, returns false.
|
||||
|
||||
|
||||
=item C<< add_annotation( $annotation ) >>
|
||||
|
||||
Adds an C<$annotation> object to this Document.
|
||||
|
||||
|
||||
=item C<< annotations() >>
|
||||
|
||||
Returns a list containing all the
|
||||
L<Perl::Critic::Annotation|Perl::Critic::Annotation>s that
|
||||
were found in this Document.
|
||||
|
||||
|
||||
=item C<< add_suppressed_violation($violation) >>
|
||||
|
||||
Informs this Document that a C<$violation> was found but not reported
|
||||
because it fell on a line that had been suppressed by a C<"## no critic">
|
||||
annotation. Returns C<$self>.
|
||||
|
||||
|
||||
=item C<< suppressed_violations() >>
|
||||
|
||||
Returns a list of references to all the
|
||||
L<Perl::Critic::Violation|Perl::Critic::Violation>s
|
||||
that were found in this Document but were suppressed.
|
||||
|
||||
|
||||
=item C<< is_program() >>
|
||||
|
||||
Returns whether this document is considered to be a program.
|
||||
|
||||
|
||||
=item C<< is_module() >>
|
||||
|
||||
Returns whether this document is considered to be a Perl module.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,96 @@
|
|||
package Perl::Critic::Exception;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception' => {
|
||||
isa => 'Exception::Class::Base',
|
||||
description => 'A problem discovered by Perl::Critic.',
|
||||
},
|
||||
);
|
||||
|
||||
use Exporter 'import';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub short_class_name {
|
||||
my ( $self ) = @_;
|
||||
|
||||
return substr ref $self, (length 'Perl::Critic') + 2;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception - A problem identified by L<Perl::Critic|Perl::Critic>.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A base class for all problems discovered by
|
||||
L<Perl::Critic|Perl::Critic>. This exists to enable differentiating
|
||||
exceptions from L<Perl::Critic|Perl::Critic> code from those
|
||||
originating in other modules.
|
||||
|
||||
This is an abstract class. It should never be instantiated.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<short_class_name()>
|
||||
|
||||
Retrieve the name of the class of this object with C<'Perl::Critic::'>
|
||||
stripped off.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,202 @@
|
|||
package Perl::Critic::Exception::AggregateConfiguration;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw{ confess };
|
||||
use English qw(-no_match_vars);
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :characters };
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::AggregateConfiguration' => {
|
||||
isa => 'Perl::Critic::Exception',
|
||||
description => 'A collected set of configuration exceptions.',
|
||||
fields => [ qw{ exceptions } ],
|
||||
alias => 'throw_aggregate',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_aggregate >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub new {
|
||||
my ($class, %options) = @_;
|
||||
|
||||
my $exceptions = $options{exceptions};
|
||||
if (not $exceptions) {
|
||||
$options{exceptions} = [];
|
||||
}
|
||||
|
||||
return $class->SUPER::new(%options);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub add_exception {
|
||||
my ( $self, $exception ) = @_;
|
||||
|
||||
push @{ $self->exceptions() }, $exception;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub add_exceptions_from {
|
||||
my ( $self, $aggregate ) = @_;
|
||||
|
||||
push @{ $self->exceptions() }, @{ $aggregate->exceptions() };
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub add_exception_or_rethrow {
|
||||
my ( $self, $eval_error ) = @_;
|
||||
|
||||
return if not $eval_error;
|
||||
confess $eval_error if not ref $eval_error;
|
||||
|
||||
if ( $eval_error->isa('Perl::Critic::Exception::Configuration') ) {
|
||||
$self->add_exception($eval_error);
|
||||
}
|
||||
elsif (
|
||||
$eval_error->isa('Perl::Critic::Exception::AggregateConfiguration')
|
||||
) {
|
||||
$self->add_exceptions_from($eval_error);
|
||||
}
|
||||
else {
|
||||
die $eval_error; ## no critic (RequireCarping)
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub has_exceptions {
|
||||
my ( $self ) = @_;
|
||||
|
||||
return @{ $self->exceptions() } ? 1 : 0;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $MESSAGE_PREFIX => $EMPTY;
|
||||
Readonly::Scalar my $MESSAGE_SUFFIX => "\n";
|
||||
Readonly::Scalar my $MESSAGE_SEPARATOR => $MESSAGE_SUFFIX . $MESSAGE_PREFIX;
|
||||
|
||||
sub full_message {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $message = $MESSAGE_PREFIX;
|
||||
$message .= join $MESSAGE_SEPARATOR, @{ $self->exceptions() };
|
||||
$message .= $MESSAGE_SUFFIX;
|
||||
|
||||
return $message;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::AggregateConfiguration - A collection of a set of problems found in the configuration and/or command-line options.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A set of configuration settings can have multiple problems. This is
|
||||
an object for collecting all the problems found so that the user can
|
||||
see them in one run.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<add_exception( $exception )>
|
||||
|
||||
Accumulate the parameter with rest of the exceptions.
|
||||
|
||||
|
||||
=item C<add_exceptions_from( $aggregate )>
|
||||
|
||||
Accumulate the exceptions from another instance of this class.
|
||||
|
||||
|
||||
=item C<exceptions()>
|
||||
|
||||
Returns a reference to an array of the collected exceptions.
|
||||
|
||||
|
||||
=item C<add_exception_or_rethrow( $eval_error )>
|
||||
|
||||
If the parameter is an instance of
|
||||
L<Perl::Critic::Exception::Configuration|Perl::Critic::Exception::Configuration>
|
||||
or
|
||||
L<Perl::Critic::Exception::AggregateConfiguration|Perl::Critic::Exception::AggregateConfiguration>,
|
||||
add it. Otherwise, C<die> with the parameter, if it is a reference,
|
||||
or C<confess> with it. If the parameter is false, simply returns.
|
||||
|
||||
|
||||
=item C<has_exceptions()>
|
||||
|
||||
Answer whether any configuration problems have been found.
|
||||
|
||||
|
||||
=item C<full_message()>
|
||||
|
||||
Concatenate the exception messages. See
|
||||
L<Exception::Class/"full_message">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,89 @@
|
|||
package Perl::Critic::Exception::Configuration;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Configuration' => {
|
||||
isa => 'Perl::Critic::Exception',
|
||||
description => 'A problem with Perl::Critic configuration, whether from a file or a command line or some other source.',
|
||||
fields => [ qw{ source } ],
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Configuration - A problem with L<Perl::Critic|Perl::Critic> configuration.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of a problem found with the configuration of
|
||||
L<Perl::Critic|Perl::Critic>, whether from a F<.perlcriticrc>, another profile
|
||||
file, or command line.
|
||||
|
||||
This is an abstract class. It should never be instantiated.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<source()>
|
||||
|
||||
Where the configuration information came from, if it could be determined.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Exception::Configuration::Generic|Perl::Critic::Exception::Configuration::Generic>
|
||||
L<Perl::Critic::Exception::Configuration::Option|Perl::Critic::Exception::Configuration::Option>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,95 @@
|
|||
package Perl::Critic::Exception::Configuration::Generic;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Configuration::Generic' => {
|
||||
isa => 'Perl::Critic::Exception::Configuration',
|
||||
description =>
|
||||
q{A problem with Perl::Critic configuration that isn't related to an option.},
|
||||
alias => 'throw_generic',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_generic >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Configuration::Generic - A problem with L<Perl::Critic|Perl::Critic> configuration that doesn't involve an option.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of a problem found with the configuration of
|
||||
L<Perl::Critic|Perl::Critic>, whether from a F<.perlcriticrc>, another
|
||||
profile file, or command line.
|
||||
|
||||
This covers things like file reading and parsing errors.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<< throw( message => $message, source => $source ) >>
|
||||
|
||||
See L<Exception::Class/"throw">.
|
||||
|
||||
|
||||
=item C<< new( message => $message, source => $source ) >>
|
||||
|
||||
See L<Exception::Class/"new">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,113 @@
|
|||
package Perl::Critic::Exception::Configuration::NonExistentPolicy;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Configuration::NonExistentPolicy' => {
|
||||
isa => 'Perl::Critic::Exception::Configuration',
|
||||
description => 'The configuration referred to a non-existant policy.',
|
||||
fields => [ qw{ policy } ],
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_extra_parameter >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub full_message {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $policy = $self->policy();
|
||||
|
||||
return qq<There is no $policy policy installed.>;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Configuration::NonExistentPolicy - The configuration referred to a non-existent policy.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of the configuration attempting to specify a
|
||||
L<Perl::Critic::Policy|Perl::Critic::Policy> that is not known, whether from a
|
||||
F<.perlcriticrc>, another profile file, or command line.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<< throw( policy => $policy ) >>
|
||||
|
||||
See L<Exception::Class/"throw">.
|
||||
|
||||
|
||||
=item C<< new( policy => $policy ) >>
|
||||
|
||||
See L<Exception::Class/"new">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<full_message()>
|
||||
|
||||
Provide a standard message. See L<Exception::Class/"full_message">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,141 @@
|
|||
package Perl::Critic::Exception::Configuration::Option;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Perl::Critic::Exception::Fatal::Internal;
|
||||
|
||||
use Exception::Class ( # this must come after "use P::C::Exception::*"
|
||||
'Perl::Critic::Exception::Configuration::Option' => {
|
||||
isa => 'Perl::Critic::Exception::Configuration',
|
||||
description => 'A problem with an option in the Perl::Critic configuration, whether from a file or a command line or some other source.',
|
||||
fields => [ qw{ option_name option_value message_suffix } ],
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub message {
|
||||
my $self = shift;
|
||||
|
||||
return $self->full_message();
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub error {
|
||||
my $self = shift;
|
||||
|
||||
return $self->full_message();
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
## no critic (Subroutines::RequireFinalReturn)
|
||||
sub full_message {
|
||||
Perl::Critic::Exception::Fatal::Internal->throw(
|
||||
'Subclass failed to override abstract method.'
|
||||
);
|
||||
}
|
||||
## use critic
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Configuration::Option - A problem with an option in the L<Perl::Critic|Perl::Critic> configuration.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of a problem found with an option in the
|
||||
configuration of L<Perl::Critic|Perl::Critic>, whether from a
|
||||
F<.perlcriticrc>, another profile file, or command line.
|
||||
|
||||
This is an abstract class. It should never be instantiated.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<option_name()>
|
||||
|
||||
The name of the option that was found to be in error.
|
||||
|
||||
|
||||
=item C<option_value()>
|
||||
|
||||
The value of the option that was found to be in error.
|
||||
|
||||
|
||||
=item C<message_suffix()>
|
||||
|
||||
Any text that should be applied to end of the standard message for
|
||||
this kind of exception.
|
||||
|
||||
|
||||
=item C<message()>
|
||||
|
||||
=item C<error()>
|
||||
|
||||
Overridden to call C<full_message()>. I.e. any message string in the
|
||||
superclass is ignored.
|
||||
|
||||
|
||||
=item C<full_message()>
|
||||
|
||||
Overridden to turn it into an abstract method to force subclasses to
|
||||
implement it.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Exception::Configuration::Option::Global|Perl::Critic::Exception::Configuration::Option::Global>
|
||||
L<Perl::Critic::Exception::Configuration::Option::Policy|Perl::Critic::Exception::Configuration::Option::Policy>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
package Perl::Critic::Exception::Configuration::Option::Global;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Configuration::Option::Global' => {
|
||||
isa => 'Perl::Critic::Exception::Configuration::Option',
|
||||
description => 'A problem with global Perl::Critic configuration.',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Configuration::Option::Global - A problem with L<Perl::Critic|Perl::Critic> global configuration.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of a problem found with the global configuration of
|
||||
L<Perl::Critic|Perl::Critic>, whether from a F<.perlcriticrc>, another
|
||||
profile file, or command line.
|
||||
|
||||
This is an abstract class. It should never be instantiated.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,122 @@
|
|||
package Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter' => {
|
||||
isa => 'Perl::Critic::Exception::Configuration::Option::Global',
|
||||
description => 'The configuration referred to a non-existant global option.',
|
||||
alias => 'throw_extra_global',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_extra_global >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub full_message {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $source = $self->source();
|
||||
if ($source) {
|
||||
$source = qq{ (found in "$source")};
|
||||
}
|
||||
else {
|
||||
$source = q{};
|
||||
}
|
||||
|
||||
my $option_name = $self->option_name();
|
||||
|
||||
return qq{"$option_name" is not a supported option$source.};
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter - The configuration referred to a non-existent global option.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of the configuration attempting to specify a value
|
||||
for an option that L<Perl::Critic|Perl::Critic> doesn't have, whether
|
||||
from a F<.perlcriticrc>, another profile file, or command line.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<< throw( option_name => $option_name, source => $source ) >>
|
||||
|
||||
See L<Exception::Class/"throw">.
|
||||
|
||||
|
||||
=item C<< new( option_name => $option_name, source => $source ) >>
|
||||
|
||||
See L<Exception::Class/"new">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<full_message()>
|
||||
|
||||
Provide a standard message for values for non-existent parameters for
|
||||
policies. See L<Exception::Class/"full_message">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,131 @@
|
|||
package Perl::Critic::Exception::Configuration::Option::Global::ParameterValue;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :characters };
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Configuration::Option::Global::ParameterValue' => {
|
||||
isa => 'Perl::Critic::Exception::Configuration::Option::Global',
|
||||
description => 'A problem with the value of a global parameter.',
|
||||
alias => 'throw_global_value',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_global_value >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub full_message {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $source = $self->source();
|
||||
if ($source) {
|
||||
$source = qq{ found in "$source"};
|
||||
}
|
||||
else {
|
||||
$source = $EMPTY;
|
||||
}
|
||||
|
||||
my $option_name = $self->option_name();
|
||||
my $option_value =
|
||||
defined $self->option_value()
|
||||
? $DQUOTE . $self->option_value() . $DQUOTE
|
||||
: '<undef>';
|
||||
my $message_suffix = $self->message_suffix() || $EMPTY;
|
||||
|
||||
return
|
||||
qq{The value for the global "$option_name" option }
|
||||
. qq{($option_value)$source $message_suffix};
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Configuration::Option::Global::ParameterValue - A problem with the value of a global parameter.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of a problem found with the value of a global
|
||||
parameter, whether from a F<.perlcriticrc>, another profile file, or
|
||||
command line.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<< throw( option_name => $option_name, option_value => $option_value, source => $source, message_suffix => $message_suffix ) >>
|
||||
|
||||
See L<Exception::Class/"throw">.
|
||||
|
||||
|
||||
=item C<< new( option_name => $option_name, option_value => $option_value, source => $source, message_suffix => $message_suffix ) >>
|
||||
|
||||
See L<Exception::Class/"new">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<full_message()>
|
||||
|
||||
Provide a standard message for global configuration problems. See
|
||||
L<Exception::Class/"full_message">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
package Perl::Critic::Exception::Configuration::Option::Policy;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Perl::Critic::Utils qw{ &policy_short_name };
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Configuration::Option::Policy' => {
|
||||
isa => 'Perl::Critic::Exception::Configuration::Option',
|
||||
description => 'A problem with the configuration of a policy.',
|
||||
fields => [ qw{ policy } ],
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub new {
|
||||
my ($class, %options) = @_;
|
||||
|
||||
my $policy = $options{policy};
|
||||
if ($policy) {
|
||||
$options{policy} = policy_short_name($policy);
|
||||
}
|
||||
|
||||
return $class->SUPER::new(%options);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Configuration::Option::Policy - A problem with configuration of a policy.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of a problem found with the configuration of a
|
||||
L<Perl::Critic::Policy|Perl::Critic::Policy>, whether from a
|
||||
F<.perlcriticrc>, another profile file, or command line.
|
||||
|
||||
This is an abstract class. It should never be instantiated.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<policy()>
|
||||
|
||||
The short name of the policy that had configuration problems.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,125 @@
|
|||
package Perl::Critic::Exception::Configuration::Option::Policy::ExtraParameter;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Configuration::Option::Policy::ExtraParameter' => {
|
||||
isa => 'Perl::Critic::Exception::Configuration::Option::Policy',
|
||||
description => 'The configuration of a policy referred to a non-existant parameter.',
|
||||
alias => 'throw_extra_parameter',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_extra_parameter >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub full_message {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $source = $self->source();
|
||||
if ($source) {
|
||||
$source = qq{ (found in "$source")};
|
||||
}
|
||||
else {
|
||||
$source = q{};
|
||||
}
|
||||
|
||||
my $policy = $self->policy();
|
||||
my $option_name = $self->option_name();
|
||||
|
||||
return
|
||||
qq{The $policy policy doesn't take a "$option_name" option$source.};
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Configuration::Option::Policy::ExtraParameter - The configuration referred to a non-existent parameter for a policy.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of the configuration attempting to specify a value
|
||||
for a parameter that a L<Perl::Critic::Policy|Perl::Critic::Policy>
|
||||
doesn't have, whether from a F<.perlcriticrc>, another profile file,
|
||||
or command line.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<< throw( policy => $policy, option_name => $option_name, source => $source ) >>
|
||||
|
||||
See L<Exception::Class/"throw">.
|
||||
|
||||
|
||||
=item C<< new( policy => $policy, option_name => $option_name, source => $source ) >>
|
||||
|
||||
See L<Exception::Class/"new">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<full_message()>
|
||||
|
||||
Provide a standard message for values for non-existent parameters for
|
||||
policies. See L<Exception::Class/"full_message">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,132 @@
|
|||
package Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :characters };
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue' => {
|
||||
isa => 'Perl::Critic::Exception::Configuration::Option::Policy',
|
||||
description => 'A problem with the value of a parameter for a policy.',
|
||||
alias => 'throw_policy_value',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_policy_value >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub full_message {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $source = $self->source();
|
||||
if ($source) {
|
||||
$source = qq{ found in "$source"};
|
||||
}
|
||||
else {
|
||||
$source = $EMPTY;
|
||||
}
|
||||
|
||||
my $policy = $self->policy();
|
||||
my $option_name = $self->option_name();
|
||||
my $option_value =
|
||||
defined $self->option_value()
|
||||
? $DQUOTE . $self->option_value() . $DQUOTE
|
||||
: '<undef>';
|
||||
my $message_suffix = $self->message_suffix() || $EMPTY;
|
||||
|
||||
return
|
||||
qq{The value for the $policy "$option_name" option }
|
||||
. qq{($option_value)$source $message_suffix};
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue - A problem with the value of a parameter for a policy.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of a problem found with the value of a parameter for
|
||||
a L<Perl::Critic::Policy|Perl::Critic::Policy>, whether from a
|
||||
F<.perlcriticrc>, another profile file, or command line.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<< throw( policy => $policy, option_name => $option_name, option_value => $option_value, source => $source, message_suffix => $message_suffix ) >>
|
||||
|
||||
See L<Exception::Class/"throw">.
|
||||
|
||||
|
||||
=item C<< new( policy => $policy, option_name => $option_name, option_value => $option_value, source => $source, message_suffix => $message_suffix ) >>
|
||||
|
||||
See L<Exception::Class/"new">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<full_message()>
|
||||
|
||||
Provide a standard message for policy parameter value problems. See
|
||||
L<Exception::Class/"full_message">.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,112 @@
|
|||
package Perl::Critic::Exception::Fatal;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Fatal' => {
|
||||
isa => 'Perl::Critic::Exception',
|
||||
description =>
|
||||
'A problem that should cause Perl::Critic to stop running.',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub new {
|
||||
my ($class, @args) = @_;
|
||||
my $self = $class->SUPER::new(@args);
|
||||
|
||||
$self->show_trace(1);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub full_message {
|
||||
my ( $self ) = @_;
|
||||
|
||||
return
|
||||
$self->short_class_name()
|
||||
. q{: }
|
||||
. $self->description()
|
||||
. "\n\n"
|
||||
. $self->message()
|
||||
. "\n\n"
|
||||
. gmtime $self->time()
|
||||
. "\n\n";
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Fatal - A problem that should cause L<Perl::Critic|Perl::Critic> to stop running.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Something went wrong and processing should not continue. You should
|
||||
never specifically look for this exception or one of its subclasses.
|
||||
|
||||
Note: the constructor invokes L<Exception::Class/"show_trace"> to
|
||||
force stack-traces to be included in the standard stringification.
|
||||
|
||||
This is an abstract class. It should never be instantiated.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<full_message()>
|
||||
|
||||
Overrides L<Exception::Class/"full_message"> to include extra
|
||||
information.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
package Perl::Critic::Exception::Fatal::Generic;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Fatal::Generic' => {
|
||||
isa => 'Perl::Critic::Exception::Fatal',
|
||||
description => 'A general problem was found.',
|
||||
alias => 'throw_generic',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_generic >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Fatal::Generic - A problem for which there is no specialized information.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A general problem, e.g. I/O errors and problems that may or not be bugs.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
Only inherited ones.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,80 @@
|
|||
package Perl::Critic::Exception::Fatal::Internal;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Fatal::Internal' => {
|
||||
isa => 'Perl::Critic::Exception::Fatal',
|
||||
description => 'A problem with the Perl::Critic code was found, a.k.a. a bug.',
|
||||
alias => 'throw_internal',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_internal >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Fatal::Internal - A problem with the L<Perl::Critic|Perl::Critic> implementation, i.e. a bug.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A representation of a bug found in the code of
|
||||
L<Perl::Critic|Perl::Critic>.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
Only inherited ones.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,80 @@
|
|||
package Perl::Critic::Exception::Fatal::PolicyDefinition;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Fatal::PolicyDefinition' => {
|
||||
isa => 'Perl::Critic::Exception::Fatal',
|
||||
description => 'A bug in a policy was found.',
|
||||
alias => 'throw_policy_definition',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_policy_definition >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Fatal::PolicyDefinition - A bug in a policy.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A bug in a policy was found, e.g. it didn't implement a method that it should
|
||||
have.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
Only inherited ones.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,96 @@
|
|||
package Perl::Critic::Exception::IO;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw{ confess };
|
||||
use English qw(-no_match_vars);
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :characters };
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::IO' => {
|
||||
isa => 'Perl::Critic::Exception',
|
||||
description => 'An input/output problem.',
|
||||
fields => [ qw< file_name errno > ],
|
||||
alias => 'throw_io',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_io >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::IO - A problem with input or output.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The outside world can do nasty things to your poor, innocent code.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<file_name()>
|
||||
|
||||
Returns the name of the file that the problem was found with, if available.
|
||||
|
||||
|
||||
=item C<errno()>
|
||||
|
||||
The value of C<$ERRNO>/C<$!> at the time the problem was found.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,91 @@
|
|||
package Perl::Critic::Exception::Parse;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use English qw< -no_match_vars >;
|
||||
use Carp qw< confess >;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw< :characters >;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
use Exception::Class (
|
||||
'Perl::Critic::Exception::Parse' => {
|
||||
isa => 'Perl::Critic::Exception',
|
||||
description => 'A problem parsing source code.',
|
||||
fields => [ qw< file_name > ],
|
||||
alias => 'throw_parse',
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array our @EXPORT_OK => qw< throw_parse >;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Exception::Parse - The code doesn't look like code.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
There was a problem with PPI parsing source code.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<file_name()>
|
||||
|
||||
Returns the name of the file that the problem was found with, if available.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank <perl@galumph.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2008-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,451 @@
|
|||
package Perl::Critic::OptionsProcessor;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use Perl::Critic::Exception::AggregateConfiguration;
|
||||
use Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter;
|
||||
use Perl::Critic::Utils qw<
|
||||
:booleans :characters :severities :data_conversion $DEFAULT_VERBOSITY
|
||||
>;
|
||||
use Perl::Critic::Utils::Constants qw<
|
||||
$PROFILE_STRICTNESS_DEFAULT
|
||||
:color_severity
|
||||
>;
|
||||
use Perl::Critic::Utils::DataConversion qw< dor >;
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub new {
|
||||
my ($class, %args) = @_;
|
||||
my $self = bless {}, $class;
|
||||
$self->_init( %args );
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _init {
|
||||
my ( $self, %args ) = @_;
|
||||
|
||||
# Multi-value defaults
|
||||
my $exclude = dor(delete $args{exclude}, $EMPTY);
|
||||
$self->{_exclude} = [ words_from_string( $exclude ) ];
|
||||
|
||||
my $include = dor(delete $args{include}, $EMPTY);
|
||||
$self->{_include} = [ words_from_string( $include ) ];
|
||||
|
||||
my $program_extensions = dor(delete $args{'program-extensions'}, $EMPTY);
|
||||
$self->{_program_extensions} = [ words_from_string( $program_extensions) ];
|
||||
|
||||
# Single-value defaults
|
||||
$self->{_force} = dor(delete $args{force}, $FALSE);
|
||||
$self->{_only} = dor(delete $args{only}, $FALSE);
|
||||
$self->{_profile_strictness} =
|
||||
dor(delete $args{'profile-strictness'}, $PROFILE_STRICTNESS_DEFAULT);
|
||||
$self->{_single_policy} = dor(delete $args{'single-policy'}, $EMPTY);
|
||||
$self->{_severity} = dor(delete $args{severity}, $SEVERITY_HIGHEST);
|
||||
$self->{_theme} = dor(delete $args{theme}, $EMPTY);
|
||||
$self->{_top} = dor(delete $args{top}, $FALSE);
|
||||
$self->{_verbose} = dor(delete $args{verbose}, $DEFAULT_VERBOSITY);
|
||||
$self->{_criticism_fatal} = dor(delete $args{'criticism-fatal'}, $FALSE);
|
||||
$self->{_pager} = dor(delete $args{pager}, $EMPTY);
|
||||
$self->{_allow_unsafe} = dor(delete $args{'allow-unsafe'}, $FALSE);
|
||||
|
||||
$self->{_color_severity_highest} = dor(
|
||||
delete $args{'color-severity-highest'},
|
||||
delete $args{'colour-severity-highest'},
|
||||
delete $args{'color-severity-5'},
|
||||
delete $args{'colour-severity-5'},
|
||||
$PROFILE_COLOR_SEVERITY_HIGHEST_DEFAULT,
|
||||
);
|
||||
$self->{_color_severity_high} = dor(
|
||||
delete $args{'color-severity-high'},
|
||||
delete $args{'colour-severity-high'},
|
||||
delete $args{'color-severity-4'},
|
||||
delete $args{'colour-severity-4'},
|
||||
$PROFILE_COLOR_SEVERITY_HIGH_DEFAULT,
|
||||
);
|
||||
$self->{_color_severity_medium} = dor(
|
||||
delete $args{'color-severity-medium'},
|
||||
delete $args{'colour-severity-medium'},
|
||||
delete $args{'color-severity-3'},
|
||||
delete $args{'colour-severity-3'},
|
||||
$PROFILE_COLOR_SEVERITY_MEDIUM_DEFAULT,
|
||||
);
|
||||
$self->{_color_severity_low} = dor(
|
||||
delete $args{'color-severity-low'},
|
||||
delete $args{'colour-severity-low'},
|
||||
delete $args{'color-severity-2'},
|
||||
delete $args{'colour-severity-2'},
|
||||
$PROFILE_COLOR_SEVERITY_LOW_DEFAULT,
|
||||
);
|
||||
$self->{_color_severity_lowest} = dor(
|
||||
delete $args{'color-severity-lowest'},
|
||||
delete $args{'colour-severity-lowest'},
|
||||
delete $args{'color-severity-1'},
|
||||
delete $args{'colour-severity-1'},
|
||||
$PROFILE_COLOR_SEVERITY_LOWEST_DEFAULT,
|
||||
);
|
||||
|
||||
# If we're using a pager or not outputing to a tty don't use colors.
|
||||
# Can't use IO::Interactive here because we /don't/ want to check STDIN.
|
||||
my $default_color = ($self->pager() or not -t *STDOUT) ? $FALSE : $TRUE; ## no critic (ProhibitInteractiveTest)
|
||||
$self->{_color} = dor(delete $args{color}, delete $args{colour}, $default_color);
|
||||
|
||||
# If there's anything left, complain.
|
||||
_check_for_extra_options(%args);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _check_for_extra_options {
|
||||
my %args = @_;
|
||||
|
||||
if ( my @remaining = sort keys %args ){
|
||||
my $errors = Perl::Critic::Exception::AggregateConfiguration->new();
|
||||
|
||||
foreach my $option_name (@remaining) {
|
||||
$errors->add_exception(
|
||||
Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter->new(
|
||||
option_name => $option_name,
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
$errors->rethrow();
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# Public ACCESSOR methods
|
||||
|
||||
sub severity {
|
||||
my ($self) = @_;
|
||||
return $self->{_severity};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub theme {
|
||||
my ($self) = @_;
|
||||
return $self->{_theme};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub exclude {
|
||||
my ($self) = @_;
|
||||
return $self->{_exclude};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub include {
|
||||
my ($self) = @_;
|
||||
return $self->{_include};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub only {
|
||||
my ($self) = @_;
|
||||
return $self->{_only};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub profile_strictness {
|
||||
my ($self) = @_;
|
||||
return $self->{_profile_strictness};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub single_policy {
|
||||
my ($self) = @_;
|
||||
return $self->{_single_policy};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub verbose {
|
||||
my ($self) = @_;
|
||||
return $self->{_verbose};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub color {
|
||||
my ($self) = @_;
|
||||
return $self->{_color};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub pager {
|
||||
my ($self) = @_;
|
||||
return $self->{_pager};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub allow_unsafe {
|
||||
my ($self) = @_;
|
||||
return $self->{_allow_unsafe};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub criticism_fatal {
|
||||
my ($self) = @_;
|
||||
return $self->{_criticism_fatal};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub force {
|
||||
my ($self) = @_;
|
||||
return $self->{_force};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub top {
|
||||
my ($self) = @_;
|
||||
return $self->{_top};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub color_severity_highest {
|
||||
my ($self) = @_;
|
||||
return $self->{_color_severity_highest};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub color_severity_high {
|
||||
my ($self) = @_;
|
||||
return $self->{_color_severity_high};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub color_severity_medium {
|
||||
my ($self) = @_;
|
||||
return $self->{_color_severity_medium};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub color_severity_low {
|
||||
my ($self) = @_;
|
||||
return $self->{_color_severity_low};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub color_severity_lowest {
|
||||
my ($self) = @_;
|
||||
return $self->{_color_severity_lowest};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub program_extensions {
|
||||
my ($self) = @_;
|
||||
return $self->{_program_extensions};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::OptionsProcessor - The global configuration default values, combined with command-line values.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is a helper class that encapsulates the default parameters for
|
||||
constructing a L<Perl::Critic::Config|Perl::Critic::Config> object.
|
||||
There are no user-serviceable parts here.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a non-public class. Its interface is subject
|
||||
to change without notice.
|
||||
|
||||
|
||||
=head1 CONSTRUCTOR
|
||||
|
||||
=over
|
||||
|
||||
=item C< new( %DEFAULT_PARAMS ) >
|
||||
|
||||
Returns a reference to a new C<Perl::Critic::OptionsProcessor> object.
|
||||
You can override the coded defaults by passing in name-value pairs
|
||||
that correspond to the methods listed below.
|
||||
|
||||
This is usually only invoked by
|
||||
L<Perl::Critic::UserProfile|Perl::Critic::UserProfile>, which passes
|
||||
in the global values from a F<.perlcriticrc> file. This object
|
||||
contains no information for individual Policies.
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C< exclude() >
|
||||
|
||||
Returns a reference to a list of the default exclusion patterns. If
|
||||
onto by
|
||||
L<Perl::Critic::PolicyParameter|Perl::Critic::PolicyParameter>. there
|
||||
are no default exclusion patterns, then the list will be empty.
|
||||
|
||||
|
||||
=item C< force() >
|
||||
|
||||
Returns the default value of the C<force> flag (Either 1 or 0).
|
||||
|
||||
|
||||
=item C< include() >
|
||||
|
||||
Returns a reference to a list of the default inclusion patterns. If
|
||||
there are no default exclusion patterns, then the list will be empty.
|
||||
|
||||
|
||||
=item C< only() >
|
||||
|
||||
Returns the default value of the C<only> flag (Either 1 or 0).
|
||||
|
||||
|
||||
=item C< profile_strictness() >
|
||||
|
||||
Returns the default value of C<profile_strictness> as an unvalidated
|
||||
string.
|
||||
|
||||
|
||||
=item C< single_policy() >
|
||||
|
||||
Returns the default C<single-policy> pattern. (As a string.)
|
||||
|
||||
|
||||
=item C< severity() >
|
||||
|
||||
Returns the default C<severity> setting. (1..5).
|
||||
|
||||
|
||||
=item C< theme() >
|
||||
|
||||
Returns the default C<theme> setting. (As a string).
|
||||
|
||||
|
||||
=item C< top() >
|
||||
|
||||
Returns the default C<top> setting. (Either 0 or a positive integer).
|
||||
|
||||
|
||||
=item C< verbose() >
|
||||
|
||||
Returns the default C<verbose> setting. (Either a number or format
|
||||
string).
|
||||
|
||||
|
||||
=item C< color() >
|
||||
|
||||
Returns the default C<color> setting. (Either 1 or 0).
|
||||
|
||||
|
||||
=item C< pager() >
|
||||
|
||||
Returns the default C<pager> setting. (Either empty string or the pager
|
||||
command string).
|
||||
|
||||
|
||||
=item C< allow_unsafe() >
|
||||
|
||||
Returns the default C<allow-unsafe> setting. (Either 1 or 0).
|
||||
|
||||
|
||||
=item C< criticism_fatal() >
|
||||
|
||||
Returns the default C<criticism-fatal> setting (Either 1 or 0).
|
||||
|
||||
=item C< color_severity_highest() >
|
||||
|
||||
Returns the color to be used for coloring highest severity violations.
|
||||
|
||||
=item C< color_severity_high() >
|
||||
|
||||
Returns the color to be used for coloring high severity violations.
|
||||
|
||||
=item C< color_severity_medium() >
|
||||
|
||||
Returns the color to be used for coloring medium severity violations.
|
||||
|
||||
=item C< color_severity_low() >
|
||||
|
||||
Returns the color to be used for coloring low severity violations.
|
||||
|
||||
=item C< color_severity_lowest() >
|
||||
|
||||
Returns the color to be used for coloring lowest severity violations.
|
||||
|
||||
=item C< program_extensions() >
|
||||
|
||||
Returns a reference to the array of file name extensions to be interpreted as
|
||||
representing Perl programs.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Config|Perl::Critic::Config>,
|
||||
L<Perl::Critic::UserProfile|Perl::Critic::UserProfile>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,910 @@
|
|||
package Perl::Critic::Policy;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use English qw< -no_match_vars >;
|
||||
use Readonly;
|
||||
|
||||
use File::Spec ();
|
||||
use String::Format qw< stringf >;
|
||||
|
||||
use overload ( q<""> => 'to_string', cmp => '_compare' );
|
||||
|
||||
use Perl::Critic::Utils qw<
|
||||
:characters
|
||||
:booleans
|
||||
:severities
|
||||
:data_conversion
|
||||
interpolate
|
||||
is_integer
|
||||
policy_long_name
|
||||
policy_short_name
|
||||
severity_to_number
|
||||
>;
|
||||
use Perl::Critic::Utils::DataConversion qw< dor >;
|
||||
use Perl::Critic::Utils::POD qw<
|
||||
get_module_abstract_for_module
|
||||
get_raw_module_abstract_for_module
|
||||
>;
|
||||
use Perl::Critic::Exception::AggregateConfiguration;
|
||||
use Perl::Critic::Exception::Configuration;
|
||||
use Perl::Critic::Exception::Configuration::Option::Policy::ExtraParameter;
|
||||
use Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue;
|
||||
use Perl::Critic::Exception::Fatal::PolicyDefinition
|
||||
qw< throw_policy_definition >;
|
||||
use Perl::Critic::PolicyConfig qw<>;
|
||||
use Perl::Critic::PolicyParameter qw<>;
|
||||
use Perl::Critic::Violation qw<>;
|
||||
|
||||
use Exception::Class; # this must come after "use P::C::Exception::*"
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $NO_LIMIT => 'no_limit';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
my $format = '%p'; #Default stringy format
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub new {
|
||||
my ($class, %config) = @_;
|
||||
|
||||
my $self = bless {}, $class;
|
||||
|
||||
my $config_object;
|
||||
if ($config{_config_object}) {
|
||||
$config_object = $config{_config_object};
|
||||
}
|
||||
else {
|
||||
$config_object =
|
||||
Perl::Critic::PolicyConfig->new(
|
||||
$self->get_short_name(),
|
||||
\%config,
|
||||
);
|
||||
}
|
||||
|
||||
$self->__set_config( $config_object );
|
||||
|
||||
my @parameters;
|
||||
my $parameter_metadata_available = 0;
|
||||
|
||||
if ( $class->can('supported_parameters') ) {
|
||||
$parameter_metadata_available = 1;
|
||||
@parameters =
|
||||
map
|
||||
{ Perl::Critic::PolicyParameter->new($_) }
|
||||
$class->supported_parameters();
|
||||
}
|
||||
$self->{_parameter_metadata_available} = $parameter_metadata_available;
|
||||
$self->{_parameters} = \@parameters;
|
||||
|
||||
my $errors = Perl::Critic::Exception::AggregateConfiguration->new();
|
||||
foreach my $parameter ( @parameters ) {
|
||||
eval {
|
||||
$parameter->parse_and_validate_config_value( $self, $config_object );
|
||||
}
|
||||
or do {
|
||||
$errors->add_exception_or_rethrow($EVAL_ERROR);
|
||||
};
|
||||
|
||||
$config_object->remove( $parameter->get_name() );
|
||||
}
|
||||
|
||||
if ($parameter_metadata_available) {
|
||||
$config_object->handle_extra_parameters( $self, $errors );
|
||||
}
|
||||
|
||||
if ( $errors->has_exceptions() ) {
|
||||
$errors->rethrow();
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub is_safe {
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub initialize_if_enabled {
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub prepare_to_scan_document {
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub __get_parameter_name {
|
||||
my ( $self, $parameter ) = @_;
|
||||
|
||||
return '_' . $parameter->get_name();
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub __set_parameter_value {
|
||||
my ( $self, $parameter, $value ) = @_;
|
||||
|
||||
$self->{ $self->__get_parameter_name($parameter) } = $value;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub __set_base_parameters {
|
||||
my ($self) = @_;
|
||||
|
||||
my $config = $self->__get_config();
|
||||
my $errors = Perl::Critic::Exception::AggregateConfiguration->new();
|
||||
|
||||
$self->_set_maximum_violations_per_document($errors);
|
||||
|
||||
my $user_severity = $config->get_severity();
|
||||
if ( defined $user_severity ) {
|
||||
my $normalized_severity = severity_to_number( $user_severity );
|
||||
$self->set_severity( $normalized_severity );
|
||||
}
|
||||
|
||||
my $user_set_themes = $config->get_set_themes();
|
||||
if ( defined $user_set_themes ) {
|
||||
my @set_themes = words_from_string( $user_set_themes );
|
||||
$self->set_themes( @set_themes );
|
||||
}
|
||||
|
||||
my $user_add_themes = $config->get_add_themes();
|
||||
if ( defined $user_add_themes ) {
|
||||
my @add_themes = words_from_string( $user_add_themes );
|
||||
$self->add_themes( @add_themes );
|
||||
}
|
||||
|
||||
if ( $errors->has_exceptions() ) {
|
||||
$errors->rethrow();
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _set_maximum_violations_per_document {
|
||||
my ($self, $errors) = @_;
|
||||
|
||||
my $config = $self->__get_config();
|
||||
|
||||
if ( $config->is_maximum_violations_per_document_unlimited() ) {
|
||||
return;
|
||||
}
|
||||
|
||||
my $user_maximum_violations =
|
||||
$config->get_maximum_violations_per_document();
|
||||
|
||||
if ( not is_integer($user_maximum_violations) ) {
|
||||
$errors->add_exception(
|
||||
new_parameter_value_exception(
|
||||
'maximum_violations_per_document',
|
||||
$user_maximum_violations,
|
||||
undef,
|
||||
"does not look like an integer.\n"
|
||||
)
|
||||
);
|
||||
|
||||
return;
|
||||
}
|
||||
elsif ( $user_maximum_violations < 0 ) {
|
||||
$errors->add_exception(
|
||||
new_parameter_value_exception(
|
||||
'maximum_violations_per_document',
|
||||
$user_maximum_violations,
|
||||
undef,
|
||||
"is not greater than or equal to zero.\n"
|
||||
)
|
||||
);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
$self->set_maximum_violations_per_document(
|
||||
$user_maximum_violations
|
||||
);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
# Unparsed configuration, P::C::PolicyConfig. Compare with get_parameters().
|
||||
sub __get_config {
|
||||
my ($self) = @_;
|
||||
|
||||
return $self->{_config};
|
||||
}
|
||||
|
||||
sub __set_config {
|
||||
my ($self, $config) = @_;
|
||||
|
||||
$self->{_config} = $config;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub get_long_name {
|
||||
my ($self) = @_;
|
||||
|
||||
return policy_long_name(ref $self);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub get_short_name {
|
||||
my ($self) = @_;
|
||||
|
||||
return policy_short_name(ref $self);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub is_enabled {
|
||||
my ($self) = @_;
|
||||
|
||||
return $self->{_enabled};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub __set_enabled {
|
||||
my ($self, $new_value) = @_;
|
||||
|
||||
$self->{_enabled} = $new_value;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub applies_to {
|
||||
return qw(PPI::Element);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub set_maximum_violations_per_document {
|
||||
my ($self, $maximum_violations_per_document) = @_;
|
||||
|
||||
$self->{_maximum_violations_per_document} =
|
||||
$maximum_violations_per_document;
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub get_maximum_violations_per_document {
|
||||
my ($self) = @_;
|
||||
|
||||
return
|
||||
exists $self->{_maximum_violations_per_document}
|
||||
? $self->{_maximum_violations_per_document}
|
||||
: $self->default_maximum_violations_per_document();
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub default_maximum_violations_per_document {
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub set_severity {
|
||||
my ($self, $severity) = @_;
|
||||
$self->{_severity} = $severity;
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub get_severity {
|
||||
my ($self) = @_;
|
||||
return $self->{_severity} || $self->default_severity();
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub default_severity {
|
||||
return $SEVERITY_LOWEST;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub set_themes {
|
||||
my ($self, @themes) = @_;
|
||||
$self->{_themes} = [ sort @themes ];
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub get_themes {
|
||||
my ($self) = @_;
|
||||
my @themes = defined $self->{_themes} ? @{ $self->{_themes} } : $self->default_themes();
|
||||
my @sorted_themes = sort @themes;
|
||||
return @sorted_themes;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub add_themes {
|
||||
my ($self, @additional_themes) = @_;
|
||||
#By hashifying the themes, we squish duplicates
|
||||
my %merged = hashify( $self->get_themes(), @additional_themes);
|
||||
$self->{_themes} = [ keys %merged];
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub default_themes {
|
||||
return ();
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub get_abstract {
|
||||
my ($self) = @_;
|
||||
|
||||
return get_module_abstract_for_module( ref $self );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub get_raw_abstract {
|
||||
my ($self) = @_;
|
||||
|
||||
return get_raw_module_abstract_for_module( ref $self );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub parameter_metadata_available {
|
||||
my ($self) = @_;
|
||||
|
||||
return $self->{_parameter_metadata_available};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub get_parameters {
|
||||
my ($self) = @_;
|
||||
|
||||
return $self->{_parameters};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self) = @_;
|
||||
|
||||
return throw_policy_definition
|
||||
$self->get_short_name() . q/ does not implement violates()./;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violation { ## no critic (ArgUnpacking)
|
||||
my ( $self, $desc, $expl, $elem ) = @_;
|
||||
# HACK!! Use goto instead of an explicit call because P::C::V::new() uses caller()
|
||||
my $sev = $self->get_severity();
|
||||
@_ = ('Perl::Critic::Violation', $desc, $expl, $elem, $sev );
|
||||
goto &Perl::Critic::Violation::new;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub new_parameter_value_exception {
|
||||
my ( $self, $option_name, $option_value, $source, $message_suffix ) = @_;
|
||||
|
||||
return Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue->new(
|
||||
policy => $self->get_short_name(),
|
||||
option_name => $option_name,
|
||||
option_value => $option_value,
|
||||
source => $source,
|
||||
message_suffix => $message_suffix
|
||||
);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
## no critic (Subroutines::RequireFinalReturn)
|
||||
sub throw_parameter_value_exception {
|
||||
my ( $self, $option_name, $option_value, $source, $message_suffix ) = @_;
|
||||
|
||||
$self->new_parameter_value_exception(
|
||||
$option_name, $option_value, $source, $message_suffix
|
||||
)
|
||||
->throw();
|
||||
}
|
||||
## use critic
|
||||
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
# Static methods.
|
||||
|
||||
sub set_format { return $format = $_[0] } ## no critic(ArgUnpacking)
|
||||
sub get_format { return $format }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub to_string {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
# Wrap the more expensive ones in sub{} to postpone evaluation
|
||||
my %fspec = (
|
||||
'P' => sub { $self->get_long_name() },
|
||||
'p' => sub { $self->get_short_name() },
|
||||
'a' => sub { dor($self->get_abstract(), $EMPTY) },
|
||||
'O' => sub { $self->_format_parameters(@_) },
|
||||
'U' => sub { $self->_format_lack_of_parameter_metadata(@_) },
|
||||
'S' => sub { $self->default_severity() },
|
||||
's' => sub { $self->get_severity() },
|
||||
'T' => sub { join $SPACE, $self->default_themes() },
|
||||
't' => sub { join $SPACE, $self->get_themes() },
|
||||
'V' => sub { dor( $self->default_maximum_violations_per_document(), $NO_LIMIT ) },
|
||||
'v' => sub { dor( $self->get_maximum_violations_per_document(), $NO_LIMIT ) },
|
||||
);
|
||||
return stringf(get_format(), %fspec);
|
||||
}
|
||||
|
||||
sub _format_parameters {
|
||||
my ($self, $parameter_format) = @_;
|
||||
|
||||
return $EMPTY if not $self->parameter_metadata_available();
|
||||
|
||||
my $separator;
|
||||
if ($parameter_format) {
|
||||
$separator = $EMPTY;
|
||||
} else {
|
||||
$separator = $SPACE;
|
||||
$parameter_format = '%n';
|
||||
}
|
||||
|
||||
return
|
||||
join
|
||||
$separator,
|
||||
map { $_->to_formatted_string($parameter_format) } @{ $self->get_parameters() };
|
||||
}
|
||||
|
||||
sub _format_lack_of_parameter_metadata {
|
||||
my ($self, $message) = @_;
|
||||
|
||||
return $EMPTY if $self->parameter_metadata_available();
|
||||
return interpolate($message) if $message;
|
||||
|
||||
return
|
||||
'Cannot programmatically discover what parameters this policy takes.';
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# Apparently, some perls do not implicitly stringify overloading
|
||||
# objects before doing a comparison. This causes a couple of our
|
||||
# sorting tests to fail. To work around this, we overload C<cmp> to
|
||||
# do it explicitly.
|
||||
#
|
||||
# 20060503 - More information: This problem has been traced to
|
||||
# Test::Simple versions <= 0.60, not perl itself. Upgrading to
|
||||
# Test::Simple v0.62 will fix the problem. But rather than forcing
|
||||
# everyone to upgrade, I have decided to leave this workaround in
|
||||
# place.
|
||||
|
||||
sub _compare { return "$_[0]" cmp "$_[1]" }
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy - Base class for all Policy modules.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Perl::Critic::Policy is the abstract base class for all Policy
|
||||
objects. If you're developing your own Policies, your job is to
|
||||
implement and override its methods in a subclass. To work with the
|
||||
L<Perl::Critic|Perl::Critic> engine, your implementation must behave
|
||||
as described below. For a detailed explanation on how to make new
|
||||
Policy modules, please see the
|
||||
L<Perl::Critic::DEVELOPER|Perl::Critic::DEVELOPER> document included
|
||||
in this distribution.
|
||||
|
||||
|
||||
=head1 INTERFACE SUPPORT
|
||||
|
||||
This is considered to be a public class. Any changes to its interface
|
||||
will go through a deprecation cycle.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item C<< new( ... ) >>
|
||||
|
||||
Don't call this. As a Policy author, do not implement this. Use the
|
||||
C<initialize_if_enabled()> method for your Policy setup. See the
|
||||
L<developer|Perl::Critic::DEVELOPER> documentation for more.
|
||||
|
||||
|
||||
=item C<< initialize_if_enabled( $config ) >>
|
||||
|
||||
This receives an instance of
|
||||
L<Perl::Critic::PolicyConfig|Perl::Critic::PolicyConfig> as a
|
||||
parameter, and is only invoked if this Policy is enabled by the user.
|
||||
Thus, this is the preferred place for subclasses to do any
|
||||
initialization.
|
||||
|
||||
Implementations of this method should return a boolean value
|
||||
indicating whether the Policy should continue to be enabled. For most
|
||||
subclasses, this will always be C<$TRUE>. Policies that depend upon
|
||||
external modules or other system facilities that may or may not be
|
||||
available should test for the availability of these dependencies and
|
||||
return C<$FALSE> if they are not.
|
||||
|
||||
|
||||
=item C<< prepare_to_scan_document( $document ) >>
|
||||
|
||||
The parameter is about to be scanned by this Policy. Whatever this
|
||||
Policy wants to do in terms of preparation should happen here.
|
||||
Returns a boolean value indicating whether the document should be
|
||||
scanned at all; if this is a false value, this Policy won't be applied
|
||||
to the document. By default, does nothing but return C<$TRUE>.
|
||||
|
||||
|
||||
=item C< violates( $element, $document ) >
|
||||
|
||||
Given a L<PPI::Element|PPI::Element> and a
|
||||
L<PPI::Document|PPI::Document>, returns one or more
|
||||
L<Perl::Critic::Violation|Perl::Critic::Violation> objects if the
|
||||
C<$element> violates this Policy. If there are no violations, then it
|
||||
returns an empty list. If the Policy encounters an exception, then it
|
||||
should C<croak> with an error message and let the caller decide how to
|
||||
handle it.
|
||||
|
||||
C<violates()> is an abstract method and it will abort if you attempt
|
||||
to invoke it directly. It is the heart of all Policy modules, and
|
||||
your subclass B<must> override this method.
|
||||
|
||||
|
||||
=item C< violation( $description, $explanation, $element ) >
|
||||
|
||||
Returns a reference to a new C<Perl::Critic::Violation> object. The
|
||||
arguments are a description of the violation (as string), an
|
||||
explanation for the policy (as string) or a series of page numbers in
|
||||
PBP (as an ARRAY ref), a reference to the L<PPI|PPI> element that
|
||||
caused the violation.
|
||||
|
||||
These are the same as the constructor to
|
||||
L<Perl::Critic::Violation|Perl::Critic::Violation>, but without the
|
||||
severity. The Policy itself knows the severity.
|
||||
|
||||
|
||||
=item C< new_parameter_value_exception( $option_name, $option_value, $source, $message_suffix ) >
|
||||
|
||||
Create a
|
||||
L<Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue|Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue>
|
||||
for this Policy.
|
||||
|
||||
|
||||
=item C< throw_parameter_value_exception( $option_name, $option_value, $source, $message_suffix ) >
|
||||
|
||||
Create and throw a
|
||||
L<Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue|Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue>.
|
||||
Useful in parameter parser implementations.
|
||||
|
||||
|
||||
=item C< get_long_name() >
|
||||
|
||||
Return the full package name of this policy.
|
||||
|
||||
|
||||
=item C< get_short_name() >
|
||||
|
||||
Return the name of this policy without the "Perl::Critic::Policy::"
|
||||
prefix.
|
||||
|
||||
|
||||
=item C< is_enabled() >
|
||||
|
||||
Answer whether this policy is really active or not. Returns a true
|
||||
value if it is, a false, yet defined, value if it isn't, and an
|
||||
undefined value if it hasn't yet been decided whether it will be.
|
||||
|
||||
|
||||
=item C< applies_to() >
|
||||
|
||||
Returns a list of the names of PPI classes that this Policy cares
|
||||
about. By default, the result is C<PPI::Element>. Overriding this
|
||||
method in Policy subclasses should lead to significant performance
|
||||
increases.
|
||||
|
||||
|
||||
=item C< default_maximum_violations_per_document() >
|
||||
|
||||
Returns the default maximum number of violations for this policy to
|
||||
report per document. By default, this not defined, but subclasses may
|
||||
override this.
|
||||
|
||||
|
||||
=item C< get_maximum_violations_per_document() >
|
||||
|
||||
Returns the maximum number of violations this policy will report for a
|
||||
single document. If this is not defined, then there is no limit. If
|
||||
L</set_maximum_violations_per_document()> has not been invoked, then
|
||||
L</default_maximum_violations_per_document()> is returned.
|
||||
|
||||
|
||||
=item C< set_maximum_violations_per_document() >
|
||||
|
||||
Specify the maximum violations that this policy should report for a
|
||||
document.
|
||||
|
||||
|
||||
=item C< default_severity() >
|
||||
|
||||
Returns the default severity for violating this Policy. See the
|
||||
C<$SEVERITY> constants in L<Perl::Critic::Utils|Perl::Critic::Utils>
|
||||
for an enumeration of possible severity values. By default, this
|
||||
method returns C<$SEVERITY_LOWEST>. Authors of Perl::Critic::Policy
|
||||
subclasses should override this method to return a value that they
|
||||
feel is appropriate for their Policy. In general, Polices that are
|
||||
widely accepted or tend to prevent bugs should have a higher severity
|
||||
than those that are more subjective or cosmetic in nature.
|
||||
|
||||
|
||||
=item C< get_severity() >
|
||||
|
||||
Returns the severity of violating this Policy. If the severity has
|
||||
not been explicitly defined by calling C<set_severity>, then the
|
||||
C<default_severity> is returned. See the C<$SEVERITY> constants in
|
||||
L<Perl::Critic::Utils|Perl::Critic::Utils> for an enumeration of
|
||||
possible severity values.
|
||||
|
||||
|
||||
=item C< set_severity( $N ) >
|
||||
|
||||
Sets the severity for violating this Policy. Clients of
|
||||
Perl::Critic::Policy objects can call this method to assign a
|
||||
different severity to the Policy if they don't agree with the
|
||||
C<default_severity>. See the C<$SEVERITY> constants in
|
||||
L<Perl::Critic::Utils|Perl::Critic::Utils> for an enumeration of
|
||||
possible values.
|
||||
|
||||
|
||||
=item C< default_themes() >
|
||||
|
||||
Returns a sorted list of the default themes associated with this
|
||||
Policy. The default method returns an empty list. Policy authors
|
||||
should override this method to return a list of themes that are
|
||||
appropriate for their policy.
|
||||
|
||||
|
||||
=item C< get_themes() >
|
||||
|
||||
Returns a sorted list of the themes associated with this Policy. If
|
||||
you haven't added themes or set the themes explicitly, this method
|
||||
just returns the default themes.
|
||||
|
||||
|
||||
=item C< set_themes( @THEME_LIST ) >
|
||||
|
||||
Sets the themes associated with this Policy. Any existing themes are
|
||||
overwritten. Duplicate themes will be removed.
|
||||
|
||||
|
||||
=item C< add_themes( @THEME_LIST ) >
|
||||
|
||||
Appends additional themes to this Policy. Any existing themes are
|
||||
preserved. Duplicate themes will be removed.
|
||||
|
||||
|
||||
=item C< get_abstract() >
|
||||
|
||||
Retrieve the abstract for this policy (the part of the NAME section of
|
||||
the POD after the module name), if it is available.
|
||||
|
||||
|
||||
=item C< get_raw_abstract() >
|
||||
|
||||
Retrieve the abstract for this policy (the part of the NAME section of
|
||||
the POD after the module name), if it is available, in the unparsed
|
||||
form.
|
||||
|
||||
|
||||
=item C< parameter_metadata_available() >
|
||||
|
||||
Returns whether information about the parameters is available.
|
||||
|
||||
|
||||
=item C< get_parameters() >
|
||||
|
||||
Returns a reference to an array containing instances of
|
||||
L<Perl::Critic::PolicyParameter|Perl::Critic::PolicyParameter>.
|
||||
|
||||
Note that this will return an empty list if the parameters for this
|
||||
policy are unknown. In order to differentiate between this
|
||||
circumstance and the one where this policy does not take any
|
||||
parameters, it is necessary to call C<parameter_metadata_available()>.
|
||||
|
||||
|
||||
=item C<set_format( $format )>
|
||||
|
||||
Class method. Sets the format for all Policy objects when they are
|
||||
evaluated in string context. The default is C<"%p\n">. See
|
||||
L<"OVERLOADS"> for formatting options.
|
||||
|
||||
|
||||
=item C<get_format()>
|
||||
|
||||
Class method. Returns the current format for all Policy objects when
|
||||
they are evaluated in string context.
|
||||
|
||||
|
||||
=item C<to_string()>
|
||||
|
||||
Returns a string representation of the policy. The content of the
|
||||
string depends on the current value returned by C<get_format()>.
|
||||
See L<"OVERLOADS"> for the details.
|
||||
|
||||
|
||||
=item C<is_safe()>
|
||||
|
||||
Answer whether this Policy can be used to analyze untrusted code, i.e. the
|
||||
Policy doesn't have any potential side effects.
|
||||
|
||||
This method returns a true value by default.
|
||||
|
||||
An "unsafe" policy might attempt to compile the code, which, if you have
|
||||
C<BEGIN> or C<CHECK> blocks that affect files or connect to databases, is not
|
||||
a safe thing to do. If you are writing a such a Policy, then you should
|
||||
override this method to return false.
|
||||
|
||||
By default L<Perl::Critic|Perl::Critic> will not run unsafe policies.
|
||||
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 DOCUMENTATION
|
||||
|
||||
When your Policy module first C<use>s
|
||||
L<Perl::Critic::Violation|Perl::Critic::Violation>, it will try and
|
||||
extract the DESCRIPTION section of your Policy module's POD. This
|
||||
information is displayed by Perl::Critic if the verbosity level is set
|
||||
accordingly. Therefore, please include a DESCRIPTION section in the
|
||||
POD for any Policy modules that you author. Thanks.
|
||||
|
||||
|
||||
=head1 OVERLOADS
|
||||
|
||||
Perl::Critic::Violation overloads the C<""> operator to produce neat
|
||||
little messages when evaluated in string context.
|
||||
|
||||
Formats are a combination of literal and escape characters similar to
|
||||
the way C<sprintf> works. If you want to know the specific formatting
|
||||
capabilities, look at L<String::Format|String::Format>. Valid escape
|
||||
characters are:
|
||||
|
||||
|
||||
=over
|
||||
|
||||
=item C<%P>
|
||||
|
||||
Name of the Policy module.
|
||||
|
||||
|
||||
=item C<%p>
|
||||
|
||||
Name of the Policy without the C<Perl::Critic::Policy::> prefix.
|
||||
|
||||
|
||||
=item C<%a>
|
||||
|
||||
The policy abstract.
|
||||
|
||||
|
||||
=item C<%O>
|
||||
|
||||
List of supported policy parameters. Takes an option of a format
|
||||
string for L<Perl::Critic::PolicyParameter/"to_formatted_string">.
|
||||
For example, this can be used like C<%{%n - %d\n}O> to get a list of
|
||||
parameter names followed by their descriptions.
|
||||
|
||||
|
||||
=item C<%U>
|
||||
|
||||
A message stating that the parameters for the policy are unknown if
|
||||
C<parameter_metadata_available()> returns false. Takes an option of
|
||||
what the message should be, which defaults to "Cannot programmatically
|
||||
discover what parameters this policy takes.". The value of this
|
||||
option is interpolated in order to expand the standard escape
|
||||
sequences (C<\n>, C<\t>, etc.).
|
||||
|
||||
|
||||
=item C<%S>
|
||||
|
||||
The default severity level of the policy.
|
||||
|
||||
|
||||
=item C<%s>
|
||||
|
||||
The current severity level of the policy.
|
||||
|
||||
|
||||
=item C<%T>
|
||||
|
||||
The default themes for the policy.
|
||||
|
||||
|
||||
=item C<%t>
|
||||
|
||||
The current themes for the policy.
|
||||
|
||||
|
||||
=item C<%V>
|
||||
|
||||
The default maximum number of violations per document of the policy.
|
||||
|
||||
|
||||
=item C<%v>
|
||||
|
||||
The current maximum number of violations per document of the policy.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,155 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitBooleanGrep;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification hashify };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{"grep" used in boolean context};
|
||||
Readonly::Scalar my $EXPL => [71,72];
|
||||
|
||||
Readonly::Hash my %POSTFIX_CONDITIONALS => hashify( qw(if unless while until) );
|
||||
Readonly::Hash my %BOOLEAN_OPERATORS => hashify( qw(&& || ! not or and));
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOW }
|
||||
sub default_themes { return qw( core pbp performance certrec ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem->content() ne 'grep';
|
||||
return if not is_function_call($elem);
|
||||
return if not _is_in_boolean_context($elem);
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _is_in_boolean_context {
|
||||
my ($token) = @_;
|
||||
|
||||
return _does_prev_sibling_cause_boolean($token) || _does_parent_cause_boolean($token);
|
||||
}
|
||||
|
||||
sub _does_prev_sibling_cause_boolean {
|
||||
my ($token) = @_;
|
||||
|
||||
my $prev = $token->sprevious_sibling;
|
||||
return if !$prev;
|
||||
return 1 if $prev->isa('PPI::Token::Word') and $POSTFIX_CONDITIONALS{$prev};
|
||||
return if not ($prev->isa('PPI::Token::Operator') and $BOOLEAN_OPERATORS{$prev});
|
||||
my $next = $token->snext_sibling;
|
||||
return 1 if not $next; # bizarre: grep with no arguments
|
||||
|
||||
# loose heuristic: unparenthesized grep has no following non-boolean operators
|
||||
return 1 if not $next->isa('PPI::Structure::List');
|
||||
|
||||
$next = $next->snext_sibling;
|
||||
return 1 if not $next;
|
||||
return 1 if $next->isa('PPI::Token::Operator') and $BOOLEAN_OPERATORS{$next};
|
||||
return;
|
||||
}
|
||||
|
||||
sub _does_parent_cause_boolean {
|
||||
my ($token) = @_;
|
||||
|
||||
my $prev = $token->sprevious_sibling;
|
||||
return if $prev;
|
||||
my $parent = $token->statement->parent;
|
||||
for (my $node = $parent; $node; $node = $node->parent) { ## no critic (CStyleForLoop)
|
||||
next if $node->isa('PPI::Structure::List');
|
||||
return 1 if $node->isa('PPI::Structure::Condition');
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitBooleanGrep - Use C<List::MoreUtils::any> instead of C<grep> in boolean context.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Using C<grep> in boolean context is a common idiom for checking if any
|
||||
elements in a list match a condition. This works because boolean
|
||||
context is a subset of scalar context, and grep returns the number of
|
||||
matches in scalar context. A non-zero number of matches means a
|
||||
match.
|
||||
|
||||
But consider the case of a long array where the first element is a
|
||||
match. Boolean C<grep> still checks all of the rest of the elements
|
||||
needlessly. Instead, a better solution is to use the C<any> function
|
||||
from L<List::MoreUtils|List::MoreUtils>, which short-circuits after
|
||||
the first successful match to save time.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 CAVEATS
|
||||
|
||||
The algorithm for detecting boolean context takes a LOT of shortcuts.
|
||||
There are lots of known false negatives. But, I was conservative in
|
||||
writing this, so I hope there are no false positives.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
|
||||
=head1 CREDITS
|
||||
|
||||
Initial development of this policy was supported by a grant from the
|
||||
Perl Foundation.
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Chris Dolan. Many rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,147 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitComplexMappings;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Map blocks should have a single statement};
|
||||
Readonly::Scalar my $EXPL => [ 113 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'max_statements',
|
||||
description =>
|
||||
'The maximum number of statements to allow within a map block.',
|
||||
default_string => '1',
|
||||
behavior => 'integer',
|
||||
integer_minimum => 1,
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core pbp maintenance complexity) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem->content() ne 'map';
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
my $sib = $elem->snext_sibling();
|
||||
return if !$sib;
|
||||
|
||||
my $arg = $sib;
|
||||
if ( $arg->isa('PPI::Structure::List') ) {
|
||||
$arg = $arg->schild(0);
|
||||
# Forward looking: PPI might change in v1.200 so schild(0) is a PPI::Statement::Expression
|
||||
if ( $arg && $arg->isa('PPI::Statement::Expression') ) {
|
||||
$arg = $arg->schild(0);
|
||||
}
|
||||
}
|
||||
# If it's not a block, it's an expression-style map, which is only one statement by definition
|
||||
return if !$arg;
|
||||
return if !$arg->isa('PPI::Structure::Block');
|
||||
|
||||
# If we get here, we found a sort with a block as the first arg
|
||||
return if $self->{_max_statements} >= $arg->schildren()
|
||||
&& 0 == grep {$_->isa('PPI::Statement::Compound')} $arg->schildren();
|
||||
|
||||
# more than one child statements
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitComplexMappings - Map blocks should have a single statement.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The map function can be confusing to novices in the best of
|
||||
circumstances. Mappings with multiple statements are even worse.
|
||||
They're also a maintainer's nightmare because any added complexity
|
||||
decreases readability precipitously. Why? Because map is
|
||||
traditionally a one-liner converting one array to another. Trying to
|
||||
cram lots of functionality into a one-liner is a bad idea in general.
|
||||
|
||||
The best solutions to a complex mapping are: 1) write a subroutine
|
||||
that performs the manipulation and call that from map; 2) rewrite the
|
||||
map as a for loop.
|
||||
|
||||
|
||||
=head1 CAVEATS
|
||||
|
||||
This policy currently misses some compound statements inside of the
|
||||
map. For example, the following code incorrectly does not trigger a
|
||||
violation:
|
||||
|
||||
map { do { foo(); bar() } } @list
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
By default this policy flags any mappings with more than one
|
||||
statement. While we do not recommend it, you can increase this limit
|
||||
as follows in a F<.perlcriticrc> file:
|
||||
|
||||
[BuiltinFunctions::ProhibitComplexMappings]
|
||||
max_statements = 2
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
|
||||
=head1 CREDITS
|
||||
|
||||
Initial development of this policy was supported by a grant from the
|
||||
Perl Foundation.
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,126 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
use version 0.77 ();
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification :language };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Lvalue form of "substr" used};
|
||||
Readonly::Scalar my $EXPL => [ 165 ];
|
||||
|
||||
Readonly::Scalar my $ASSIGNMENT_PRECEDENCE => precedence_of( q{=} );
|
||||
Readonly::Scalar my $MINIMUM_PERL_VERSION => version->new( 5.005 );
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core maintenance pbp ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub prepare_to_scan_document {
|
||||
my ( $self, $document ) = @_;
|
||||
# perl5005delta says that is when the fourth argument to substr()
|
||||
# was introduced, so ... (RT #59112)
|
||||
my $version = $document->highest_explicit_perl_version();
|
||||
return ! $version || $version >= $MINIMUM_PERL_VERSION;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self, $elem, undef) = @_;
|
||||
|
||||
return if $elem->content() ne 'substr';
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
my $sib = $elem;
|
||||
while ($sib = $sib->snext_sibling()) {
|
||||
if ( $sib->isa( 'PPI::Token::Operator' ) ) {
|
||||
my $rslt = $ASSIGNMENT_PRECEDENCE <=> precedence_of(
|
||||
$sib->content() );
|
||||
return if $rslt < 0;
|
||||
return $self->violation( $DESC, $EXPL, $sib ) if $rslt == 0;
|
||||
}
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords perlfunc substr 4th
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr - Use 4-argument C<substr> instead of writing C<substr($foo, 2, 6) = $bar>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway discourages the use of C<substr()> as an lvalue, instead
|
||||
recommending that the 4-argument version of C<substr()> be used
|
||||
instead.
|
||||
|
||||
substr($something, 1, 2) = $newvalue; # not ok
|
||||
substr($something, 1, 2, $newvalue); # ok
|
||||
|
||||
The four-argument form of C<substr()> was introduced in Perl 5.005.
|
||||
This policy does not report violations on code which explicitly
|
||||
specifies an earlier version of Perl (e.g. C<use 5.004;>).
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<"substr" in perlfunc|perlfunc/substr> (or C<perldoc -f substr>).
|
||||
|
||||
L<"4th argument to substr" in perl5005delta|perl5005delta/4th argument to substr>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Graham TerMarsch <graham@howlingfrog.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Graham TerMarsch. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,130 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitReverseSortBlock;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Forbid $b before $a in sort blocks}; ## no critic (InterpolationOfMetachars)
|
||||
Readonly::Scalar my $EXPL => [ 152 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOWEST }
|
||||
sub default_themes { return qw(core pbp cosmetic) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self, $elem, $doc) = @_;
|
||||
|
||||
return if $elem->content() ne 'sort';
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
my $sib = $elem->snext_sibling();
|
||||
return if !$sib;
|
||||
|
||||
my $arg = $sib;
|
||||
if ( $arg->isa('PPI::Structure::List') ) {
|
||||
$arg = $arg->schild(0);
|
||||
# Forward looking: PPI might change in v1.200 so schild(0) is a PPI::Statement::Expression
|
||||
if ( $arg && $arg->isa('PPI::Statement::Expression') ) {
|
||||
$arg = $arg->schild(0);
|
||||
}
|
||||
}
|
||||
return if !$arg || !$arg->isa('PPI::Structure::Block');
|
||||
|
||||
# If we get here, we found a sort with a block as the first arg
|
||||
|
||||
# Look at each statement in the block separately.
|
||||
# $a is +1, $b is -1, sum should always be >= 0.
|
||||
# This may go badly if there are conditionals or loops or other
|
||||
# sub-statements...
|
||||
for my $statement ($arg->children) {
|
||||
my @sort_vars = $statement =~ m/\$([ab])\b/gxms;
|
||||
my $count = 0;
|
||||
for my $sort_var (@sort_vars) {
|
||||
if ($sort_var eq 'a') {
|
||||
$count++;
|
||||
} else {
|
||||
$count--;
|
||||
if ($count < 0) {
|
||||
# Found too many C<$b>s too early
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return; #ok
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitReverseSortBlock - Forbid $b before $a in sort blocks.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway says that it is much clearer to use C<reverse> than to flip
|
||||
C<$a> and C<$b> around in a C<sort> block. He also suggests that, in
|
||||
newer perls, C<reverse> is specifically looked for and optimized, and
|
||||
in the case of a simple reversed string C<sort>, using C<reverse> with
|
||||
a C<sort> with no block is faster even in old perls.
|
||||
|
||||
my @foo = sort { $b cmp $a } @bar; #not ok
|
||||
my @foo = reverse sort @bar; #ok
|
||||
|
||||
my @foo = sort { $b <=> $a } @bar; #not ok
|
||||
my @foo = reverse sort { $a <=> $b } @bar; #ok
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,189 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitShiftRef;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
use version 0.77 ();
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification :language };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{\shift used};
|
||||
Readonly::Scalar my $EXPL => [165];
|
||||
|
||||
Readonly::Scalar my $MINIMUM_PERL_VERSION => version->new(5.008008);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core bugs tests ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub prepare_to_scan_document {
|
||||
my ( $self, $document ) = @_;
|
||||
|
||||
# The earliest version tested was 5.8.8
|
||||
my $version = $document->highest_explicit_perl_version();
|
||||
return !$version || $version >= $MINIMUM_PERL_VERSION;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem->content() ne 'shift';
|
||||
|
||||
my $prev = $elem->sprevious_sibling();
|
||||
if ( !$prev ) {
|
||||
|
||||
# If there is no previous token, we are probably nested in a block.
|
||||
# Grab the statement and see if it's in a block. For simplicity, we
|
||||
# assume the block only contains a 'shift' statement, which may not be
|
||||
# reliable.
|
||||
if ( my $stmt = $elem->statement ) {
|
||||
|
||||
my $block = $stmt->parent();
|
||||
if ( $block && $block->isa('PPI::Structure::Block') ) {
|
||||
$prev = $block->sprevious_sibling();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $prev && $prev->isa('PPI::Token::Cast') && $prev->content() eq q{\\} ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding utf8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitShiftRef - Prohibit C<\shift> in code
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Prohibit the use of C<\shift>, as it is associated with bugs in Perl and its
|
||||
modules.
|
||||
|
||||
=head2 Background
|
||||
|
||||
Often, C<\shift> is used to create references that act much like an alias. By
|
||||
creating an "alias" that is named, the code becomes more readable. For example,
|
||||
|
||||
sub routine {
|
||||
my $longstring = \shift;
|
||||
print $$longstring;
|
||||
}
|
||||
|
||||
is more readable than
|
||||
|
||||
sub routine {
|
||||
print $_[0]; # longstring
|
||||
}
|
||||
|
||||
Unfortunately, this added readability brings with it new and exciting issues,
|
||||
detailed in the next section.
|
||||
|
||||
=head2 Problems with C<\shift>
|
||||
|
||||
By avoiding C<\shift>, several issues in Perl can be averted, including:
|
||||
|
||||
=over
|
||||
|
||||
=item Memory leak since Perl 5.22
|
||||
|
||||
Issue #126676 was introduced in Perl 5.21.4 and is triggered when C<\shift> is
|
||||
used. The bug has not been resolved as of Perl 5.28.
|
||||
|
||||
In short, the bug causes the ref counter for the aliased variable to be
|
||||
incremented when running the subroutine, but it is not subsequently decremented
|
||||
after the subroutine returns. In addition to leaking memory, this issue can
|
||||
also delay the cleanup of objects until Global Destruction, which can cause
|
||||
further issues.
|
||||
|
||||
For more information, see L<https://rt.perl.org/Public/Bug/Display.html?id=126676>.
|
||||
|
||||
=item Devel::Cover crashes
|
||||
|
||||
A separate, longstanding issue in Devel::Cover (since at least 1.21), causes
|
||||
test code to segfault occasionally. This prevents the coverage data from being
|
||||
written out, resulting in bad metrics.
|
||||
|
||||
The bug itself isn't actually caused by C<\shift>, instead it shows up in code
|
||||
like the following:
|
||||
|
||||
sub myopen {
|
||||
open ${ \$_[0] }, ">test";
|
||||
}
|
||||
|
||||
However, this code would rarely be seen in production. It would more likely
|
||||
manifest with C<\shift>, as it does below:
|
||||
|
||||
sub myopen {
|
||||
my $fh = \shift;
|
||||
open $$fh, ">test";
|
||||
}
|
||||
|
||||
So while C<\shift> isn't the cause, it's often associated with the problem.
|
||||
|
||||
For more information, see L<https://github.com/pjcj/Devel--Cover/issues/125>.
|
||||
|
||||
=back
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<https://rt.perl.org/Public/Bug/Display.html?id=126676>
|
||||
|
||||
L<https://github.com/pjcj/Devel--Cover/issues/125>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
=for stopwords Lindee
|
||||
|
||||
Chris Lindee <chris.lindee@cpanel.net>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
=for stopwords cPanel
|
||||
|
||||
Copyright (c) 2018 cPanel, L.L.C.
|
||||
|
||||
All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,114 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification :ppi };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{"select" used to emulate "sleep"};
|
||||
Readonly::Scalar my $EXPL => [168];
|
||||
Readonly::Scalar my $SELECT_ARGUMENT_COUNT => 4;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGHEST }
|
||||
sub default_themes { return qw( core pbp bugs ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self, $elem, undef) = @_;
|
||||
|
||||
return if $elem->content() ne 'select';
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
my @arguments = parse_arg_list($elem);
|
||||
return if $SELECT_ARGUMENT_COUNT != @arguments;
|
||||
|
||||
foreach my $argument ( @arguments[0..2] ) {
|
||||
return if $argument->[0] ne 'undef';
|
||||
}
|
||||
|
||||
if ( $arguments[-1]->[0] ne 'undef' ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords perlfunc
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect - Use L<Time::HiRes|Time::HiRes> instead of something like C<select(undef, undef, undef, .05)>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway discourages the use of C<select()> for performing non-integer
|
||||
sleeps. Although documented in L<perlfunc|perlfunc>, it's something
|
||||
that generally requires the reader to read C<perldoc -f select> to
|
||||
figure out what it should be doing. Instead, Conway recommends that
|
||||
you use the C<Time::HiRes> module when you want to sleep.
|
||||
|
||||
select undef, undef, undef, 0.25; # not ok
|
||||
|
||||
use Time::HiRes;
|
||||
sleep( 0.25 ); # ok
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Time::HiRes|Time::HiRes>.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Graham TerMarsch <graham@howlingfrog.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Graham TerMarsch. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,184 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
use PPI::Document;
|
||||
|
||||
use Perl::Critic::Utils qw{ :booleans :severities :classification :ppi $SCOLON };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Expression form of "eval"};
|
||||
Readonly::Scalar my $EXPL => [ 161 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'allow_includes',
|
||||
description => q<Allow eval of "use" and "require" strings.>,
|
||||
default_string => '0',
|
||||
behavior => 'boolean',
|
||||
},
|
||||
);
|
||||
}
|
||||
sub default_severity { return $SEVERITY_HIGHEST }
|
||||
sub default_themes { return qw( core pbp bugs certrule ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem->content() ne 'eval';
|
||||
return if not is_function_call($elem);
|
||||
|
||||
my $argument = first_arg($elem);
|
||||
return if not $argument;
|
||||
return if $argument->isa('PPI::Structure::Block');
|
||||
return if
|
||||
$self->{_allow_includes} and _string_eval_is_an_include($argument);
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
sub _string_eval_is_an_include {
|
||||
my ($eval_argument) = @_;
|
||||
|
||||
return if not $eval_argument->isa('PPI::Token::Quote');
|
||||
|
||||
my $string = $eval_argument->string();
|
||||
my $document;
|
||||
|
||||
eval { $document = PPI::Document->new(\$string); 1 }
|
||||
or return;
|
||||
|
||||
my @statements = $document->schildren;
|
||||
|
||||
return if @statements > 2;
|
||||
my $include = $statements[0];
|
||||
return if not defined $include; # RT 60179
|
||||
return if not $include->isa('PPI::Statement::Include');
|
||||
return if $include->type() eq 'no';
|
||||
|
||||
if (
|
||||
$eval_argument->isa('PPI::Token::Quote::Single')
|
||||
or $eval_argument->isa('PPI::Token::Quote::Literal')
|
||||
) {
|
||||
# Don't allow funky inclusion of arbitrary code (note we do allow
|
||||
# interpolated values in interpolating strings because they can't
|
||||
# entirely screw with the syntax).
|
||||
return if $include->find('PPI::Token::Symbol');
|
||||
}
|
||||
|
||||
return $TRUE if @statements == 1;
|
||||
|
||||
my $follow_on = $statements[1];
|
||||
return if not $follow_on->isa('PPI::Statement');
|
||||
|
||||
my @follow_on_components = $follow_on->schildren();
|
||||
|
||||
return if @follow_on_components > 2;
|
||||
return if not $follow_on_components[0]->isa('PPI::Token::Number');
|
||||
return $TRUE if @follow_on_components == 1;
|
||||
|
||||
return $follow_on_components[1]->content() eq $SCOLON;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords SIGNES
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval - Write C<eval { my $foo; bar($foo) }> instead of C<eval "my $foo; bar($foo);">.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The string form of C<eval> is recompiled every time it is executed,
|
||||
whereas the block form is only compiled once. Also, the string form
|
||||
doesn't give compile-time warnings.
|
||||
|
||||
eval "print $foo"; # not ok
|
||||
eval {print $foo}; # ok
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
There is an C<allow_includes> boolean option for this Policy. If set, then
|
||||
strings that look like they only include a single "use" or "require" statement
|
||||
(with the possible following statement that consists of a single number) are
|
||||
allowed. With this option set, the following are flagged as indicated:
|
||||
|
||||
eval 'use Foo'; # ok
|
||||
eval 'require Foo'; # ok
|
||||
eval "use $thingy;"; # ok
|
||||
eval "require $thingy;"; # ok
|
||||
eval "use $thingy; 1;"; # ok
|
||||
eval "require $thingy; 1;"; # ok
|
||||
|
||||
eval 'use Foo; blah;'; # still not ok
|
||||
eval 'require Foo; 2; 1;'; # still not ok
|
||||
eval 'use $thingy;'; # still not ok
|
||||
eval 'no Foo'; # still not ok
|
||||
|
||||
If you don't understand why the number is allowed, see
|
||||
L<Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval|Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval>.
|
||||
|
||||
This option inspired by Ricardo SIGNES'
|
||||
L<Perl::Critic::Policy::Lax::ProhibitStringyEval::ExceptForRequire|Perl::Critic::Policy::Lax::ProhibitStringyEval::ExceptForRequire>.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep|Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep>
|
||||
|
||||
L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap|Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,113 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :characters :severities :classification :ppi };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{String delimiter used with "split"};
|
||||
Readonly::Scalar my $EXPL => q{Express it as a regex instead};
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOW }
|
||||
sub default_themes { return qw(core pbp cosmetic certrule ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem->content() ne 'split';
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
my @args = parse_arg_list($elem);
|
||||
my $pattern = @args ? $args[0]->[0] : return;
|
||||
|
||||
if ( $pattern->isa('PPI::Token::Quote') && $pattern->string() ne $SPACE ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
return; #ok
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit - Write C<split /-/, $string> instead of C<split '-', $string>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The C<split> function always interprets the PATTERN argument as a
|
||||
regular expression, even if you specify it as a string. This causes
|
||||
much confusion if the string contains regex metacharacters. So for
|
||||
clarity, always express the PATTERN argument as a regex.
|
||||
|
||||
$string = 'Fred|Barney';
|
||||
@names = split '|', $string; #not ok, is ('F', 'r', 'e', 'd', '|', 'B', 'a' ...)
|
||||
@names = split m/[|]/, $string; #ok, is ('Fred', Barney')
|
||||
|
||||
When the PATTERN is a single space the C<split> function has special
|
||||
behavior, so Perl::Critic forgives that usage. See C<"perldoc -f
|
||||
split"> for more information.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep|Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep>
|
||||
|
||||
L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap|Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,104 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{UNIVERSAL::can should not be used as a function};
|
||||
Readonly::Scalar my $EXPL => q{Use eval{$obj->can($pkg)} instead}; ## no critic (RequireInterp);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core maintenance certrule ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
return if !($elem eq 'can' || $elem eq 'UNIVERSAL::can');
|
||||
return if ! is_function_call($elem); # this also permits 'use UNIVERSAL::can;'
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan - Write C<< eval { $foo->can($name) } >> instead of C<UNIVERSAL::can($foo, $name)>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
print UNIVERSAL::can($obj, 'Foo::Bar') ? 'yes' : 'no'; #not ok
|
||||
print eval { $obj->can('Foo::Bar') } ? 'yes' : 'no'; #ok
|
||||
|
||||
As of Perl 5.9.3, the use of UNIVERSAL::can as a function has been
|
||||
deprecated and the method form is preferred instead. Formerly, the
|
||||
functional form was recommended because it gave valid results even
|
||||
when the object was C<undef> or an unblessed scalar. However, the
|
||||
functional form makes it impossible for packages to override C<can()>,
|
||||
a technique which is crucial for implementing mock objects and some
|
||||
facades.
|
||||
|
||||
See L<UNIVERSAL::can|UNIVERSAL::can> for a more thorough discussion of
|
||||
this topic.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa|Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,105 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{UNIVERSAL::isa should not be used as a function};
|
||||
Readonly::Scalar my $EXPL => q{Use eval{$obj->isa($pkg)} instead}; ## no critic (RequireInterp);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core maintenance certrule ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
return if !($elem eq 'isa' || $elem eq 'UNIVERSAL::isa');
|
||||
return if ! is_function_call($elem); # this also permits 'use UNIVERSAL::isa;'
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa - Write C<< eval { $foo->isa($pkg) } >> instead of C<UNIVERSAL::isa($foo, $pkg)>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
print UNIVERSAL::isa($obj, 'Foo::Bar') ? 'yes' : 'no'; #not ok
|
||||
print eval { $obj->isa('Foo::Bar') } ? 'yes' : 'no'; #ok
|
||||
|
||||
As of Perl 5.9.3, the use of C<UNIVERSAL::isa> as a function has been
|
||||
deprecated and the method form is preferred instead. Formerly, the
|
||||
functional form was recommended because it gave valid results even
|
||||
when the object was C<undef> or an unblessed scalar. However, the
|
||||
functional form makes it impossible for packages to override C<isa()>,
|
||||
a technique which is crucial for implementing mock objects and some
|
||||
facades.
|
||||
|
||||
Another alternative to UNIVERSAL::isa is the C<_INSTANCE> method of
|
||||
Param::Util, which is faster.
|
||||
|
||||
See the CPAN module L<UNIVERSAL::isa|UNIVERSAL::isa> for an incendiary
|
||||
discussion of this topic.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan|Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,212 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitUselessTopic;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification :ppi };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
## no critic ( ValuesAndExpressions::RequireInterpolationOfMetachars )
|
||||
## The numerous $_ variables make false positives.
|
||||
Readonly::Scalar my $DESC => q{Useless use of $_};
|
||||
Readonly::Scalar my $EXPL_FILETEST => q{$_ should be omitted when using a filetest operator};
|
||||
Readonly::Scalar my $EXPL_FUNCTION => q{$_ should be omitted when calling "%s"};
|
||||
Readonly::Scalar my $EXPL_FUNCTION_SPLIT => q{$_ should be omitted when calling "split" with two arguments};
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOW }
|
||||
sub default_themes { return qw( core ) }
|
||||
sub applies_to { return 'PPI::Token::Operator', 'PPI::Token::Word' }
|
||||
|
||||
my @filetest_operators = qw( -r -w -x -o -R -W -X -O -e -z -s -f -d -l -p -S -b -c -u -g -k -T -B -M -A -C );
|
||||
my %filetest_operators = map { ($_ => 1) } @filetest_operators;
|
||||
|
||||
my @topical_funcs = qw(
|
||||
abs alarm
|
||||
chomp chop chr chroot cos
|
||||
defined
|
||||
eval exp
|
||||
fc
|
||||
glob
|
||||
hex
|
||||
int
|
||||
lc lcfirst length log lstat
|
||||
mkdir
|
||||
oct ord
|
||||
pos print
|
||||
quotemeta
|
||||
readlink readpipe ref require reverse rmdir
|
||||
say sin split sqrt stat study
|
||||
uc ucfirst unlink unpack
|
||||
);
|
||||
my %topical_funcs = map { ($_ => 1) } @topical_funcs;
|
||||
|
||||
my %applies_to = ( %topical_funcs, %filetest_operators );
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if not exists $applies_to{ $elem->content };
|
||||
|
||||
my $content = $elem->content;
|
||||
|
||||
# Are we looking at a filetest?
|
||||
if ( $filetest_operators{ $content } ) {
|
||||
# Is there a $_ following it?
|
||||
my $op_node = $elem->snext_sibling;
|
||||
if ( $op_node && $op_node->isa('PPI::Token::Magic') ) {
|
||||
my $op = $op_node->content;
|
||||
if ( $op eq '$_' ) {
|
||||
return $self->violation( $DESC, $EXPL_FILETEST, $elem );
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
if ( $topical_funcs{ $content } && is_perl_builtin( $elem ) ) {
|
||||
my $is_split = $content eq 'split';
|
||||
|
||||
my @args = parse_arg_list( $elem );
|
||||
|
||||
my $nth_arg_for_topic;
|
||||
if ( $is_split ) {
|
||||
return if @args != 2; # Ignore split( /\t/ ) or split( /\t/, $_, 3 )
|
||||
$nth_arg_for_topic = 2;
|
||||
}
|
||||
else {
|
||||
$nth_arg_for_topic = 1;
|
||||
}
|
||||
|
||||
if ( @args == $nth_arg_for_topic ) {
|
||||
my $topic_arg = $args[ $nth_arg_for_topic - 1 ];
|
||||
my @tokens = @{$topic_arg};
|
||||
if ( (@tokens == 1) && ($tokens[0]->content eq '$_') ) {
|
||||
my $msg = $is_split ? $EXPL_FUNCTION_SPLIT : (sprintf $EXPL_FUNCTION, $content);
|
||||
return $self->violation( $DESC, $msg, $elem );
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords filetest
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitUselessTopic - Don't pass $_ to built-in functions that assume it, or to most filetest operators.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the L<Perl::Critic|Perl::Critic> distribution.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
There are a number of places where C<$_>, or "the topic" variable,
|
||||
is unnecessary.
|
||||
|
||||
=head2 Topic unnecessary for certain Perl built-in functions
|
||||
|
||||
Many Perl built-in functions will operate on C<$_> if no argument
|
||||
is passed. For example, the C<length> function will operate on
|
||||
C<$_> by default. This snippet:
|
||||
|
||||
for ( @list ) {
|
||||
if ( length( $_ ) == 4 ) { ...
|
||||
|
||||
is more idiomatically written as:
|
||||
|
||||
for ( @list ) {
|
||||
if ( length == 4 ) { ...
|
||||
|
||||
In the case of the C<split> function, the second argument is the
|
||||
one that defaults to C<$_>. This snippet:
|
||||
|
||||
for ( @list ) {
|
||||
my @args = split /\t/, $_;
|
||||
|
||||
is better written as:
|
||||
|
||||
for ( @list ) {
|
||||
my @args = split /\t/;
|
||||
|
||||
There is one built-in that this policy does B<not> check for:
|
||||
C<reverse> called with C<$_>.
|
||||
|
||||
The C<reverse> function only operates on C<$_> if called in scalar
|
||||
context. Therefore:
|
||||
|
||||
for ( @list ) {
|
||||
my $backwards = reverse $_;
|
||||
|
||||
is better written as:
|
||||
|
||||
for ( @list ) {
|
||||
my $backwards = reverse;
|
||||
|
||||
However, the distinction for scalar vs. list context on C<reverse>
|
||||
is not yet working. See L<KNOWN BUGS|KNOWN BUGS> below.
|
||||
|
||||
=head2 Topic unnecessary for most filetest operators
|
||||
|
||||
Another place that C<$_> is unnecessary is with a filetest operator.
|
||||
|
||||
# These are identical.
|
||||
my $size = -s $_;
|
||||
my $size = -s;
|
||||
|
||||
# These are identical.
|
||||
if ( -r $_ ) { ...
|
||||
if ( -r ) { ...
|
||||
|
||||
The exception is after the C<-t> filetest operator, which instead of
|
||||
defaulting to C<$_> defaults to C<STDIN>.
|
||||
|
||||
# These are NOT identical.
|
||||
if ( -t $_ ) { ...
|
||||
if ( -t ) { ... # Checks STDIN, not $_
|
||||
|
||||
=head1 KNOWN BUGS
|
||||
|
||||
This policy flags a false positive on C<reverse> called in list
|
||||
context, since C<reverse> in list context does I<not> assume C<$_>.
|
||||
|
||||
my $s = reverse( $_ ); # $_ is useless.
|
||||
my @a = reverse( $_ ); # $_ is not useless here.
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Andy Lester <andy@petdance.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2013 Andy Lester <andy@petdance.com>
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the Artistic License 2.0.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification is_in_void_context };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{"grep" used in void context};
|
||||
Readonly::Scalar my $EXPL => q{Use a "for" loop instead};
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core maintenance ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem->content() ne 'grep';
|
||||
return if not is_function_call($elem);
|
||||
return if not is_in_void_context($elem);
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep - Don't use C<grep> in void contexts.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
C<map> and C<grep> are intended to be pure functions, not mutators.
|
||||
If you want to iterate with side-effects, then you should use a proper
|
||||
C<for> or C<foreach> loop.
|
||||
|
||||
grep{ print frobulate($_) } @list; #not ok
|
||||
print map{ frobulate($_) } @list; #ok
|
||||
|
||||
grep{ $_ = lc $_ } @list; #not ok
|
||||
for( @list ){ $_ = lc $_ }; #ok
|
||||
|
||||
map{ push @frobbed, frobulate($_) } @list; #not ok
|
||||
@frobbed = map { frobulate($_) } @list; #ok
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification is_in_void_context };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{"map" used in void context};
|
||||
Readonly::Scalar my $EXPL => q{Use a "for" loop instead};
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core maintenance ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem->content() ne 'map';
|
||||
return if not is_function_call($elem);
|
||||
return if not is_in_void_context($elem);
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap - Don't use C<map> in void contexts.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
C<map> and C<grep> are intended to be pure functions, not mutators.
|
||||
If you want to iterate with side-effects, then you should use a proper
|
||||
C<for> or C<foreach> loop.
|
||||
|
||||
grep{ print frobulate($_) } @list; #not ok
|
||||
print map{ frobulate($_) } @list; #ok
|
||||
|
||||
grep{ $_ = lc $_ } @list; #not ok
|
||||
for( @list ){ $_ = lc $_ }; #ok
|
||||
|
||||
map{ push @frobbed, frobulate($_) } @list; #not ok
|
||||
@frobbed = map { frobulate($_) } @list; #ok
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,103 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep;
|
||||
|
||||
# DEVELOPER NOTE: this module is used as an example in DEVELOPER.pod.
|
||||
# If you make changes in here, please reflect those changes in the
|
||||
# examples.
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification :ppi };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Expression form of "grep"};
|
||||
Readonly::Scalar my $EXPL => [ 169 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGH }
|
||||
sub default_themes { return qw( core bugs pbp ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem->content() ne 'grep';
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
my $arg = first_arg($elem);
|
||||
return if !$arg;
|
||||
return if $arg->isa('PPI::Structure::Block');
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep - Write C<grep { /$pattern/ } @list> instead of C<grep /$pattern/, @list>.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The expression forms of C<grep> and C<map> are awkward and hard to
|
||||
read. Use the block forms instead.
|
||||
|
||||
@matches = grep /pattern/, @list; #not ok
|
||||
@matches = grep { /pattern/ } @list; #ok
|
||||
|
||||
@mapped = map transform($_), @list; #not ok
|
||||
@mapped = map { transform($_) } @list; #ok
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval|Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval>
|
||||
|
||||
L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap|Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2013 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification :ppi };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Expression form of "map"};
|
||||
Readonly::Scalar my $EXPL => [ 169 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGH }
|
||||
sub default_themes { return qw( core bugs pbp ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem ne 'map';
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
my $arg = first_arg($elem);
|
||||
return if !$arg;
|
||||
return if $arg->isa('PPI::Structure::Block');
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap - Write C<map { /$pattern/ } @list> instead of C<map /$pattern/, @list>.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The expression forms of C<grep> and C<map> are awkward and hard to
|
||||
read. Use the block forms instead.
|
||||
|
||||
@matches = grep /pattern/, @list; #not ok
|
||||
@matches = grep { /pattern/ } @list; #ok
|
||||
|
||||
@mapped = map transform($_), @list; #not ok
|
||||
@mapped = map { transform($_) } @list; #ok
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval|Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval>
|
||||
|
||||
L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep|Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2013 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,93 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $GLOB_RX => qr< [*?] >xms;
|
||||
Readonly::Scalar my $DESC => q{Glob written as <...>};
|
||||
Readonly::Scalar my $EXPL => [ 167 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGHEST }
|
||||
sub default_themes { return qw( core pbp bugs ) }
|
||||
sub applies_to { return 'PPI::Token::QuoteLike::Readline' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
if ( $elem =~ $GLOB_RX ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction - Use C<glob q{*}> instead of <*>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway discourages the use of the C<< <..> >> construct for globbing, as
|
||||
it is easily confused with the angle bracket file input operator.
|
||||
Instead, he recommends the use of the C<glob()> function as it makes
|
||||
it much more obvious what you're attempting to do.
|
||||
|
||||
@files = <*.pl>; # not ok
|
||||
@files = glob '*.pl'; # ok
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Graham TerMarsch <graham@howlingfrog.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Graham TerMarsch. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,111 @@
|
|||
package Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Sort blocks should have a single statement};
|
||||
Readonly::Scalar my $EXPL => [ 149 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core pbp maintenance complexity) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem->content() ne 'sort';
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
my $sib = $elem->snext_sibling();
|
||||
return if !$sib;
|
||||
|
||||
my $arg = $sib;
|
||||
if ( $arg->isa('PPI::Structure::List') ) {
|
||||
$arg = $arg->schild(0);
|
||||
# Forward looking: PPI might change in v1.200 so schild(0) is a PPI::Statement::Expression
|
||||
if ( $arg && $arg->isa('PPI::Statement::Expression') ) {
|
||||
$arg = $arg->schild(0);
|
||||
}
|
||||
}
|
||||
return if !$arg || !$arg->isa('PPI::Structure::Block');
|
||||
|
||||
# If we get here, we found a sort with a block as the first arg
|
||||
return if ( 1 >= $arg->schildren() );
|
||||
|
||||
# more than one child statements
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock - Sort blocks should have a single statement.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway advises that sort functions should be simple. Any complicated
|
||||
operations on list elements should be computed and cached (perhaps via
|
||||
a Schwartzian Transform) before the sort, rather than computed inside
|
||||
the sort block, because the sort block is called C<N log N> times
|
||||
instead of just C<N> times.
|
||||
|
||||
This policy prohibits the most blatant case of complicated sort
|
||||
blocks: multiple statements. Future policies may wish to examine the
|
||||
sort block in more detail -- looking for subroutine calls or large
|
||||
numbers of operations.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,93 @@
|
|||
package Perl::Critic::Policy::ClassHierarchies::ProhibitAutoloading;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{AUTOLOAD method declared};
|
||||
Readonly::Scalar my $EXPL => [ 393 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core maintenance pbp ) }
|
||||
sub applies_to { return 'PPI::Statement::Sub' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self, $elem, undef) = @_;
|
||||
|
||||
if( $elem->name eq 'AUTOLOAD' ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ClassHierarchies::ProhibitAutoloading - AUTOLOAD methods should be avoided.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Declaring a subroutine with the name C<"AUTOLOAD"> will violate this
|
||||
Policy. The C<AUTOLOAD> mechanism is an easy way to generate methods
|
||||
for your classes, but unless they are carefully written, those classes
|
||||
are difficult to inherit from. And over time, the C<AUTOLOAD> method
|
||||
will become more and more complex as it becomes responsible for
|
||||
dispatching more and more functions. You're better off writing
|
||||
explicit accessor methods. Editor macros can help make this a little
|
||||
easier.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
package Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{@ISA used instead of "use base"}; ## no critic (RequireInterpolation)
|
||||
Readonly::Scalar my $EXPL => [ 360 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core maintenance pbp certrec ) }
|
||||
sub applies_to { return 'PPI::Token::Symbol' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self, $elem, undef) = @_;
|
||||
|
||||
if( $elem eq q{@ISA} ) { ## no critic (RequireInterpolation)
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA - Employ C<use base> instead of C<@ISA>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway recommends employing C<use base qw(Foo)> instead of the usual
|
||||
C<our @ISA = qw(Foo)> because the former happens at compile time and
|
||||
the latter at runtime. The L<base|base> pragma also automatically loads
|
||||
C<Foo> for you so you save a line of easily-forgotten code.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 NOTE
|
||||
|
||||
Some people prefer L<parent|parent> over L<base|base>.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,96 @@
|
|||
package Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :booleans :severities :classification :ppi };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{One-argument "bless" used};
|
||||
Readonly::Scalar my $EXPL => [ 365 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGHEST }
|
||||
sub default_themes { return qw( core pbp bugs ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self, $elem, undef) = @_;
|
||||
|
||||
return if $elem->content() ne 'bless';
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
if( scalar parse_arg_list($elem) == 1 ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless - Write C<bless {}, $class;> instead of just C<bless {};>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Always use the two-argument form of C<bless> because it allows
|
||||
subclasses to inherit your constructor.
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = bless {}; # not ok
|
||||
my $self = bless {}, $class; # ok
|
||||
return $self;
|
||||
}
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,162 @@
|
|||
package Perl::Critic::Policy::CodeLayout::ProhibitHardTabs;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :booleans :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Hard tabs used};
|
||||
Readonly::Scalar my $EXPL => [ 20 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
# The following regex should probably be "qr{^ .* [^\t]+ \t}xms" but it doesn't
|
||||
# match when I expect it to. I haven't figured out why, so I used "\S" to
|
||||
# approximately mean "not a tab", and that seemed to work.
|
||||
|
||||
Readonly::Scalar my $NON_LEADING_TAB_REGEX => qr{^ .* \S+ \t }xms;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'allow_leading_tabs',
|
||||
description => 'Allow hard tabs before first non-whitespace character.',
|
||||
default_string => '1',
|
||||
behavior => 'boolean',
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core cosmetic pbp ) }
|
||||
sub applies_to { return 'PPI::Token' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
$elem =~ m{ \t }xms || return;
|
||||
|
||||
# The __DATA__ element is exempt
|
||||
return if $elem->parent->isa('PPI::Statement::Data');
|
||||
|
||||
# If allowed, permit leading tabs in situations where whitespace s not significant.
|
||||
if ( $self->_allow_leading_tabs() ) {
|
||||
|
||||
return if $elem->location->[1] == 1;
|
||||
|
||||
return if _is_extended_regex($elem)
|
||||
&& $elem !~ $NON_LEADING_TAB_REGEX;
|
||||
|
||||
return if $elem->isa('PPI::Token::QuoteLike::Words')
|
||||
&& $elem !~ $NON_LEADING_TAB_REGEX;
|
||||
}
|
||||
|
||||
# If we get here, then it must be a violation...
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _allow_leading_tabs {
|
||||
my ( $self ) = @_;
|
||||
return $self->{_allow_leading_tabs};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _is_extended_regex {
|
||||
my ($elem) = @_;
|
||||
|
||||
$elem->isa('PPI::Token::Regexp')
|
||||
|| $elem->isa('PPI::Token::QuoteLike::Regexp')
|
||||
|| return;
|
||||
|
||||
# Look for the /x modifier near the end
|
||||
return $elem =~ m{\b [gimso]* x [gimso]* $}xms;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::CodeLayout::ProhibitHardTabs - Use spaces instead of tabs.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Putting hard tabs in your source code (or POD) is one of the worst
|
||||
things you can do to your co-workers and colleagues, especially if
|
||||
those tabs are anywhere other than a leading position. Because
|
||||
various applications and devices represent tabs differently, they can
|
||||
cause you code to look vastly different to other people. Any decent
|
||||
editor can be configured to expand tabs into spaces.
|
||||
L<Perl::Tidy|Perl::Tidy> also does this for you.
|
||||
|
||||
This Policy catches all tabs in your source code, including POD,
|
||||
quotes, and HEREDOCs. The contents of the C<__DATA__> section are not
|
||||
examined.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
Hard tabs in a string are always forbidden (use "\t" instead). But
|
||||
hard tabs in a leading position are allowed when they are used to indent
|
||||
code statements, C<qw()> word lists, and regular expressions with the C</x>
|
||||
modifier. However, if you want to forbid all tabs everywhere, then add
|
||||
this to your F<.perlcriticrc> file:
|
||||
|
||||
[CodeLayout::ProhibitHardTabs]
|
||||
allow_leading_tabs = 0
|
||||
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
Beware that Perl::Critic may report the location of the string that
|
||||
contains the tab, not the actual location of the tab, so you may need
|
||||
to do some hunting. I'll try and fix this in the future.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
##############################################################################
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,259 @@
|
|||
package Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{
|
||||
:booleans :severities :data_conversion :classification :language
|
||||
};
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array my @ALLOW => qw( my our local return state );
|
||||
Readonly::Hash my %ALLOW => hashify( @ALLOW );
|
||||
|
||||
Readonly::Scalar my $DESC => q{Builtin function called with parentheses};
|
||||
Readonly::Scalar my $EXPL => [ 13 ];
|
||||
|
||||
Readonly::Scalar my $PRECENDENCE_OF_LIST => precedence_of(q{>>}) + 1;
|
||||
Readonly::Scalar my $PRECEDENCE_OF_COMMA => precedence_of(q{,});
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# These are all the functions that are considered named unary
|
||||
# operators. These frequently require parentheses because they have lower
|
||||
# precedence than ordinary function calls.
|
||||
|
||||
Readonly::Array my @NAMED_UNARY_OPS => qw(
|
||||
alarm glob rand
|
||||
caller gmtime readlink
|
||||
chdir hex ref
|
||||
chroot int require
|
||||
cos lc return
|
||||
defined lcfirst rmdir
|
||||
delete length scalar
|
||||
do localtime sin
|
||||
eval lock sleep
|
||||
exists log sqrt
|
||||
exit lstat srand
|
||||
getgrp my stat
|
||||
gethostbyname oct uc
|
||||
getnetbyname ord ucfirst
|
||||
getprotobyname quotemeta umask
|
||||
undef
|
||||
);
|
||||
Readonly::Hash my %NAMED_UNARY_OPS => hashify( @NAMED_UNARY_OPS );
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOWEST }
|
||||
sub default_themes { return qw( core pbp cosmetic ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if exists $ALLOW{$elem};
|
||||
return if not is_perl_builtin($elem);
|
||||
return if not is_function_call($elem);
|
||||
|
||||
my $sibling = $elem->snext_sibling();
|
||||
return if not $sibling;
|
||||
if ( $sibling->isa('PPI::Structure::List') ) {
|
||||
my $elem_after_parens = $sibling->snext_sibling();
|
||||
|
||||
return if _is_named_unary_with_operator_inside_parens_exemption($elem, $sibling);
|
||||
return if _is_named_unary_with_operator_following_parens_exemption($elem, $elem_after_parens);
|
||||
return if _is_precedence_exemption($elem_after_parens);
|
||||
return if _is_equals_exemption($sibling);
|
||||
return if _is_sort_exemption($elem, $sibling);
|
||||
|
||||
# If we get here, it must be a violation
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# EXCEPTION 1: If the function is a named unary and there is an
|
||||
# operator with higher precedence right after the parentheses.
|
||||
# Example: int( 1.5 ) + 0.5;
|
||||
|
||||
sub _is_named_unary_with_operator_following_parens_exemption {
|
||||
my ($elem, $elem_after_parens) = @_;
|
||||
|
||||
if ( _is_named_unary( $elem ) && $elem_after_parens ){
|
||||
# Smaller numbers mean higher precedence
|
||||
my $precedence = precedence_of( $elem_after_parens );
|
||||
return $TRUE if defined $precedence && $precedence < $PRECENDENCE_OF_LIST;
|
||||
}
|
||||
|
||||
return $FALSE;
|
||||
}
|
||||
|
||||
sub _is_named_unary {
|
||||
my ($elem) = @_;
|
||||
|
||||
return exists $NAMED_UNARY_OPS{$elem->content};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# EXCEPTION 2, If there is an operator immediately after the
|
||||
# parentheses, and that operator has precedence greater than
|
||||
# or equal to a comma.
|
||||
# Example: join($delim, @list) . "\n";
|
||||
|
||||
sub _is_precedence_exemption {
|
||||
my ($elem_after_parens) = @_;
|
||||
|
||||
if ( $elem_after_parens ){
|
||||
# Smaller numbers mean higher precedence
|
||||
my $precedence = precedence_of( $elem_after_parens );
|
||||
return $TRUE if defined $precedence && $precedence <= $PRECEDENCE_OF_COMMA;
|
||||
}
|
||||
|
||||
return $FALSE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# EXCEPTION 3: If the first operator within the parentheses is '='
|
||||
# Example: chomp( my $foo = <STDIN> );
|
||||
|
||||
sub _is_equals_exemption {
|
||||
my ($sibling) = @_;
|
||||
|
||||
if ( my $first_op = $sibling->find_first('PPI::Token::Operator') ){
|
||||
return $TRUE if $first_op eq q{=};
|
||||
}
|
||||
|
||||
return $FALSE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# EXCEPTION 4: sort with default comparator but a function for the list data
|
||||
# Example: sort(foo(@x))
|
||||
|
||||
sub _is_sort_exemption {
|
||||
my ($elem, $sibling) = @_;
|
||||
|
||||
if ( $elem eq 'sort' ) {
|
||||
my $first_arg = $sibling->schild(0);
|
||||
if ( $first_arg && $first_arg->isa('PPI::Statement::Expression') ) {
|
||||
$first_arg = $first_arg->schild(0);
|
||||
}
|
||||
if ( $first_arg && $first_arg->isa('PPI::Token::Word') ) {
|
||||
my $next_arg = $first_arg->snext_sibling;
|
||||
return $TRUE if $next_arg && $next_arg->isa('PPI::Structure::List');
|
||||
}
|
||||
}
|
||||
|
||||
return $FALSE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# EXCEPTION 5: If the function is a named unary and there is an operator
|
||||
# inside the parentheses.
|
||||
# Example: length($foo || $bar);
|
||||
|
||||
sub _is_named_unary_with_operator_inside_parens_exemption {
|
||||
my ($elem, $parens) = @_;
|
||||
return _is_named_unary($elem) && _contains_operators($parens);
|
||||
}
|
||||
|
||||
sub _contains_operators {
|
||||
my ($parens) = @_;
|
||||
return $TRUE if $parens->find_first('PPI::Token::Operator');
|
||||
return $FALSE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords disambiguates builtins
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins - Write C<open $handle, $path> instead of C<open($handle, $path)>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway suggests that all built-in functions be called without
|
||||
parentheses around the argument list. This reduces visual clutter and
|
||||
disambiguates built-in functions from user functions. Exceptions are
|
||||
made for C<my>, C<local>, and C<our> which require parentheses when
|
||||
called with multiple arguments.
|
||||
|
||||
open($handle, '>', $filename); #not ok
|
||||
open $handle, '>', $filename; #ok
|
||||
|
||||
split(/$pattern/, @list); #not ok
|
||||
split /$pattern/, @list; #ok
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
Coding with parentheses can sometimes lead to verbose and awkward
|
||||
constructs, so I think the intent of Conway's guideline is to remove
|
||||
only the F<unnecessary> parentheses. This policy makes exceptions for
|
||||
some common situations where parentheses are usually required.
|
||||
However, you may find other situations where the parentheses are
|
||||
necessary to enforce precedence, but they cause still violations. In
|
||||
those cases, consider using the '## no critic' comments to silence
|
||||
Perl::Critic.
|
||||
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Some builtin functions (particularly those that take a variable number
|
||||
of scalar arguments) should probably get parentheses. This policy
|
||||
should be enhanced to allow the user to specify a list of builtins
|
||||
that are exempt from the policy.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,181 @@
|
|||
package Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :characters :severities :classification};
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{List of quoted literal words};
|
||||
Readonly::Scalar my $EXPL => q{Use 'qw()' instead};
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'min_elements',
|
||||
description => 'The minimum number of words in a list that will be complained about.',
|
||||
default_string => '2',
|
||||
behavior => 'integer',
|
||||
integer_minimum => 1,
|
||||
},
|
||||
{
|
||||
name => 'strict',
|
||||
description => 'Complain even if there are non-word characters in the values.',
|
||||
default_string => '0',
|
||||
behavior => 'boolean',
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_LOW }
|
||||
sub default_themes { return qw( core cosmetic ) }
|
||||
sub applies_to { return 'PPI::Structure::List' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
# Don't worry about subroutine calls
|
||||
my $sibling = $elem->sprevious_sibling();
|
||||
return if not $sibling;
|
||||
|
||||
return if $sibling->isa('PPI::Token::Symbol');
|
||||
return if $sibling->isa('PPI::Token::Operator') and $sibling eq '->';
|
||||
return if $sibling->isa('PPI::Token::Word') and not is_included_module_name($sibling);
|
||||
|
||||
# Get the list elements
|
||||
my $expr = $elem->schild(0);
|
||||
return if not $expr;
|
||||
my @children = $expr->schildren();
|
||||
return if not @children;
|
||||
|
||||
my $count = 0;
|
||||
for my $child ( @children ) {
|
||||
next if $child->isa('PPI::Token::Operator') && $child eq $COMMA;
|
||||
|
||||
# All elements must be literal strings,
|
||||
# and must contain 1 or more word characters.
|
||||
|
||||
return if not _is_literal($child);
|
||||
|
||||
my $string = $child->string();
|
||||
return if $string =~ m{ \s }xms;
|
||||
return if $string eq $EMPTY;
|
||||
return if not $self->{_strict} and $string !~ m{\A [\w-]+ \z}xms;
|
||||
$count++;
|
||||
}
|
||||
|
||||
# Were there enough?
|
||||
return if $count < $self->{_min_elements};
|
||||
|
||||
# If we get here, then all elements were literals
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
sub _is_literal {
|
||||
my $elem = shift;
|
||||
return $elem->isa('PPI::Token::Quote::Single')
|
||||
|| $elem->isa('PPI::Token::Quote::Literal');
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists - Write C<qw(foo bar baz)> instead of C<('foo', 'bar', 'baz')>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway doesn't mention this, but I think C<qw()> is an underused
|
||||
feature of Perl. Whenever you need to declare a list of one-word
|
||||
literals, the C<qw()> operator is wonderfully concise, and makes it
|
||||
easy to add to the list in the future.
|
||||
|
||||
@list = ('foo', 'bar', 'baz'); #not ok
|
||||
@list = qw(foo bar baz); #ok
|
||||
|
||||
use Foo ('foo', 'bar', 'baz'); #not ok
|
||||
use Foo qw(foo bar baz); #ok
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This policy can be configured to only pay attention to word lists with
|
||||
at least a particular number of elements. By default, this value is
|
||||
2, which means that lists containing zero or one elements are ignored.
|
||||
The minimum list size to be looked at can be specified by giving a
|
||||
value for C<min_elements> in F<.perlcriticrc> like this:
|
||||
|
||||
[CodeLayout::ProhibitQuotedWordLists]
|
||||
min_elements = 4
|
||||
|
||||
This would cause this policy to only complain about lists containing
|
||||
four or more words.
|
||||
|
||||
By default, this policy won't complain if any of the values in the list
|
||||
contain non-word characters. If you want it to, set the C<strict>
|
||||
option to a true value.
|
||||
|
||||
[CodeLayout::ProhibitQuotedWordLists]
|
||||
strict = 1
|
||||
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
In the PPI parlance, a "list" is almost anything with parentheses.
|
||||
I've tried to make this Policy smart by targeting only "lists" that
|
||||
could be sensibly expressed with C<qw()>. However, there may be some
|
||||
edge cases that I haven't covered. If you find one, send me a note.
|
||||
|
||||
|
||||
=head1 IMPORTANT CHANGES
|
||||
|
||||
This policy was formerly called C<RequireQuotedWords> which seemed a
|
||||
little counter-intuitive. If you get lots of "Cannot load policy
|
||||
module" errors, then you probably need to change C<RequireQuotedWords>
|
||||
to C<ProhibitQuotedWordLists> in your F<.perlcriticrc> file.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,143 @@
|
|||
package Perl::Critic::Policy::CodeLayout::ProhibitTrailingWhitespace;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use English qw(-no_match_vars);
|
||||
use Readonly;
|
||||
|
||||
use charnames qw{};
|
||||
|
||||
use PPI::Token::Whitespace;
|
||||
use Perl::Critic::Utils qw{ :characters :severities };
|
||||
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $EXPL => q{Don't use whitespace at the end of lines};
|
||||
|
||||
## no critic (RequireInterpolationOfMetachars)
|
||||
Readonly::Hash my %C_STYLE_ESCAPES =>
|
||||
(
|
||||
ord "\t" => q{\t},
|
||||
ord "\n" => q{\n},
|
||||
ord "\r" => q{\r},
|
||||
ord "\f" => q{\f},
|
||||
ord "\b" => q{\b},
|
||||
ord "\a" => q{\a},
|
||||
ord "\e" => q{\e},
|
||||
);
|
||||
## use critic
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return qw{ } }
|
||||
sub default_severity { return $SEVERITY_LOWEST }
|
||||
sub default_themes { return qw( core maintenance ) }
|
||||
sub applies_to { return 'PPI::Token::Whitespace' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $token, undef ) = @_;
|
||||
|
||||
if ( $token->content() =~ m< ( (?! \n) \s )+ \n >xms ) {
|
||||
my $extra_whitespace = $1;
|
||||
|
||||
my $description = q{Found "};
|
||||
$description .=
|
||||
join
|
||||
$EMPTY,
|
||||
map { _escape($_) } split $EMPTY, $extra_whitespace;
|
||||
$description .= q{" at the end of the line};
|
||||
|
||||
return $self->violation( $description, $EXPL, $token );
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _escape {
|
||||
my $character = shift;
|
||||
my $ordinal = ord $character;
|
||||
|
||||
if (my $c_escape = $C_STYLE_ESCAPES{$ordinal}) {
|
||||
return $c_escape;
|
||||
}
|
||||
|
||||
|
||||
# Apparently, the charnames.pm that ships with older perls does not
|
||||
# support the C<viacode> function, and newer versions of the module are
|
||||
# not distributed separately from perl itself So if the C<viacode> method
|
||||
# is not supported, then just substitute something.
|
||||
|
||||
|
||||
## no critic (RequireInterpolationOfMetachars)
|
||||
if ( charnames->can( 'viacode' ) ) {
|
||||
return q/\N{/ . charnames::viacode($ordinal) . q/}/;
|
||||
}
|
||||
else {
|
||||
return '\N{WHITESPACE CHAR}';
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::CodeLayout::ProhibitTrailingWhitespace - Don't use whitespace at the end of lines.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Anything that is not readily visually detectable is a bad thing in
|
||||
general, and more specifically, as different people edit the same
|
||||
code, their editors may automatically strip out trailing whitespace,
|
||||
causing spurious differences between different versions of the same
|
||||
file (i.e. code in a source control system).
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank C<< <perl@galumph.com> >>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,125 @@
|
|||
package Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities };
|
||||
use PPI::Token::Whitespace;
|
||||
use English qw(-no_match_vars);
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
Readonly::Scalar my $LINE_END => qr/\015{1,2}\012|[\012\015]/mxs;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Use the same newline through the source};
|
||||
Readonly::Scalar my $EXPL => q{Change your newlines to be the same throughout};
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGH }
|
||||
sub default_themes { return qw( core bugs ) }
|
||||
sub applies_to { return 'PPI::Document' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, undef, $doc ) = @_;
|
||||
|
||||
my $filename = $doc->filename();
|
||||
return if !$filename;
|
||||
|
||||
my $fh;
|
||||
return if !open $fh, '<', $filename;
|
||||
local $RS = undef;
|
||||
my $source = <$fh>;
|
||||
close $fh or return;
|
||||
|
||||
my $newline; # undef until we find the first one
|
||||
my $line = 1;
|
||||
my @v;
|
||||
while ( $source =~ m/\G([^\012\015]*)($LINE_END)/cgmxs ) {
|
||||
my $code = $1;
|
||||
my $nl = $2;
|
||||
my $col = length $code;
|
||||
$newline ||= $nl;
|
||||
if ( $nl ne $newline ) {
|
||||
my $token = PPI::Token::Whitespace->new( $nl );
|
||||
# TODO this is a terrible violation of encapsulation, but absent a
|
||||
# mechanism to override the line numbers in the violation, I do
|
||||
# not know what to do about it.
|
||||
$token->{_location} = [$line, $col, $col, $line, $filename];
|
||||
push @v, $self->violation( $DESC, $EXPL, $token );
|
||||
}
|
||||
$line++;
|
||||
}
|
||||
return @v;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords GnuPG
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines - Use the same newline through the source.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Source code files are divided into lines with line endings of C<\r>,
|
||||
C<\n> or C<\r\n>. Mixing these different line endings causes problems
|
||||
in many text editors and, notably, Module::Signature and GnuPG.
|
||||
|
||||
|
||||
=head1 CAVEAT
|
||||
|
||||
This policy works outside of PPI because PPI automatically normalizes
|
||||
source code to local newline conventions. So, this will only work if
|
||||
we know the filename of the source code.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,206 @@
|
|||
package Perl::Critic::Policy::CodeLayout::RequireTidyCode;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use English qw(-no_match_vars);
|
||||
use IO::String qw< >;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Tidy qw< >;
|
||||
|
||||
use Perl::Critic::Utils qw{ :booleans :characters :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Code is not tidy};
|
||||
Readonly::Scalar my $EXPL => [ 33 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'perltidyrc',
|
||||
description => 'The Perl::Tidy configuration file to use, if any.',
|
||||
default_string => undef,
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_LOWEST }
|
||||
sub default_themes { return qw(core pbp cosmetic) }
|
||||
sub applies_to { return 'PPI::Document' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub initialize_if_enabled {
|
||||
my ($self, $config) = @_;
|
||||
|
||||
# Set configuration if defined
|
||||
if (defined $self->{_perltidyrc} && $self->{_perltidyrc} eq $EMPTY) {
|
||||
my $rc = $EMPTY;
|
||||
$self->{_perltidyrc} = \$rc;
|
||||
}
|
||||
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, $doc ) = @_;
|
||||
|
||||
# Perl::Tidy seems to produce slightly different output, depending
|
||||
# on the trailing whitespace in the input. As best I can tell,
|
||||
# Perl::Tidy will truncate any extra trailing newlines, and if the
|
||||
# input has no trailing newline, then it adds one. But when you
|
||||
# re-run it through Perl::Tidy here, that final newline gets lost,
|
||||
# which causes the policy to insist that the code is not tidy.
|
||||
# This only occurs when Perl::Tidy is writing the output to a
|
||||
# scalar, but does not occur when writing to a file. I may
|
||||
# investigate further, but for now, this seems to do the trick.
|
||||
|
||||
my $source = $doc->serialize();
|
||||
$source =~ s{ \s+ \Z}{\n}xms;
|
||||
|
||||
# Remove the shell fix code from the top of program, if applicable
|
||||
## no critic (ProhibitComplexRegexes)
|
||||
my $shebang_re = qr< [#]! [^\015\012]+ [\015\012]+ >xms;
|
||||
my $shell_re = qr<eval [ ] 'exec [ ] [^\015\012]* [ ] \$0 [ ] \$[{]1[+]"\$@"}'
|
||||
[ \t]*[\012\015]+ [ \t]* if [^\015\012]+ [\015\012]+ >xms;
|
||||
$source =~ s/\A ($shebang_re) $shell_re /$1/xms;
|
||||
|
||||
my $dest = $EMPTY;
|
||||
my $stderr = $EMPTY;
|
||||
|
||||
|
||||
# Perl::Tidy gets confused if @ARGV has arguments from
|
||||
# another program. Also, we need to override the
|
||||
# stdout and stderr redirects that the user may have
|
||||
# configured in their .perltidyrc file.
|
||||
# Also override -b because we are using dest and source.
|
||||
local @ARGV = qw(-nst -nse -nb);
|
||||
|
||||
# Trap Perl::Tidy errors, just in case it dies
|
||||
my $eval_worked = eval {
|
||||
|
||||
# Perl::Tidy 20120619 no longer accepts a scalar reference for stdio.
|
||||
my $handle = IO::String->new( $stderr );
|
||||
|
||||
# Beginning with version 20120619, Perl::Tidy modifies $source. So we
|
||||
# make a copy so we can get a good comparison after tidying. Doing an
|
||||
# s/// on $source after the fact appears not to work with previous
|
||||
# versions of Perl::Tidy.
|
||||
my $source_copy = $source;
|
||||
|
||||
# In version 20120619 (and possibly earlier), Perl::Tidy assigns the
|
||||
# stderr parameter directly to *STDERR. So when our $stderr goes out
|
||||
# of scope, the handle gets closed. Subsequent calls to warn() will
|
||||
# then cause a fatal exception. See RT #78182 for more details. In
|
||||
# the meantime, we workaround it by localizing STDERR first.
|
||||
local *STDERR = \*STDERR;
|
||||
|
||||
Perl::Tidy::perltidy(
|
||||
source => \$source_copy,
|
||||
destination => \$dest,
|
||||
stderr => $handle,
|
||||
defined $self->{_perltidyrc} ? (perltidyrc => $self->{_perltidyrc}) : (),
|
||||
);
|
||||
1;
|
||||
};
|
||||
|
||||
if ($stderr or not $eval_worked) {
|
||||
# Looks like perltidy had problems
|
||||
return $self->violation( 'perltidy had errors!!', $EXPL, $elem );
|
||||
}
|
||||
|
||||
if ( $source ne $dest ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords perltidy
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::CodeLayout::RequireTidyCode - Must run code through L<perltidy|perltidy>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway does make specific recommendations for whitespace and
|
||||
curly-braces in your code, but the most important thing is to adopt a
|
||||
consistent layout, regardless of the specifics. And the easiest way
|
||||
to do that is to use L<Perl::Tidy|Perl::Tidy>. This policy will
|
||||
complain if you're code hasn't been run through Perl::Tidy.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This policy can be configured to tell Perl::Tidy to use a particular
|
||||
F<perltidyrc> file or no configuration at all. By default, Perl::Tidy
|
||||
is told to look in its default location for configuration.
|
||||
Perl::Critic can be told to tell Perl::Tidy to use a specific
|
||||
configuration file by putting an entry in a F<.perlcriticrc> file like
|
||||
this:
|
||||
|
||||
[CodeLayout::RequireTidyCode]
|
||||
perltidyrc = /usr/share/perltidy.conf
|
||||
|
||||
As a special case, setting C<perltidyrc> to the empty string tells
|
||||
Perl::Tidy not to load any configuration file at all and just use
|
||||
Perl::Tidy's own default style.
|
||||
|
||||
[CodeLayout::RequireTidyCode]
|
||||
perltidyrc =
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Tidy|Perl::Tidy>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,123 @@
|
|||
package Perl::Critic::Policy::CodeLayout::RequireTrailingCommas;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :characters :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{List declaration without trailing comma};
|
||||
Readonly::Scalar my $EXPL => [ 17 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOWEST }
|
||||
sub default_themes { return qw(core pbp cosmetic) }
|
||||
sub applies_to { return 'PPI::Structure::List' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
$elem =~ m{ \n }xms || return;
|
||||
|
||||
# Is it an assignment of some kind?
|
||||
my $sib = $elem->sprevious_sibling();
|
||||
return if !$sib;
|
||||
$sib->isa('PPI::Token::Operator') && $sib =~ m{ = }xms || return;
|
||||
|
||||
# List elements are children of an expression
|
||||
my $expr = $elem->schild(0);
|
||||
return if !$expr;
|
||||
|
||||
# Does the list have more than 1 element?
|
||||
# This means list element, not PPI element.
|
||||
my @children = $expr->schildren();
|
||||
return if 1 >= grep { $_->isa('PPI::Token::Operator')
|
||||
&& $_ eq $COMMA } @children;
|
||||
|
||||
# Is the final element a comma?
|
||||
my $final = $children[-1];
|
||||
if ( ! ($final->isa('PPI::Token::Operator') && $final eq $COMMA) ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::CodeLayout::RequireTrailingCommas - Put a comma at the end of every multi-line list declaration, including the last one.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway suggests that all elements in a multi-line list should be
|
||||
separated by commas, including the last element. This makes it a
|
||||
little easier to re-order the list by cutting and pasting.
|
||||
|
||||
my @list = ($foo,
|
||||
$bar,
|
||||
$baz); #not ok
|
||||
|
||||
my @list = ($foo,
|
||||
$bar,
|
||||
$baz,); #ok
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
In the PPI parlance, a "list" is almost anything with parentheses.
|
||||
I've tried to make this Policy smart by targeting only "lists" that
|
||||
have at least one element and are being assigned to something.
|
||||
However, there may be some edge cases that I haven't covered. If you
|
||||
find one, send me a note.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,103 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :characters :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{C-style "for" loop used};
|
||||
Readonly::Scalar my $EXPL => [ 100 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOW }
|
||||
sub default_themes { return qw( core pbp maintenance ) }
|
||||
sub applies_to { return 'PPI::Structure::For' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
if ( _is_cstyle($elem) ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
sub _is_cstyle {
|
||||
my $elem = shift;
|
||||
my $nodes_ref = $elem->find('PPI::Token::Structure');
|
||||
return if !$nodes_ref;
|
||||
my @semis = grep { $_ eq $SCOLON } @{$nodes_ref};
|
||||
return scalar @semis == 2;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops - Write C<for(0..20)> instead of C<for($i=0; $i<=20; $i++)>.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The 3-part C<for> loop that Perl inherits from C is butt-ugly, and
|
||||
only really necessary if you need irregular counting. The very
|
||||
Perlish C<..> operator is much more elegant and readable.
|
||||
|
||||
for($i=0; $i<=$max; $i++){ #ick!
|
||||
do_something($i);
|
||||
}
|
||||
|
||||
for(0..$max){ #very nice
|
||||
do_something($_);
|
||||
}
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,129 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Cascading if-elsif chain};
|
||||
Readonly::Scalar my $EXPL => [ 117, 118 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'max_elsif',
|
||||
description => 'The maximum number of alternatives that will be allowed.',
|
||||
default_string => '2',
|
||||
behavior => 'integer',
|
||||
integer_minimum => 1,
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core pbp maintenance complexity ) }
|
||||
sub applies_to { return 'PPI::Statement::Compound' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if ($elem->type() ne 'if');
|
||||
|
||||
if ( _count_elsifs($elem) > $self->{_max_elsif} ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
sub _count_elsifs {
|
||||
my $elem = shift;
|
||||
return
|
||||
grep { $_->isa('PPI::Token::Word') && $_->content() eq 'elsif' } $elem->schildren();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords lookup
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse - Don't write long "if-elsif-elsif-elsif-elsif...else" chains.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Long C<if-elsif> chains are hard to digest, especially if they are
|
||||
longer than a single page or screen. If testing for equality, use a
|
||||
hash lookup instead. If you're using perl 5.10 or later, use
|
||||
C<given>/C<when>.
|
||||
|
||||
if ($condition1) { #ok
|
||||
$foo = 1;
|
||||
}
|
||||
elsif ($condition2) { #ok
|
||||
$foo = 2;
|
||||
}
|
||||
elsif ($condition3) { #ok
|
||||
$foo = 3;
|
||||
}
|
||||
elsif ($condition4) { #too many!
|
||||
$foo = 4;
|
||||
}
|
||||
else { #ok
|
||||
$foo = $default;
|
||||
}
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This policy can be configured with a maximum number of C<elsif>
|
||||
alternatives to allow. The default is 2. This can be specified via a
|
||||
C<max_elsif> item in the F<.perlcriticrc> file:
|
||||
|
||||
[ControlStructures::ProhibitCascadingIfElse]
|
||||
max_elsif = 3
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,118 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitDeepNests;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Code structure is deeply nested};
|
||||
Readonly::Scalar my $EXPL => q{Consider refactoring};
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'max_nests',
|
||||
description => 'The maximum number of nested constructs to allow.',
|
||||
default_string => '5',
|
||||
behavior => 'integer',
|
||||
integer_minimum => 1,
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw(core maintenance complexity) }
|
||||
sub applies_to { return 'PPI::Statement::Compound' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
my $nest_count = 1; #For _this_ element
|
||||
my $parent = $elem;
|
||||
|
||||
while ( $parent = $parent->parent() ){
|
||||
if( $parent->isa('PPI::Statement::Compound') ) {
|
||||
$nest_count++;
|
||||
}
|
||||
}
|
||||
|
||||
if ( $nest_count > $self->{_max_nests} ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords refactored
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitDeepNests - Don't write deeply nested loops and conditionals.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Deeply nested code is often hard to understand and may be a sign that
|
||||
it needs to be refactored. There are several good books on how to
|
||||
refactor code. I like Martin Fowler's "Refactoring: Improving The
|
||||
Design of Existing Code".
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
The maximum number of nested control structures can be configured via
|
||||
a value for C<max_nests> in a F<.perlcriticrc> file. Each for-loop,
|
||||
if-else, while, and until block is counted as one nest. Postfix forms
|
||||
of these constructs are not counted. The default maximum is 5.
|
||||
Customization in a F<.perlcriticrc> file looks like this:
|
||||
|
||||
[ControlStructures::ProhibitDeepNests]
|
||||
max_nests = 3
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,118 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities hashify };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
Readonly::Hash my %SPECIAL_BLOCK_NAMES =>
|
||||
hashify( qw< BEGIN END INIT CHECK UNITCHECK > );
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q<Special block name used as label.>;
|
||||
Readonly::Scalar my $EXPL =>
|
||||
q<Use a label that cannot be confused with BEGIN, END, CHECK, INIT, or UNITCHECK blocks.>;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGH }
|
||||
sub default_themes { return qw< core bugs > }
|
||||
sub applies_to { return qw< PPI::Token::Label > }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self, $elem, undef) = @_;
|
||||
|
||||
# Does the function call have enough arguments?
|
||||
my $label = $elem->content();
|
||||
$label =~ s/ \s* : \z //xms;
|
||||
return if not $SPECIAL_BLOCK_NAMES{ $label };
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=for stopwords Lauen O'Regan
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames - Don't use labels that are the same as the special block names.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
When using one of the special Perl blocks C<BEGIN>, C<END>, C<CHECK>,
|
||||
C<INIT>, and C<UNITCHECK>, it is easy to mistakenly add a colon to the
|
||||
end of the block name. E.g.:
|
||||
|
||||
# a BEGIN block that gets executed at compile time.
|
||||
BEGIN { <...code...> }
|
||||
|
||||
# an ordinary labeled block that gets executed at run time.
|
||||
BEGIN: { <...code...> }
|
||||
|
||||
The labels "BEGIN:", "END:", etc. are probably errors. This policy
|
||||
prohibits the special Perl block names from being used as labels.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
The Perl Buzz article on this issue at
|
||||
L<http://perlbuzz.com/2008/05/colons-invalidate-your-begin-and-end-blocks.html>.
|
||||
|
||||
|
||||
=head1 ACKNOWLEDGMENT
|
||||
|
||||
Randy Lauen for identifying the problem.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Mike O'Regan
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2008-2011 Mike O'Regan. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,348 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use List::MoreUtils qw( none any );
|
||||
|
||||
use Perl::Critic::Utils qw{
|
||||
:booleans :characters :severities :data_conversion :classification :ppi
|
||||
};
|
||||
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Array my @BUILTIN_LIST_FUNCS => qw( map grep );
|
||||
Readonly::Array my @CPAN_LIST_FUNCS => _get_cpan_list_funcs();
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_cpan_list_funcs {
|
||||
return qw( List::Util::first ),
|
||||
map { 'List::MoreUtils::'.$_ } _get_list_moreutils_funcs();
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_list_moreutils_funcs {
|
||||
return qw(any all none notall true false firstidx first_index
|
||||
lastidx last_index insert_after insert_after_string);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _is_topic {
|
||||
my $elem = shift;
|
||||
return defined $elem
|
||||
&& $elem->isa('PPI::Token::Magic')
|
||||
&& $elem->content() eq q{$_}; ##no critic (InterpolationOfMetachars)
|
||||
}
|
||||
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Don't modify $_ in list functions}; ##no critic (InterpolationOfMetachars)
|
||||
Readonly::Scalar my $EXPL => [ 114 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'list_funcs',
|
||||
description => 'The base set of functions to check.',
|
||||
default_string => join ($SPACE, @BUILTIN_LIST_FUNCS, @CPAN_LIST_FUNCS ),
|
||||
behavior => 'string list',
|
||||
},
|
||||
{
|
||||
name => 'add_list_funcs',
|
||||
description => 'The set of functions to check, in addition to those given in list_funcs.',
|
||||
default_string => $EMPTY,
|
||||
behavior => 'string list',
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_HIGHEST }
|
||||
sub default_themes { return qw(core bugs pbp certrule ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub initialize_if_enabled {
|
||||
my ($self, $config) = @_;
|
||||
|
||||
$self->{_all_list_funcs} = {
|
||||
hashify keys %{ $self->{_list_funcs} }, keys %{ $self->{_add_list_funcs} }
|
||||
};
|
||||
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self, $elem, $doc) = @_;
|
||||
|
||||
# Is this element a list function?
|
||||
return if not $self->{_all_list_funcs}->{$elem};
|
||||
return if not is_function_call($elem);
|
||||
|
||||
# Only the block form of list functions can be analyzed.
|
||||
return if not my $first_arg = first_arg( $elem );
|
||||
return if not $first_arg->isa('PPI::Structure::Block');
|
||||
return if not $self->_has_topic_side_effect( $first_arg, $doc );
|
||||
|
||||
# Must be a violation
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _has_topic_side_effect {
|
||||
my ( $self, $node, $doc ) = @_;
|
||||
|
||||
# Search through all significant elements in the block,
|
||||
# testing each element to see if it mutates the topic.
|
||||
my $tokens = $node->find( 'PPI::Token' ) || [];
|
||||
for my $elem ( @{ $tokens } ) {
|
||||
next if not $elem->significant();
|
||||
return 1 if _is_assignment_to_topic( $elem );
|
||||
return 1 if $self->_is_topic_mutating_regex( $elem, $doc );
|
||||
return 1 if _is_topic_mutating_func( $elem );
|
||||
return 1 if _is_topic_mutating_substr( $elem );
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _is_assignment_to_topic {
|
||||
my $elem = shift;
|
||||
return if not _is_topic( $elem );
|
||||
|
||||
my $sib = $elem->snext_sibling();
|
||||
if ($sib && $sib->isa('PPI::Token::Operator')) {
|
||||
return 1 if _is_assignment_operator( $sib );
|
||||
}
|
||||
|
||||
my $psib = $elem->sprevious_sibling();
|
||||
if ($psib && $psib->isa('PPI::Token::Operator')) {
|
||||
return 1 if _is_increment_operator( $psib );
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _is_topic_mutating_regex {
|
||||
my ( $self, $elem, $doc ) = @_;
|
||||
return if ! ( $elem->isa('PPI::Token::Regexp::Substitute')
|
||||
|| $elem->isa('PPI::Token::Regexp::Transliterate') );
|
||||
|
||||
# Exempt PPI::Token::Regexp::Transliterate objects IF the replacement
|
||||
# string is empty AND neither the /d or /s flags are specified, OR the
|
||||
# replacement string equals the match string AND neither the /c or /s
|
||||
# flags are specified. RT 44515.
|
||||
#
|
||||
# NOTE that, at least as of 5.14.2, tr/// does _not_ participate in the
|
||||
# 'use re /modifiers' mechanism. And a good thing, too, since the
|
||||
# modifiers that _are_ common (/s and /d) mean something completely
|
||||
# different in tr///.
|
||||
if ( $elem->isa( 'PPI::Token::Regexp::Transliterate') ) {
|
||||
my $subs = $elem->get_substitute_string();
|
||||
my %mods = $elem->get_modifiers();
|
||||
$mods{r} and return; # Introduced in Perl 5.13.7
|
||||
if ( $EMPTY eq $subs ) {
|
||||
$mods{d} or $mods{s} or return;
|
||||
} elsif ( $elem->get_match_string() eq $subs ) {
|
||||
$mods{c} or $mods{s} or return;
|
||||
}
|
||||
}
|
||||
|
||||
# As of 5.13.2, the substitute built-in supports the /r modifier, which
|
||||
# causes the operation to return the modified string and leave the
|
||||
# original unmodified. This does not parse under earlier Perls, so there
|
||||
# is no version check.
|
||||
|
||||
if ( $elem->isa( 'PPI::Token::Regexp::Substitute' ) ) {
|
||||
my $re = $doc->ppix_regexp_from_element( $elem )
|
||||
or return;
|
||||
$re->modifier_asserted( 'r' )
|
||||
and return;
|
||||
}
|
||||
|
||||
# If the previous sibling does not exist, then
|
||||
# the regex implicitly binds to $_
|
||||
my $prevsib = $elem->sprevious_sibling;
|
||||
return 1 if not $prevsib;
|
||||
|
||||
# If the previous sibling does exist, then it
|
||||
# should be a binding operator.
|
||||
return 1 if not _is_binding_operator( $prevsib );
|
||||
|
||||
# Check if the sibling before the biding operator
|
||||
# is explicitly set to $_
|
||||
my $bound_to = $prevsib->sprevious_sibling;
|
||||
return _is_topic( $bound_to );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _is_topic_mutating_func {
|
||||
my $elem = shift;
|
||||
return if not $elem->isa('PPI::Token::Word');
|
||||
my @mutator_funcs = qw(chop chomp undef);
|
||||
return if not any { $elem->content() eq $_ } @mutator_funcs;
|
||||
return if not is_function_call( $elem );
|
||||
|
||||
# If these functions have no argument,
|
||||
# they default to mutating $_
|
||||
my $first_arg = first_arg( $elem );
|
||||
if (not defined $first_arg) {
|
||||
# undef does not default to $_, unlike the others
|
||||
return if $elem->content() eq 'undef';
|
||||
return 1;
|
||||
}
|
||||
return _is_topic( $first_arg );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $MUTATING_SUBSTR_ARG_COUNT => 4;
|
||||
|
||||
sub _is_topic_mutating_substr {
|
||||
my $elem = shift;
|
||||
return if $elem->content() ne 'substr';
|
||||
return if not is_function_call( $elem );
|
||||
|
||||
# check and see if the first arg is $_
|
||||
my @args = parse_arg_list( $elem );
|
||||
return @args >= $MUTATING_SUBSTR_ARG_COUNT && _is_topic( $args[0]->[0] );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
{
|
||||
##no critic(ArgUnpacking)
|
||||
|
||||
my %assignment_ops = hashify qw(
|
||||
= *= /= += -= %= **= x= .= &= |= ^= &&= ||= <<= >>= //= ++ --
|
||||
);
|
||||
sub _is_assignment_operator { return exists $assignment_ops{$_[0]} }
|
||||
|
||||
my %increment_ops = hashify qw( ++ -- );
|
||||
sub _is_increment_operator { return exists $increment_ops{$_[0]} }
|
||||
|
||||
my %binding_ops = hashify qw( =~ !~ );
|
||||
sub _is_binding_operator { return exists $binding_ops{$_[0]} }
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions - Don't modify C<$_> in list functions.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
C<map>, C<grep> and other list operators are intended to transform
|
||||
arrays into other arrays by applying code to the array elements one by
|
||||
one. For speed, the elements are referenced via a C<$_> alias rather
|
||||
than copying them. As a consequence, if the code block of the C<map>
|
||||
or C<grep> modify C<$_> in any way, then it is actually modifying the
|
||||
source array. This IS technically allowed, but those side effects can
|
||||
be quite surprising, especially when the array being passed is C<@_>
|
||||
or perhaps C<values(%ENV)>! Instead authors should restrict in-place
|
||||
array modification to C<for(@array) { ... }> constructs instead, or
|
||||
use C<List::MoreUtils::apply()>.
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
By default, this policy applies to the following list functions:
|
||||
|
||||
map grep
|
||||
List::Util qw(first)
|
||||
List::MoreUtils qw(any all none notall true false firstidx
|
||||
first_index lastidx last_index insert_after
|
||||
insert_after_string)
|
||||
|
||||
This list can be overridden the F<.perlcriticrc> file like this:
|
||||
|
||||
[ControlStructures::ProhibitMutatingListFunctions]
|
||||
list_funcs = map grep List::Util::first
|
||||
|
||||
Or, one can just append to the list like so:
|
||||
|
||||
[ControlStructures::ProhibitMutatingListFunctions]
|
||||
add_list_funcs = Foo::Bar::listmunge
|
||||
|
||||
=head1 LIMITATIONS
|
||||
|
||||
This policy deliberately does not apply to C<for (@array) { ... }> or
|
||||
C<List::MoreUtils::apply()>.
|
||||
|
||||
Currently, the policy only detects explicit external module usage like
|
||||
this:
|
||||
|
||||
my @out = List::MoreUtils::any {s/^foo//} @in;
|
||||
|
||||
and not like this:
|
||||
|
||||
use List::MoreUtils qw(any);
|
||||
my @out = any {s/^foo//} @in;
|
||||
|
||||
This policy looks only for modifications of C<$_>. Other naughtiness
|
||||
could include modifying C<$a> and C<$b> in C<sort> and the like.
|
||||
That's beyond the scope of this policy.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
There is discussion of this policy at
|
||||
L<http://perlmonks.org/index.pl?node_id=743445>.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
Michael Wolf <MichaelRWolf@att.net>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
||||
|
|
@ -0,0 +1,202 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use English qw(-no_match_vars);
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw< :characters :severities :classification hashify >;
|
||||
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $EXPL => [99];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return qw< > }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core maintenance pbp ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $token, undef ) = @_;
|
||||
|
||||
return if $token->content() ne 'until' && $token->content() ne 'unless';
|
||||
|
||||
return if is_hash_key($token);
|
||||
return if is_subroutine_name($token);
|
||||
return if is_method_call($token);
|
||||
return if is_included_module_name($token);
|
||||
|
||||
return
|
||||
map
|
||||
{ $self->_violation_for_operator( $_, $token ) }
|
||||
_get_negative_operators( $token );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_negative_operators {
|
||||
my ($token) = @_;
|
||||
|
||||
my @operators;
|
||||
foreach my $element ( _get_condition_elements($token) ) {
|
||||
if ( $element->isa('PPI::Node') ) {
|
||||
my $operators = $element->find( \&_is_negative_operator );
|
||||
if ($operators) {
|
||||
push @operators, @{$operators};
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ( _is_negative_operator( undef, $element ) ) {
|
||||
push @operators, $element;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return @operators;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_condition_elements {
|
||||
my ($token) = @_;
|
||||
|
||||
my $statement = $token->statement();
|
||||
return if not $statement;
|
||||
|
||||
if ($statement->isa('PPI::Statement::Compound')) {
|
||||
my $condition = $token->snext_sibling();
|
||||
|
||||
return if not $condition;
|
||||
return if not $condition->isa('PPI::Structure::Condition');
|
||||
|
||||
return ( $condition );
|
||||
}
|
||||
|
||||
my @condition_elements;
|
||||
my $element = $token;
|
||||
while (
|
||||
$element = $element->snext_sibling()
|
||||
and $element->content() ne $SCOLON
|
||||
) {
|
||||
push @condition_elements, $element;
|
||||
}
|
||||
|
||||
return @condition_elements;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Hash my %NEGATIVE_OPERATORS => hashify(
|
||||
qw/
|
||||
! not
|
||||
!~ ne !=
|
||||
< > <= >= <=>
|
||||
lt gt le ge cmp
|
||||
/
|
||||
);
|
||||
|
||||
sub _is_negative_operator {
|
||||
my (undef, $element) = @_;
|
||||
|
||||
return
|
||||
$element->isa('PPI::Token::Operator')
|
||||
&& $NEGATIVE_OPERATORS{$element};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _violation_for_operator {
|
||||
my ($self, $operator, $control_structure) = @_;
|
||||
|
||||
return
|
||||
$self->violation(
|
||||
qq<Found "$operator" in condition for an "$control_structure">,
|
||||
$EXPL,
|
||||
$control_structure,
|
||||
);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions - Don't use operators like C<not>, C<!~>, and C<le> within C<until> and C<unless>.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
until ($foo ne 'blah') { #not ok
|
||||
...
|
||||
}
|
||||
|
||||
while ($foo eq 'blah') { #ok
|
||||
...
|
||||
}
|
||||
|
||||
A number of people have problems figuring out the meaning of doubly
|
||||
negated expressions. C<unless> and C<until> are both negative
|
||||
constructs, so any negative (e.g. C<!~>) or reversible operators (e.g.
|
||||
C<le>) included in their conditional expressions are double negations.
|
||||
Conway considers the following operators to be difficult to understand
|
||||
within C<unless> and C<until>:
|
||||
|
||||
! not
|
||||
!~ ne !=
|
||||
< > <= >= <=>
|
||||
lt gt le ge cmp
|
||||
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks|Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank C<< <perl@galumph.com> >>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,207 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :characters :severities :data_conversion :classification };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Hash my %PAGES_OF => (
|
||||
if => [ 93, 94 ],
|
||||
unless => [ 96, 97 ],
|
||||
until => [ 96, 97 ],
|
||||
for => [ 96 ],
|
||||
foreach => [ 96 ],
|
||||
while => [ 96 ],
|
||||
when => q<Similar to "if", postfix "when" should only be used with flow-control>,
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'allow',
|
||||
description => 'The permitted postfix controls.',
|
||||
default_string => $EMPTY,
|
||||
behavior => 'enumeration',
|
||||
enumeration_values => [ sort keys %PAGES_OF ],
|
||||
enumeration_allow_multiple_values => 1,
|
||||
},
|
||||
{
|
||||
name => 'flowcontrol',
|
||||
description => 'The exempt flow control functions.',
|
||||
default_string => 'carp cluck confess croak die exit goto warn',
|
||||
behavior => 'string list',
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_LOW }
|
||||
sub default_themes { return qw(core pbp cosmetic) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
my $expl = $PAGES_OF{$elem};
|
||||
return if not $expl;
|
||||
|
||||
return if is_hash_key($elem);
|
||||
return if is_method_call($elem);
|
||||
return if is_subroutine_name($elem);
|
||||
return if is_included_module_name($elem);
|
||||
return if is_package_declaration($elem);
|
||||
|
||||
# Skip controls that are allowed
|
||||
return if exists $self->{_allow}->{ $elem->content() };
|
||||
|
||||
# Skip Compound variety (these are good)
|
||||
my $stmnt = $elem->statement();
|
||||
return if not $stmnt;
|
||||
return if $stmnt->isa('PPI::Statement::Compound');
|
||||
return if $stmnt->isa('PPI::Statement::When');
|
||||
|
||||
# Handle special cases
|
||||
my $content = $elem->content();
|
||||
if ($content eq 'if' or $content eq 'when') {
|
||||
# Postfix 'if' allowed with loop breaks, or other
|
||||
# flow-controls like 'die', 'warn', and 'croak'
|
||||
return if $stmnt->isa('PPI::Statement::Break');
|
||||
return if defined $self->{_flowcontrol}{ $stmnt->schild(0)->content() };
|
||||
}
|
||||
|
||||
# If we get here, it must be postfix.
|
||||
my $desc = qq{Postfix control "$content" used};
|
||||
return $self->violation($desc, $expl, $elem);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords flowcontrol brian foy
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls - Write C<if($condition){ do_something() }> instead of C<do_something() if $condition>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway discourages using postfix control structures (C<if>, C<for>,
|
||||
C<unless>, C<until>, C<when>, C<while>) because they hide control
|
||||
flow. The C<unless> and C<until> controls are particularly evil
|
||||
because they lead to double-negatives that are hard to comprehend.
|
||||
The only tolerable usage of a postfix C<if>/C<when> is when it follows
|
||||
a loop break such as C<last>, C<next>, C<redo>, or C<continue>.
|
||||
|
||||
do_something() if $condition; # not ok
|
||||
if ($condition) { do_something() } # ok
|
||||
|
||||
do_something() while $condition; # not ok
|
||||
while ($condition) { do_something() } # ok
|
||||
|
||||
do_something() unless $condition; # not ok
|
||||
do_something() unless ! $condition; # really bad
|
||||
if (! $condition) { do_something() } # ok
|
||||
|
||||
do_something() until $condition; # not ok
|
||||
do_something() until ! $condition; # really bad
|
||||
while (! $condition) { do_something() } # ok
|
||||
|
||||
do_something($_) for @list; # not ok
|
||||
|
||||
LOOP:
|
||||
for my $n (0..100) {
|
||||
next if $condition; # ok
|
||||
last LOOP if $other_condition; # also ok
|
||||
|
||||
next when m< 0 \z >xms; # fine too
|
||||
}
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
A set of constructs to be ignored by this policy can specified by
|
||||
giving a value for 'allow' of a string of space-delimited keywords:
|
||||
C<if>, C<for>, C<unless>, C<until>, C<when>, and/or C<while>. An
|
||||
example of specifying allowed flow-control structures in a
|
||||
F<.perlcriticrc> file:
|
||||
|
||||
[ControlStructures::ProhibitPostfixControls]
|
||||
allow = for if until
|
||||
|
||||
By default, all postfix control keywords are prohibited.
|
||||
|
||||
The set of flow-control functions that are exempt from the restriction
|
||||
can also be configured with the 'flowcontrol' directive in your
|
||||
F<.perlcriticrc> file:
|
||||
|
||||
[ControlStructures::ProhibitPostfixControls]
|
||||
flowcontrol = warn die carp croak cluck confess goto exit
|
||||
|
||||
This is useful if you're using additional modules that add things like
|
||||
C<assert> or C<throw>.
|
||||
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
The C<die>, C<croak>, and C<confess> functions are frequently used as
|
||||
flow-controls just like C<next> or C<last>. So this Policy does
|
||||
permit you to use a postfix C<if> when the statement begins with one
|
||||
of those functions. It is also pretty common to use C<warn>, C<carp>,
|
||||
and C<cluck> with a postfix C<if>, so those are allowed too.
|
||||
|
||||
The C<when> keyword was added to the language after Perl Best
|
||||
Practices was written. This policy treats C<when> the same way it
|
||||
does C<if>, i.e. it's allowed after flow-control constructs. Thanks
|
||||
to brian d foy for the
|
||||
L<inspiration|http://www.effectiveperlprogramming.com/blog/543>.
|
||||
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Look for the C<do {} while> case and change the explanation to point
|
||||
to page 123 when it is found. RT #37905.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,98 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{"unless" block used};
|
||||
Readonly::Scalar my $EXPL => [ 97 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOW }
|
||||
sub default_themes { return qw(core pbp cosmetic) }
|
||||
sub applies_to { return 'PPI::Statement::Compound' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
if ( $elem->first_element() eq 'unless' ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks - Write C<if(! $condition)> instead of C<unless($condition)>.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway discourages using C<unless> because it leads to
|
||||
double-negatives that are hard to understand. Instead, reverse the
|
||||
logic and use C<if>.
|
||||
|
||||
unless($condition) { do_something() } #not ok
|
||||
unless(! $no_flag) { do_something() } #really bad
|
||||
if( ! $condition) { do_something() } #ok
|
||||
|
||||
This Policy only covers the block-form of C<unless>. For the postfix
|
||||
variety, see C<ProhibitPostfixControls>.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls|Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,229 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :data_conversion :classification };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
Readonly::Array my @TERMINALS => qw( die exit croak confess );
|
||||
Readonly::Hash my %TERMINALS => hashify( @TERMINALS );
|
||||
|
||||
Readonly::Array my @CONDITIONALS => qw( if unless foreach while until for );
|
||||
Readonly::Hash my %CONDITIONALS => hashify( @CONDITIONALS );
|
||||
|
||||
Readonly::Array my @OPERATORS => qw( && || // and or err ? );
|
||||
Readonly::Hash my %OPERATORS => hashify( @OPERATORS );
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Unreachable code};
|
||||
Readonly::Scalar my $EXPL => q{Consider removing it};
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGH }
|
||||
sub default_themes { return qw( core bugs certrec ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
my $statement = $elem->statement();
|
||||
return if not $statement;
|
||||
|
||||
# We check to see if this is an interesting token before calling
|
||||
# is_function_call(). This weeds out most candidate tokens and
|
||||
# prevents us from having to make an expensive function call.
|
||||
|
||||
return if ( !exists $TERMINALS{$elem} ) &&
|
||||
( !$statement->isa('PPI::Statement::Break') );
|
||||
|
||||
return if not is_function_call($elem);
|
||||
|
||||
# Scan the enclosing statement for conditional keywords or logical
|
||||
# operators. If any are found, then this the following statements
|
||||
# could _potentially_ be executed, so this policy is satisfied.
|
||||
|
||||
# NOTE: When the first operand in an boolean expression is
|
||||
# C<croak> or C<die>, etc., the second operand is technically
|
||||
# unreachable. But this policy doesn't catch that situation.
|
||||
|
||||
for my $child ( $statement->schildren() ) {
|
||||
return if $child->isa('PPI::Token::Operator') && exists $OPERATORS{$child};
|
||||
return if $child->isa('PPI::Token::Word') && exists $CONDITIONALS{$child};
|
||||
}
|
||||
|
||||
return $self->_gather_violations($statement);
|
||||
}
|
||||
|
||||
sub _gather_violations {
|
||||
my ($self, $statement) = @_;
|
||||
|
||||
# If we get here, then the statement contained an unconditional
|
||||
# die or exit or return. Then all the subsequent sibling
|
||||
# statements are unreachable, except for those that have labels,
|
||||
# which could be reached from anywhere using C<goto>. Subroutine
|
||||
# declarations are also exempt for the same reason. "use" and
|
||||
# "our" statements are exempt because they happen at compile time.
|
||||
|
||||
my @violations = ();
|
||||
while ( $statement = $statement->snext_sibling() ) {
|
||||
my @children = $statement->schildren();
|
||||
last if @children && $children[0]->isa('PPI::Token::Label');
|
||||
next if $statement->isa('PPI::Statement::Sub');
|
||||
next if $statement->isa('PPI::Statement::End');
|
||||
next if $statement->isa('PPI::Statement::Data');
|
||||
next if $statement->isa('PPI::Statement::Package');
|
||||
|
||||
next if $statement->isa('PPI::Statement::Include') &&
|
||||
$statement->type() ne 'require';
|
||||
|
||||
next if $statement->isa('PPI::Statement::Variable') &&
|
||||
$statement->type() eq 'our';
|
||||
|
||||
push @violations, $self->violation( $DESC, $EXPL, $statement );
|
||||
}
|
||||
|
||||
return @violations;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode - Don't write code after an unconditional C<die, exit, or next>.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This policy prohibits code following a statement which unconditionally
|
||||
alters the program flow. This includes calls to C<exit>, C<die>,
|
||||
C<return>, C<next>, C<last> and C<goto>. Due to common usage,
|
||||
C<croak> and C<confess> from L<Carp|Carp> are also included.
|
||||
|
||||
Code is reachable if any of the following conditions are true:
|
||||
|
||||
=over
|
||||
|
||||
=item * Flow-altering statement has a conditional attached to it
|
||||
|
||||
=item * Statement is on the right side of an operator C<&&>, C<||>, C<//>, C<and>, C<or>, or C<err>.
|
||||
|
||||
=item * Code is prefixed with a label (can potentially be reached via C<goto>)
|
||||
|
||||
=item * Code is a subroutine
|
||||
|
||||
=back
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
# not ok
|
||||
|
||||
exit;
|
||||
print "123\n";
|
||||
|
||||
# ok
|
||||
|
||||
exit if !$xyz;
|
||||
print "123\n";
|
||||
|
||||
# not ok
|
||||
|
||||
for ( 1 .. 10 ) {
|
||||
next;
|
||||
print 1;
|
||||
}
|
||||
|
||||
# ok
|
||||
|
||||
for ( 1 .. 10 ) {
|
||||
next if $_ == 5;
|
||||
print 1;
|
||||
}
|
||||
|
||||
# not ok
|
||||
|
||||
sub foo {
|
||||
my $bar = shift;
|
||||
return;
|
||||
print 1;
|
||||
}
|
||||
|
||||
# ok
|
||||
|
||||
sub foo {
|
||||
my $bar = shift;
|
||||
return if $bar->baz();
|
||||
print 1;
|
||||
}
|
||||
|
||||
|
||||
# not ok
|
||||
|
||||
die;
|
||||
print "123\n";
|
||||
|
||||
# ok
|
||||
|
||||
die;
|
||||
LABEL: print "123\n";
|
||||
|
||||
# not ok
|
||||
|
||||
croak;
|
||||
do_something();
|
||||
|
||||
# ok
|
||||
|
||||
croak;
|
||||
sub do_something {}
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls|Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Peter Guzis <pguzis@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Peter Guzis. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{"until" block used};
|
||||
Readonly::Scalar my $EXPL => [ 97 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOW }
|
||||
sub default_themes { return qw(core pbp cosmetic) }
|
||||
sub applies_to { return 'PPI::Statement' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
if ( $elem->first_element() eq 'until' ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks - Write C<while(! $condition)> instead of C<until($condition)>.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Conway discourages using C<until> because it leads to double-negatives
|
||||
that are hard to understand. Instead, reverse the logic and use
|
||||
C<while>.
|
||||
|
||||
until($condition) { do_something() } #not ok
|
||||
until(! $no_flag) { do_something() } #really bad
|
||||
while( ! $condition) { do_something() } #ok
|
||||
|
||||
This Policy only covers the block-form of C<until>. For the postfix
|
||||
variety, see C<ProhibitPostfixControls>.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls|Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,101 @@
|
|||
package Perl::Critic::Policy::ControlStructures::ProhibitYadaOperator;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :characters :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{yada operator (...) used};
|
||||
Readonly::Scalar my $EXPL => q{The yada operator is a placeholder for code you have not yet written.};
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGH }
|
||||
sub default_themes { return qw( core pbp maintenance ) }
|
||||
sub applies_to { return 'PPI::Token::Operator' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
if ( _is_yada( $elem ) ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
sub _is_yada {
|
||||
my ( $elem ) = @_;
|
||||
|
||||
return if $elem ne '...';
|
||||
#return if not defined $elem->statement;
|
||||
|
||||
# if there is something significant on both sides of the element it's
|
||||
# probably the three dot range operator
|
||||
return if ($elem->snext_sibling and $elem->sprevious_sibling);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords yada Berndt
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ControlStructures::ProhibitYadaOperator - Never use C<...> in production code.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The yada operator C<...> is not something you'd want in production
|
||||
code because it will throw an exception when executed. However, it is
|
||||
perfectly useful in less critical environments as a placeholder for code
|
||||
not yet implemented.
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Alan Berndt <alan@eatabrick.org>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2015-2017 Alan Berndt. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,407 @@
|
|||
package Perl::Critic::Policy::Documentation::PodSpelling;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use English qw(-no_match_vars);
|
||||
use Readonly;
|
||||
|
||||
use File::Spec;
|
||||
use File::Temp;
|
||||
use IO::String qw< >;
|
||||
use List::MoreUtils qw(uniq);
|
||||
use Pod::Spell qw< >;
|
||||
use Text::ParseWords qw< >;
|
||||
|
||||
use Perl::Critic::Utils qw{
|
||||
:characters
|
||||
:booleans
|
||||
:severities
|
||||
words_from_string
|
||||
};
|
||||
use Perl::Critic::Exception::Fatal::Generic qw{ throw_generic };
|
||||
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $POD_RX => qr{\A = (?: for|begin|end ) }xms;
|
||||
Readonly::Scalar my $DESC => q{Check the spelling in your POD};
|
||||
Readonly::Scalar my $EXPL => [148];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'spell_command',
|
||||
description => 'The command to invoke to check spelling.',
|
||||
default_string => 'aspell list',
|
||||
behavior => 'string',
|
||||
},
|
||||
{
|
||||
name => 'stop_words',
|
||||
description => 'The words to not consider as misspelled.',
|
||||
default_string => $EMPTY,
|
||||
behavior => 'string list',
|
||||
},
|
||||
{
|
||||
name => 'stop_words_file',
|
||||
description => 'A file containing words to not consider as misspelled.',
|
||||
default_string => $EMPTY,
|
||||
behavior => 'string',
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_LOWEST }
|
||||
sub default_themes { return qw( core cosmetic pbp ) }
|
||||
sub applies_to { return 'PPI::Document' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
my $got_sigpipe = 0;
|
||||
sub got_sigpipe {
|
||||
return $got_sigpipe;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub initialize_if_enabled {
|
||||
my ( $self, $config ) = @_;
|
||||
|
||||
eval { require File::Which; 1 } or return $FALSE;
|
||||
|
||||
return $FALSE if not $self->_derive_spell_command_line();
|
||||
|
||||
my $test_code = <<'END_TEST_CODE';
|
||||
;pod
|
||||
|
||||
;head1 Test The Spell Command
|
||||
|
||||
;cut
|
||||
END_TEST_CODE
|
||||
$test_code =~ s/^;/=/msx;
|
||||
return $FALSE if not $self->_run_spell_command($test_code);
|
||||
|
||||
$self->_load_stop_words_file();
|
||||
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, $doc ) = @_;
|
||||
|
||||
my $code = $doc->serialize();
|
||||
|
||||
my $words = $self->_run_spell_command($code);
|
||||
|
||||
return if not $words; # error running spell command
|
||||
|
||||
return if not @{$words}; # no problems found
|
||||
|
||||
return $self->violation( "$DESC: @{$words}", $EXPL, $doc );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _derive_spell_command_line {
|
||||
my ($self) = @_;
|
||||
|
||||
my @words = Text::ParseWords::shellwords($self->_get_spell_command());
|
||||
if (!@words) {
|
||||
return;
|
||||
}
|
||||
if (! File::Spec->file_name_is_absolute($words[0])) {
|
||||
$words[0] = File::Which::which($words[0]);
|
||||
}
|
||||
if (! $words[0] || ! -x $words[0]) {
|
||||
return;
|
||||
}
|
||||
$self->_set_spell_command_line(\@words);
|
||||
|
||||
return $self->_get_spell_command_line();
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_spell_command {
|
||||
my ( $self ) = @_;
|
||||
|
||||
return $self->{_spell_command};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_spell_command_line {
|
||||
my ( $self ) = @_;
|
||||
|
||||
return $self->{_spell_command_line};
|
||||
}
|
||||
|
||||
sub _set_spell_command_line {
|
||||
my ( $self, $spell_command_line ) = @_;
|
||||
|
||||
$self->{_spell_command_line} = $spell_command_line;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_stop_words {
|
||||
my ( $self ) = @_;
|
||||
|
||||
return $self->{_stop_words};
|
||||
}
|
||||
|
||||
sub _set_stop_words {
|
||||
my ( $self, $stop_words ) = @_;
|
||||
|
||||
$self->{_stop_words} = $stop_words;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _get_stop_words_file {
|
||||
my ( $self ) = @_;
|
||||
|
||||
return $self->{_stop_words_file};
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _run_spell_command {
|
||||
my ($self, $code) = @_;
|
||||
|
||||
my $infh = IO::String->new( $code );
|
||||
|
||||
my $outfh = File::Temp->new();
|
||||
|
||||
my $outfile = $outfh->filename();
|
||||
my @words;
|
||||
|
||||
local $EVAL_ERROR = undef;
|
||||
|
||||
eval {
|
||||
# temporarily add our special wordlist to this annoying global
|
||||
local %Pod::Wordlist::Wordlist = ## no critic (ProhibitPackageVars)
|
||||
%{ $self->_get_stop_words() };
|
||||
|
||||
Pod::Spell->new()->parse_from_filehandle($infh, $outfh);
|
||||
close $outfh or throw_generic "Failed to close pod temp file: $OS_ERROR";
|
||||
return if not -s $outfile; # Bail out if no words to spellcheck
|
||||
|
||||
# run spell command and fetch output
|
||||
local $SIG{PIPE} = sub { $got_sigpipe = 1; };
|
||||
my $command_line = join $SPACE, @{$self->_get_spell_command_line()};
|
||||
open my $aspell_out_fh, q{-|}, "$command_line < $outfile" ## Is this portable??
|
||||
or throw_generic "Failed to open handle to spelling program: $OS_ERROR";
|
||||
|
||||
@words = uniq( <$aspell_out_fh> );
|
||||
close $aspell_out_fh
|
||||
or throw_generic "Failed to close handle to spelling program: $OS_ERROR";
|
||||
|
||||
chomp @words;
|
||||
|
||||
# Why is this extra step needed???
|
||||
@words = grep { not exists $Pod::Wordlist::Wordlist{$_} } @words; ## no critic (ProhibitPackageVars)
|
||||
1;
|
||||
}
|
||||
or do {
|
||||
# Eat anything we did ourselves above, propagate anything else.
|
||||
if (
|
||||
$EVAL_ERROR
|
||||
and not ref Perl::Critic::Exception::Fatal::Generic->caught()
|
||||
) {
|
||||
ref $EVAL_ERROR ? $EVAL_ERROR->rethrow() : die $EVAL_ERROR; ## no critic (ErrorHandling::RequireCarping)
|
||||
}
|
||||
|
||||
return;
|
||||
};
|
||||
|
||||
return [ @words ];
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _load_stop_words_file {
|
||||
my ($self) = @_;
|
||||
|
||||
my %stop_words = %{ $self->_get_stop_words() };
|
||||
|
||||
my $file_name = $self->_get_stop_words_file() or return;
|
||||
|
||||
open my $handle, '<', $file_name
|
||||
or do { warn qq<Could not open "$file_name": $OS_ERROR\n>; return; };
|
||||
|
||||
while ( my $line = <$handle> ) {
|
||||
if ( my $word = _word_from_line($line) ) {
|
||||
$stop_words{$word} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
close $handle or warn qq<Could not close "$file_name": $OS_ERROR\n>;
|
||||
|
||||
$self->_set_stop_words(\%stop_words);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _word_from_line {
|
||||
my ($line) = @_;
|
||||
|
||||
$line =~ s< [#] .* \z ><>xms;
|
||||
$line =~ s< \s+ \z ><>xms;
|
||||
$line =~ s< \A \s+ ><>xms;
|
||||
|
||||
return $line;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords foobie foobie-bletch Hmm stopwords
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::Documentation::PodSpelling - Check your spelling.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Did you write the documentation? Check.
|
||||
|
||||
Did you document all of the public methods? Check.
|
||||
|
||||
Is your documentation readable? Hmm...
|
||||
|
||||
Ideally, we'd like Perl::Critic to tell you when your documentation is
|
||||
inadequate. That's hard to code, though. So, inspired by
|
||||
L<Test::Spelling|Test::Spelling>, this module checks the spelling of
|
||||
your POD. It does this by pulling the prose out of the code and
|
||||
passing it to an external spell checker. It skips over words you
|
||||
flagged to ignore. If the spell checker returns any misspelled words,
|
||||
this policy emits a violation.
|
||||
|
||||
If anything else goes wrong -- we can't locate the spell checking program or
|
||||
(gasp!) your module has no POD -- then this policy passes.
|
||||
|
||||
To add exceptions on a module-by-module basis, add "stopwords" as
|
||||
described in L<Pod::Spell|Pod::Spell>. For example:
|
||||
|
||||
=for stopwords gibbles
|
||||
|
||||
=head1 Gibble::Manip -- manipulate your gibbles
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This policy can be configured to tell which spell checker to use or to
|
||||
set a global list of spelling exceptions. To do this, put entries in
|
||||
a F<.perlcriticrc> file like this:
|
||||
|
||||
[Documentation::PodSpelling]
|
||||
spell_command = aspell list
|
||||
stop_words = gibbles foobar
|
||||
stop_words_file = some/path/with/stop/words.txt
|
||||
|
||||
The default spell command is C<aspell list> and it is interpreted as a
|
||||
shell command. We parse the individual arguments via
|
||||
L<Text::ParseWords|Text::ParseWords> so feel free to use quotes around
|
||||
your arguments. If the executable path is an absolute file name, it
|
||||
is used as-is. If it is a relative file name, we employ
|
||||
L<File::Which|File::Which> to convert it to an absolute path via the
|
||||
C<PATH> environment variable. As described in Pod::Spell and
|
||||
Test::Spelling, the spell checker must accept text on STDIN and print
|
||||
misspelled words one per line on STDOUT.
|
||||
|
||||
You can specify global stop words via the C<stop_words> and
|
||||
C<stop_words_file> options. The former is simply split up on
|
||||
whitespace. The latter is looked at line by line, with anything after
|
||||
an octothorp ("#") removed and then leading and trailing whitespace
|
||||
removed. Silly example valid file contents:
|
||||
|
||||
# It's a comment!
|
||||
|
||||
foo
|
||||
arglbargl # Some other comment.
|
||||
bar
|
||||
|
||||
The values from C<stop_words> and C<stop_words_file> are merged
|
||||
together into a single list of exemptions.
|
||||
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
A spell checking program is not included with Perl::Critic.
|
||||
|
||||
The results of failures for this policy can be confusing when F<aspell>
|
||||
complains about words containing punctuation such as hyphens and apostrophes.
|
||||
In this situation F<aspell> will often only emit part of the word that it
|
||||
thinks is misspelled. For example, if you ask F<aspell> to check
|
||||
"foobie-bletch", the output only complains about "foobie". Unfortunately,
|
||||
you'll have to look through your POD to figure out what the real word that
|
||||
F<aspell> is complaining about is. One thing to try is looking at the output
|
||||
of C<< perl -MPod::Spell -e 'print
|
||||
Pod::Spell->new()->parse_from_file("lib/Your/Module.pm")' >> to see what is
|
||||
actually being checked for spelling.
|
||||
|
||||
|
||||
=head1 PREREQUISITES
|
||||
|
||||
This policy will disable itself if L<File::Which|File::Which> is not
|
||||
available.
|
||||
|
||||
|
||||
=head1 CREDITS
|
||||
|
||||
Initial development of this policy was supported by a grant from the
|
||||
Perl Foundation.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Chris Dolan. Many rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,125 @@
|
|||
package Perl::Critic::Policy::Documentation::RequirePackageMatchesPodName;
|
||||
|
||||
use 5.006001;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
use English qw{ -no_match_vars };
|
||||
use Perl::Critic::Utils qw{ :severities :classification };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $PKG_RX => qr{ [[:alpha:]](?:[\w:\']*\w)? }xms;
|
||||
Readonly::Scalar my $DESC =>
|
||||
q{Pod NAME on line %d does not match the package declaration};
|
||||
Readonly::Scalar my $EXPL => q{};
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOWEST }
|
||||
sub default_themes { return qw( core cosmetic ) }
|
||||
sub applies_to { return 'PPI::Document' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub prepare_to_scan_document {
|
||||
my ( $self, $document ) = @_;
|
||||
|
||||
# idea: force NAME to match the file name in programs?
|
||||
return $document->is_module(); # mismatch is normal in program entry points
|
||||
}
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, $doc ) = @_;
|
||||
|
||||
# No POD means no violation
|
||||
my $pods_ref = $doc->find('PPI::Token::Pod');
|
||||
return if !$pods_ref;
|
||||
|
||||
for my $pod (@{$pods_ref}) {
|
||||
my $content = $pod->content;
|
||||
|
||||
next if $content !~ m{^=head1 [ \t]+ NAME [ \t]*$ \s*}cgxms;
|
||||
|
||||
my $line_number = $pod->line_number() + (
|
||||
substr( $content, 0, $LAST_MATCH_START[0] + 1 ) =~ tr/\n/\n/ );
|
||||
|
||||
my ($pod_pkg) = $content =~ m{\G (\S+) }cgxms;
|
||||
|
||||
if (!$pod_pkg) {
|
||||
return $self->violation( sprintf( $DESC, $line_number ),
|
||||
q{Empty name declaration}, $pod );
|
||||
}
|
||||
|
||||
# idea: worry about POD escapes?
|
||||
$pod_pkg =~ s{\A [BCIL]<(.*)>\z}{$1}gxms; # unwrap
|
||||
$pod_pkg =~ s{\'}{::}gxms; # perl4 -> perl5
|
||||
|
||||
foreach my $stmt ( @{ $doc->find('PPI::Statement::Package') || [] } ) {
|
||||
my $pkg = $stmt->namespace();
|
||||
$pkg =~ s{\'}{::}gxms;
|
||||
return if $pkg eq $pod_pkg;
|
||||
}
|
||||
|
||||
return $self->violation( sprintf( $DESC, $line_number ),
|
||||
$EXPL, $pod );
|
||||
}
|
||||
|
||||
return; # no NAME section found
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::Documentation::RequirePackageMatchesPodName - The C<=head1 NAME> section should match the package.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic> distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2008-2011 Chris Dolan
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,127 @@
|
|||
package Perl::Critic::Policy::Documentation::RequirePodAtEnd;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use List::Util qw(first);
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $POD_RX => qr{\A = (?: for|begin|end ) }xms;
|
||||
Readonly::Scalar my $DESC => q{POD before __END__};
|
||||
Readonly::Scalar my $EXPL => [139, 140];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_LOWEST }
|
||||
sub default_themes { return qw( core cosmetic pbp ) }
|
||||
sub applies_to { return 'PPI::Document' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, $doc ) = @_;
|
||||
|
||||
# No POD means no violation
|
||||
my $pods_ref = $doc->find('PPI::Token::Pod');
|
||||
return if !$pods_ref;
|
||||
|
||||
# Look for first POD tag that isn't =for, =begin, or =end
|
||||
my $pod = first { $_ !~ $POD_RX} @{ $pods_ref };
|
||||
return if !$pod;
|
||||
|
||||
my $end = $doc->find_first('PPI::Statement::End');
|
||||
if ($end) { # No __END__ means definite violation
|
||||
my $pod_loc = $pod->location();
|
||||
my $end_loc = $end->location();
|
||||
if ( $pod_loc->[0] > $end_loc->[0] ) {
|
||||
# POD is after __END__, or relative position couldn't be determined
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $pod );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::Documentation::RequirePodAtEnd - All POD should be after C<__END__>.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Perl stops processing code when it sees an C<__END__> statement. So,
|
||||
to save processing time, it's faster to put documentation after the
|
||||
C<__END__>. Also, writing all the POD in one place usually leads to a
|
||||
more cohesive document, rather than being forced to follow the layout
|
||||
of your code. This policy issues violations if any POD is found
|
||||
before an C<__END__>.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
Some folks like to use C<=for>, and C<=begin>, and C<=end> tags to
|
||||
create block comments in-line with their code. Since those tags
|
||||
aren't usually part of the documentation, this Policy does allows them
|
||||
to appear before the C<__END__> statement.
|
||||
|
||||
=begin comments
|
||||
|
||||
frobulate()
|
||||
Accepts: A list of things to frobulate
|
||||
Returns: True if successful
|
||||
|
||||
=end comments
|
||||
|
||||
sub frobulate { ... }
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,494 @@
|
|||
package Perl::Critic::Policy::Documentation::RequirePodSections;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :booleans :characters :severities :classification };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $EXPL => [133, 138];
|
||||
|
||||
Readonly::Scalar my $BOOK => 'book';
|
||||
Readonly::Scalar my $BOOK_FIRST_EDITION => 'book_first_edition';
|
||||
Readonly::Scalar my $MODULE_STARTER_PBP => 'module_starter_pbp';
|
||||
Readonly::Scalar my $M_S_PBP_0_0_3 => 'module_starter_pbp_0_0_3';
|
||||
|
||||
Readonly::Scalar my $DEFAULT_SOURCE => $BOOK_FIRST_EDITION;
|
||||
|
||||
Readonly::Hash my %SOURCE_TRANSLATION => (
|
||||
$BOOK => $BOOK_FIRST_EDITION,
|
||||
$BOOK_FIRST_EDITION => $BOOK_FIRST_EDITION,
|
||||
$MODULE_STARTER_PBP => $M_S_PBP_0_0_3,
|
||||
$M_S_PBP_0_0_3 => $M_S_PBP_0_0_3,
|
||||
);
|
||||
|
||||
Readonly::Scalar my $EN_AU => 'en_AU';
|
||||
Readonly::Scalar my $EN_US => 'en_US';
|
||||
Readonly::Scalar my $ORIGINAL_MODULE_VERSION => 'original';
|
||||
|
||||
Readonly::Hash my %SOURCE_DEFAULT_LANGUAGE => (
|
||||
$BOOK_FIRST_EDITION => $ORIGINAL_MODULE_VERSION,
|
||||
$M_S_PBP_0_0_3 => $EN_AU,
|
||||
);
|
||||
|
||||
Readonly::Scalar my $BOOK_FIRST_EDITION_US_LIB_SECTIONS =>
|
||||
[
|
||||
'NAME',
|
||||
'VERSION',
|
||||
'SYNOPSIS',
|
||||
'DESCRIPTION',
|
||||
'SUBROUTINES/METHODS',
|
||||
'DIAGNOSTICS',
|
||||
'CONFIGURATION AND ENVIRONMENT',
|
||||
'DEPENDENCIES',
|
||||
'INCOMPATIBILITIES',
|
||||
'BUGS AND LIMITATIONS',
|
||||
'AUTHOR',
|
||||
'LICENSE AND COPYRIGHT',
|
||||
];
|
||||
|
||||
Readonly::Hash my %DEFAULT_LIB_SECTIONS => (
|
||||
$BOOK_FIRST_EDITION => {
|
||||
$ORIGINAL_MODULE_VERSION => $BOOK_FIRST_EDITION_US_LIB_SECTIONS,
|
||||
$EN_AU => [
|
||||
'NAME',
|
||||
'VERSION',
|
||||
'SYNOPSIS',
|
||||
'DESCRIPTION',
|
||||
'SUBROUTINES/METHODS',
|
||||
'DIAGNOSTICS',
|
||||
'CONFIGURATION AND ENVIRONMENT',
|
||||
'DEPENDENCIES',
|
||||
'INCOMPATIBILITIES',
|
||||
'BUGS AND LIMITATIONS',
|
||||
'AUTHOR',
|
||||
'LICENCE AND COPYRIGHT',
|
||||
],
|
||||
$EN_US => $BOOK_FIRST_EDITION_US_LIB_SECTIONS,
|
||||
},
|
||||
$M_S_PBP_0_0_3 => {
|
||||
$EN_AU => [
|
||||
'NAME',
|
||||
'VERSION',
|
||||
'SYNOPSIS',
|
||||
'DESCRIPTION',
|
||||
'INTERFACE',
|
||||
'DIAGNOSTICS',
|
||||
'CONFIGURATION AND ENVIRONMENT',
|
||||
'DEPENDENCIES',
|
||||
'INCOMPATIBILITIES',
|
||||
'BUGS AND LIMITATIONS',
|
||||
'AUTHOR',
|
||||
'LICENCE AND COPYRIGHT',
|
||||
'DISCLAIMER OF WARRANTY',
|
||||
],
|
||||
$EN_US => [
|
||||
'NAME',
|
||||
'VERSION',
|
||||
'SYNOPSIS',
|
||||
'DESCRIPTION',
|
||||
'INTERFACE',
|
||||
'DIAGNOSTICS',
|
||||
'CONFIGURATION AND ENVIRONMENT',
|
||||
'DEPENDENCIES',
|
||||
'INCOMPATIBILITIES',
|
||||
'BUGS AND LIMITATIONS',
|
||||
'AUTHOR',
|
||||
'LICENSE AND COPYRIGHT',
|
||||
'DISCLAIMER OF WARRANTY'
|
||||
],
|
||||
},
|
||||
);
|
||||
|
||||
Readonly::Hash my %DEFAULT_SCRIPT_SECTIONS => (
|
||||
$BOOK_FIRST_EDITION => {
|
||||
$ORIGINAL_MODULE_VERSION => [
|
||||
'NAME',
|
||||
'USAGE',
|
||||
'DESCRIPTION',
|
||||
'REQUIRED ARGUMENTS',
|
||||
'OPTIONS',
|
||||
'DIAGNOSTICS',
|
||||
'EXIT STATUS',
|
||||
'CONFIGURATION',
|
||||
'DEPENDENCIES',
|
||||
'INCOMPATIBILITIES',
|
||||
'BUGS AND LIMITATIONS',
|
||||
'AUTHOR',
|
||||
'LICENSE AND COPYRIGHT',
|
||||
],
|
||||
$EN_AU => [
|
||||
'NAME',
|
||||
'VERSION',
|
||||
'USAGE',
|
||||
'REQUIRED ARGUMENTS',
|
||||
'OPTIONS',
|
||||
'DESCRIPTION',
|
||||
'DIAGNOSTICS',
|
||||
'CONFIGURATION AND ENVIRONMENT',
|
||||
'DEPENDENCIES',
|
||||
'INCOMPATIBILITIES',
|
||||
'BUGS AND LIMITATIONS',
|
||||
'AUTHOR',
|
||||
'LICENCE AND COPYRIGHT',
|
||||
],
|
||||
$EN_US => [
|
||||
'NAME',
|
||||
'VERSION',
|
||||
'USAGE',
|
||||
'REQUIRED ARGUMENTS',
|
||||
'OPTIONS',
|
||||
'DESCRIPTION',
|
||||
'DIAGNOSTICS',
|
||||
'CONFIGURATION AND ENVIRONMENT',
|
||||
'DEPENDENCIES',
|
||||
'INCOMPATIBILITIES',
|
||||
'BUGS AND LIMITATIONS',
|
||||
'AUTHOR',
|
||||
'LICENSE AND COPYRIGHT',
|
||||
],
|
||||
},
|
||||
$M_S_PBP_0_0_3 => {
|
||||
$EN_AU => [
|
||||
'NAME',
|
||||
'VERSION',
|
||||
'USAGE',
|
||||
'REQUIRED ARGUMENTS',
|
||||
'OPTIONS',
|
||||
'DESCRIPTION',
|
||||
'DIAGNOSTICS',
|
||||
'CONFIGURATION AND ENVIRONMENT',
|
||||
'DEPENDENCIES',
|
||||
'INCOMPATIBILITIES',
|
||||
'BUGS AND LIMITATIONS',
|
||||
'AUTHOR',
|
||||
'LICENCE AND COPYRIGHT',
|
||||
'DISCLAIMER OF WARRANTY',
|
||||
],
|
||||
$EN_US => [
|
||||
'NAME',
|
||||
'VERSION',
|
||||
'USAGE',
|
||||
'REQUIRED ARGUMENTS',
|
||||
'OPTIONS',
|
||||
'DESCRIPTION',
|
||||
'DIAGNOSTICS',
|
||||
'CONFIGURATION AND ENVIRONMENT',
|
||||
'DEPENDENCIES',
|
||||
'INCOMPATIBILITIES',
|
||||
'BUGS AND LIMITATIONS',
|
||||
'AUTHOR',
|
||||
'LICENSE AND COPYRIGHT',
|
||||
'DISCLAIMER OF WARRANTY',
|
||||
],
|
||||
},
|
||||
);
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'lib_sections',
|
||||
description => 'The sections to require for modules (separated by qr/\s* [|] \s*/xms).',
|
||||
default_string => $EMPTY,
|
||||
parser => \&_parse_lib_sections,
|
||||
},
|
||||
{
|
||||
name => 'script_sections',
|
||||
description => 'The sections to require for programs (separated by qr/\s* [|] \s*/xms).',
|
||||
default_string => $EMPTY,
|
||||
parser => \&_parse_script_sections,
|
||||
},
|
||||
{
|
||||
name => 'source',
|
||||
description => 'The origin of sections to use.',
|
||||
default_string => $DEFAULT_SOURCE,
|
||||
behavior => 'enumeration',
|
||||
enumeration_values => [ keys %SOURCE_TRANSLATION ],
|
||||
},
|
||||
{
|
||||
name => 'language',
|
||||
description => 'The spelling of sections to use.',
|
||||
default_string => $EMPTY,
|
||||
behavior => 'enumeration',
|
||||
enumeration_values => [ $EN_AU, $EN_US ],
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_LOW }
|
||||
sub default_themes { return qw(core pbp maintenance) }
|
||||
sub applies_to { return 'PPI::Document' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _parse_sections {
|
||||
my $config_string = shift;
|
||||
|
||||
my @sections = split m{ \s* [|] \s* }xms, $config_string;
|
||||
|
||||
return map { uc } @sections; # Normalize CaSe!
|
||||
}
|
||||
|
||||
sub _parse_lib_sections {
|
||||
my ($self, $parameter, $config_string) = @_;
|
||||
|
||||
if ( defined $config_string ) {
|
||||
$self->{_lib_sections} = [ _parse_sections( $config_string ) ];
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _parse_script_sections {
|
||||
my ($self, $parameter, $config_string) = @_;
|
||||
|
||||
if ( defined $config_string ) {
|
||||
$self->{_script_sections} = [ _parse_sections( $config_string ) ];
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub initialize_if_enabled {
|
||||
my ($self, $config) = @_;
|
||||
|
||||
my $source = $self->{_source};
|
||||
if ( not defined $source or not defined $DEFAULT_LIB_SECTIONS{$source} ) {
|
||||
$source = $DEFAULT_SOURCE;
|
||||
}
|
||||
|
||||
my $language = $self->{_language};
|
||||
if (
|
||||
not defined $language
|
||||
or not defined $DEFAULT_LIB_SECTIONS{$source}{$language}
|
||||
) {
|
||||
$language = $SOURCE_DEFAULT_LANGUAGE{$source};
|
||||
}
|
||||
|
||||
if ( not $self->_sections_specified('_lib_sections') ) {
|
||||
$self->{_lib_sections} = $DEFAULT_LIB_SECTIONS{$source}{$language};
|
||||
}
|
||||
if ( not $self->_sections_specified('_script_sections') ) {
|
||||
$self->{_script_sections} =
|
||||
$DEFAULT_SCRIPT_SECTIONS{$source}{$language};
|
||||
}
|
||||
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
sub _sections_specified {
|
||||
my ( $self, $sections_key ) = @_;
|
||||
|
||||
my $sections = $self->{$sections_key};
|
||||
|
||||
return 0 if not defined $sections;
|
||||
|
||||
return scalar @{ $sections };
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, $doc ) = @_;
|
||||
|
||||
# This policy does not apply unless there is some real code in the
|
||||
# file. For example, if this file is just pure POD, then
|
||||
# presumably this file is ancillary documentation and you can use
|
||||
# whatever headings you want.
|
||||
return if ! $doc->schild(0);
|
||||
|
||||
my %found_sections = ();
|
||||
my @violations = ();
|
||||
|
||||
my @required_sections =
|
||||
$doc->is_program()
|
||||
? @{ $self->{_script_sections} }
|
||||
: @{ $self->{_lib_sections} };
|
||||
|
||||
my $pods_ref = $doc->find('PPI::Token::Pod');
|
||||
return if not $pods_ref;
|
||||
|
||||
# Round up the names of all the =head1 sections
|
||||
my $pod_of_record;
|
||||
for my $pod ( @{ $pods_ref } ) {
|
||||
for my $found ( $pod =~ m{ ^ =head1 \s+ ( .+? ) \s* $ }gxms ) {
|
||||
# Use first matching POD as POD of record (RT #59268)
|
||||
$pod_of_record ||= $pod;
|
||||
#Leading/trailing whitespace is already removed
|
||||
$found_sections{ uc $found } = 1;
|
||||
}
|
||||
}
|
||||
|
||||
# Compare the required sections against those we found
|
||||
for my $required ( @required_sections ) {
|
||||
if ( not exists $found_sections{$required} ) {
|
||||
my $desc = qq{Missing "$required" section in POD};
|
||||
# Report any violations against POD of record rather than whole
|
||||
# document (the point of RT #59268)
|
||||
# But if there are no =head1 records at all, rat out the
|
||||
# first pod found, as being better than blowing up. RT #67231
|
||||
push @violations, $self->violation( $desc, $EXPL,
|
||||
$pod_of_record || $pods_ref->[0] );
|
||||
}
|
||||
}
|
||||
|
||||
return @violations;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords licence
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::Documentation::RequirePodSections - Organize your POD into the customary sections.
|
||||
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This Policy requires your POD to contain certain C<=head1> sections.
|
||||
If the file doesn't contain any POD at all, then this Policy does not
|
||||
apply. Tools like L<Module::Starter|Module::Starter> make it really
|
||||
easy to ensure that every module has the same documentation framework,
|
||||
and they can save you lots of keystrokes.
|
||||
|
||||
|
||||
=head1 DEFAULTS
|
||||
|
||||
Different POD sections are required, depending on whether the file is
|
||||
a library or program (which is determined by the presence or absence
|
||||
of a perl shebang line).
|
||||
|
||||
Default Required POD Sections
|
||||
|
||||
Perl Libraries Perl Programs
|
||||
----------------------------- ---------------------
|
||||
NAME NAME
|
||||
VERSION
|
||||
SYNOPSIS USAGE
|
||||
DESCRIPTION DESCRIPTION
|
||||
SUBROUTINES/METHODS REQUIRED ARGUMENTS
|
||||
OPTIONS
|
||||
DIAGNOSTICS DIAGNOSTICS
|
||||
EXIT STATUS
|
||||
CONFIGURATION AND ENVIRONMENT CONFIGURATION
|
||||
DEPENDENCIES DEPENDENCIES
|
||||
INCOMPATIBILITIES INCOMPATIBILITIES
|
||||
BUGS AND LIMITATIONS BUGS AND LIMITATIONS
|
||||
AUTHOR AUTHOR
|
||||
LICENSE AND COPYRIGHT LICENSE AND COPYRIGHT
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
The default sections above are derived from Damian Conway's I<Perl
|
||||
Best Practices> book. Since the book has been published, Conway has
|
||||
released L<Module::Starter::PBP|Module::Starter::PBP>, which has
|
||||
different names for some of the sections, and adds some more. Also,
|
||||
the book and module use Australian spelling, while the authors of this
|
||||
module have previously used American spelling. To sort this all out,
|
||||
there are a couple of options that can be used: C<source> and
|
||||
C<language>.
|
||||
|
||||
The C<source> option has two generic values, C<book> and
|
||||
C<module_starter_pbp>, and two version-specific values,
|
||||
C<book_first_edition> and C<module_starter_pbp_0_0_3>. Currently, the
|
||||
generic values map to the corresponding version-specific values, but
|
||||
may change as new versions of the book and module are released, so use
|
||||
these if you want to keep up with the latest and greatest. If you
|
||||
want things to remain stable, use the version-specific values.
|
||||
|
||||
The C<language> option has a default, unnamed value but also accepts
|
||||
values of C<en_AU> and C<en_US>. The reason the unnamed value exists
|
||||
is because the default values for programs don't actually match the
|
||||
book, even taking spelling into account, i.e. C<CONFIGURATION> instead
|
||||
of C<CONFIGURATION AND ENVIRONMENT>, the removal of C<VERSION>, and
|
||||
the addition of C<EXIT STATUS>. To get precisely the sections as
|
||||
specified in the book, put the following in your F<.perlcriticrc>
|
||||
file:
|
||||
|
||||
[Documentation::RequirePodSections]
|
||||
source = book_first_edition
|
||||
language = en_AU
|
||||
|
||||
If you want to use
|
||||
|
||||
[Documentation::RequirePodSections]
|
||||
source = module_starter_pbp
|
||||
language = en_US
|
||||
|
||||
you will need to modify your F<~/.module-starter/PBP/Module.pm>
|
||||
template because it is generated using Australian spelling.
|
||||
|
||||
Presently, the difference between C<en_AU> and C<en_US> is in how the
|
||||
word "licence" is spelled.
|
||||
|
||||
The sections required for modules and programs can be independently
|
||||
customized, overriding any values for C<source> and C<language>, by
|
||||
giving values for C<script_sections> and C<lib_sections> of a string
|
||||
of pipe-delimited required POD section names. An example of entries
|
||||
in a F<.perlcriticrc> file:
|
||||
|
||||
[Documentation::RequirePodSections]
|
||||
lib_sections = NAME | SYNOPSIS | BUGS AND LIMITATIONS | AUTHOR
|
||||
script_sections = NAME | USAGE | OPTIONS | EXIT STATUS | AUTHOR
|
||||
|
||||
|
||||
=head1 LIMITATIONS
|
||||
|
||||
Currently, this Policy does not look for the required POD sections
|
||||
below the C<=head1> level. Also, it does not require the sections to
|
||||
appear in any particular order.
|
||||
|
||||
This Policy applies to the entire document, but can be disabled for a
|
||||
particular document by a C<## no critic (RequirePodSections)> annotation
|
||||
anywhere between the beginning of the document and the first POD section
|
||||
containing a C<=head1>, the C<__END__> (if any), or the C<__DATA__> (if any),
|
||||
whichever comes first.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,502 @@
|
|||
package Perl::Critic::Policy::ErrorHandling::RequireCarping;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{
|
||||
:booleans :characters :severities :classification :data_conversion
|
||||
};
|
||||
use Perl::Critic::Utils::PPI qw{ is_ppi_expression_or_generic_statement };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $EXPL => [ 283 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'allow_messages_ending_with_newlines',
|
||||
description => q{Don't complain about die or warn if the message ends in a newline.},
|
||||
default_string => '1',
|
||||
behavior => 'boolean',
|
||||
},
|
||||
{
|
||||
name => 'allow_in_main_unless_in_subroutine',
|
||||
description => q{Don't complain about die or warn in main::, unless in a subroutine.},
|
||||
default_string => '0',
|
||||
behavior => 'boolean',
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core pbp maintenance certrule ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
my $alternative;
|
||||
if ( $elem eq 'warn' ) {
|
||||
$alternative = 'carp';
|
||||
}
|
||||
elsif ( $elem eq 'die' ) {
|
||||
$alternative = 'croak';
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
if ($self->{_allow_messages_ending_with_newlines}) {
|
||||
return if _last_flattened_argument_list_element_ends_in_newline($elem);
|
||||
}
|
||||
|
||||
return if $self->{_allow_in_main_unless_in_subroutine}
|
||||
&& !$self->_is_element_contained_in_subroutine( $elem )
|
||||
&& $self->_is_element_in_namespace_main( $elem ); # RT #56619
|
||||
|
||||
my $desc = qq{"$elem" used instead of "$alternative"};
|
||||
return $self->violation( $desc, $EXPL, $elem );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _last_flattened_argument_list_element_ends_in_newline {
|
||||
my $die_or_warn = shift;
|
||||
|
||||
my $last_flattened_argument =
|
||||
_find_last_flattened_argument_list_element($die_or_warn)
|
||||
or return $FALSE;
|
||||
|
||||
if ( $last_flattened_argument->isa('PPI::Token::Quote') ) {
|
||||
my $last_flattened_argument_string =
|
||||
$last_flattened_argument->string();
|
||||
if (
|
||||
$last_flattened_argument_string =~ m{ \n \z }xms
|
||||
or (
|
||||
(
|
||||
$last_flattened_argument->isa('PPI::Token::Quote::Double')
|
||||
or $last_flattened_argument->isa('PPI::Token::Quote::Interpolate')
|
||||
)
|
||||
and $last_flattened_argument_string =~ m{ [\\] n \z }xms
|
||||
)
|
||||
) {
|
||||
return $TRUE;
|
||||
}
|
||||
}
|
||||
elsif ( $last_flattened_argument->isa('PPI::Token::HereDoc') ) {
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
return $FALSE
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# Here starts the fun. Explanation by example:
|
||||
#
|
||||
# Let's say we've got the following (contrived) statement:
|
||||
#
|
||||
# die q{Isn't }, ( $this, ( " fun?\n" ) , ) if "It isn't Monday.";
|
||||
#
|
||||
# This statement should pass because the last parameter that die is going to
|
||||
# get is C<" fun?\n">.
|
||||
#
|
||||
# The approach is to first find the last non-flattened parameter. If this
|
||||
# is a simple token, we're done. Else, it's some aggregate thing. We can't
|
||||
# tell what C<some_function( "foo\n" )> is going to do, so we give up on
|
||||
# anything other than a PPI::Structure::List.
|
||||
#
|
||||
# There are three possible scenarios for the children of a List:
|
||||
#
|
||||
# * No children of the List, i.e. the list looks like C< ( ) >.
|
||||
# * One PPI::Statement::Expression element.
|
||||
# * One PPI::Statement element. That's right, an instance of the base
|
||||
# statement class and not some subclass. *sigh*
|
||||
#
|
||||
# In the first case, we're done. The latter two cases get treated
|
||||
# identically. We get the last child of the Statement and start the search
|
||||
# all over again.
|
||||
#
|
||||
# Back to our example. The PPI tree for this expression is
|
||||
#
|
||||
# PPI::Document
|
||||
# PPI::Statement
|
||||
# PPI::Token::Word 'die'
|
||||
# PPI::Token::Quote::Literal 'q{Isn't }'
|
||||
# PPI::Token::Operator ','
|
||||
# PPI::Structure::List ( ... )
|
||||
# PPI::Statement::Expression
|
||||
# PPI::Token::Symbol '$this'
|
||||
# PPI::Token::Operator ','
|
||||
# PPI::Structure::List ( ... )
|
||||
# PPI::Statement::Expression
|
||||
# PPI::Token::Quote::Double '" fun?\n"'
|
||||
# PPI::Token::Operator ','
|
||||
# PPI::Token::Word 'if'
|
||||
# PPI::Token::Quote::Double '"It isn't Monday.\n"'
|
||||
# PPI::Token::Structure ';'
|
||||
#
|
||||
# We're starting with the Word containing 'die' (it could just as well be
|
||||
# 'warn') because the earlier parts of validate() have taken care of any
|
||||
# other possibility. We're going to scan forward through 'die's siblings
|
||||
# until we reach what we think the end of its parameters are. So we get
|
||||
#
|
||||
# 1. A Literal. A perfectly good argument.
|
||||
# 2. A comma operator. Looks like we've got more to go.
|
||||
# 3. A List. Another argument.
|
||||
# 4. The Word 'if'. Oops. That's a postfix operator.
|
||||
#
|
||||
# Thus, the last parameter is the List. So, we've got to scan backwards
|
||||
# through the components of the List; again, the goal is to find the last
|
||||
# value in the flattened list.
|
||||
#
|
||||
# Before decending into the List, we check that it isn't a subroutine call by
|
||||
# looking at its prior sibling. In this case, the prior sibling is a comma
|
||||
# operator, so it's fine.
|
||||
#
|
||||
# The List has one Expression element as we expect. We grab the Expression's
|
||||
# last child and start all over again.
|
||||
#
|
||||
# 1. The last child is a comma operator, which Perl will ignore, so we
|
||||
# skip it.
|
||||
# 2. The comma's prior sibling is a List. This is the last significant
|
||||
# part of the outer list.
|
||||
# 3. The List's prior sibling isn't a Word, so we can continue because the
|
||||
# List is not a parameter list.
|
||||
# 4. We go through the child Expression and find that the last child of
|
||||
# that is a PPI::Token::Quote::Double, which is a simple, non-compound
|
||||
# token. We return that and we're done.
|
||||
|
||||
sub _find_last_flattened_argument_list_element {
|
||||
my $die_or_warn = shift;
|
||||
|
||||
# Zoom forward...
|
||||
my $current_candidate =
|
||||
_find_last_element_in_subexpression($die_or_warn);
|
||||
|
||||
# ... scan back.
|
||||
while (
|
||||
$current_candidate
|
||||
and not _is_simple_list_element_token( $current_candidate )
|
||||
and not _is_complex_expression_token( $current_candidate )
|
||||
) {
|
||||
if ( $current_candidate->isa('PPI::Structure::List') ) {
|
||||
$current_candidate =
|
||||
_determine_if_list_is_a_plain_list_and_get_last_child(
|
||||
$current_candidate,
|
||||
$die_or_warn
|
||||
);
|
||||
} elsif ( not $current_candidate->isa('PPI::Token') ) {
|
||||
return;
|
||||
} else {
|
||||
$current_candidate = $current_candidate->sprevious_sibling();
|
||||
}
|
||||
}
|
||||
|
||||
return if not $current_candidate;
|
||||
return if _is_complex_expression_token( $current_candidate );
|
||||
|
||||
my $penultimate_element = $current_candidate->sprevious_sibling();
|
||||
if ($penultimate_element) {
|
||||
# Bail if we've got a Word in front of the Element that isn't
|
||||
# the original 'die' or 'warn' or anything else that isn't
|
||||
# a comma or dot operator.
|
||||
if ( $penultimate_element->isa('PPI::Token::Operator') ) {
|
||||
if (
|
||||
$penultimate_element ne $COMMA
|
||||
and $penultimate_element ne $PERIOD
|
||||
) {
|
||||
return;
|
||||
}
|
||||
} elsif ( $penultimate_element != $die_or_warn ) {
|
||||
return
|
||||
}
|
||||
}
|
||||
|
||||
return $current_candidate;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# This is the part where we scan forward from the 'die' or 'warn' to find
|
||||
# the last argument.
|
||||
|
||||
sub _find_last_element_in_subexpression {
|
||||
my $die_or_warn = shift;
|
||||
|
||||
my $last_following_sibling;
|
||||
my $next_sibling = $die_or_warn;
|
||||
while (
|
||||
$next_sibling = $next_sibling->snext_sibling()
|
||||
and not _is_postfix_operator( $next_sibling )
|
||||
) {
|
||||
$last_following_sibling = $next_sibling;
|
||||
}
|
||||
|
||||
return $last_following_sibling;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# Ensure that the list isn't a parameter list. Find the last element of it.
|
||||
|
||||
sub _determine_if_list_is_a_plain_list_and_get_last_child {
|
||||
my ($list, $die_or_warn) = @_;
|
||||
|
||||
my $prior_sibling = $list->sprevious_sibling();
|
||||
|
||||
if ( $prior_sibling ) {
|
||||
# Bail if we've got a Word in front of the List that isn't
|
||||
# the original 'die' or 'warn' or anything else that isn't
|
||||
# a comma operator.
|
||||
if ( $prior_sibling->isa('PPI::Token::Operator') ) {
|
||||
if ( $prior_sibling ne $COMMA ) {
|
||||
return;
|
||||
}
|
||||
} elsif ( $prior_sibling != $die_or_warn ) {
|
||||
return
|
||||
}
|
||||
}
|
||||
|
||||
my @list_children = $list->schildren();
|
||||
|
||||
# If zero children, nothing to look for.
|
||||
# If multiple children, then PPI is not giving us
|
||||
# anything we understand.
|
||||
return if scalar (@list_children) != 1;
|
||||
|
||||
my $list_child = $list_children[0];
|
||||
|
||||
# If the child isn't an Expression or it is some other subclass
|
||||
# of Statement, we again don't understand PPI's output.
|
||||
return if not is_ppi_expression_or_generic_statement($list_child);
|
||||
|
||||
my @statement_children = $list_child->schildren();
|
||||
return if scalar (@statement_children) < 1;
|
||||
|
||||
return $statement_children[-1];
|
||||
}
|
||||
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
Readonly::Hash my %POSTFIX_OPERATORS =>
|
||||
hashify qw{ if unless while until for foreach };
|
||||
|
||||
sub _is_postfix_operator {
|
||||
my $element = shift;
|
||||
|
||||
if (
|
||||
$element->isa('PPI::Token::Word')
|
||||
and $POSTFIX_OPERATORS{$element}
|
||||
) {
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
return $FALSE;
|
||||
}
|
||||
|
||||
|
||||
Readonly::Array my @SIMPLE_LIST_ELEMENT_TOKEN_CLASSES =>
|
||||
qw{
|
||||
PPI::Token::Number
|
||||
PPI::Token::Word
|
||||
PPI::Token::DashedWord
|
||||
PPI::Token::Symbol
|
||||
PPI::Token::Quote
|
||||
PPI::Token::HereDoc
|
||||
};
|
||||
|
||||
sub _is_simple_list_element_token {
|
||||
my $element = shift;
|
||||
|
||||
return $FALSE if not $element->isa('PPI::Token');
|
||||
|
||||
foreach my $class (@SIMPLE_LIST_ELEMENT_TOKEN_CLASSES) {
|
||||
return $TRUE if $element->isa($class);
|
||||
}
|
||||
|
||||
return $FALSE;
|
||||
}
|
||||
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# Tokens that can't possibly be part of an expression simple
|
||||
# enough for us to examine.
|
||||
|
||||
Readonly::Array my @COMPLEX_EXPRESSION_TOKEN_CLASSES =>
|
||||
qw{
|
||||
PPI::Token::ArrayIndex
|
||||
PPI::Token::QuoteLike
|
||||
PPI::Token::Regexp
|
||||
PPI::Token::Cast
|
||||
PPI::Token::Label
|
||||
PPI::Token::Separator
|
||||
PPI::Token::Data
|
||||
PPI::Token::End
|
||||
PPI::Token::Prototype
|
||||
PPI::Token::Attribute
|
||||
PPI::Token::Unknown
|
||||
};
|
||||
|
||||
sub _is_complex_expression_token {
|
||||
my $element = shift;
|
||||
|
||||
return $FALSE if not $element->isa('PPI::Token');
|
||||
|
||||
foreach my $class (@COMPLEX_EXPRESSION_TOKEN_CLASSES) {
|
||||
return $TRUE if $element->isa($class);
|
||||
}
|
||||
|
||||
return $FALSE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# Check whether the given element is contained in a subroutine.
|
||||
|
||||
sub _is_element_contained_in_subroutine {
|
||||
my ( $self, $elem ) = @_;
|
||||
|
||||
my $parent = $elem;
|
||||
while ( $parent = $parent->parent() ) {
|
||||
$parent->isa( 'PPI::Statement::Sub' ) and return $TRUE;
|
||||
$parent->isa( 'PPI::Structure::Block' ) or next;
|
||||
my $prior_elem = $parent->sprevious_sibling() or next;
|
||||
$prior_elem->isa( 'PPI::Token::Word' )
|
||||
and 'sub' eq $prior_elem->content()
|
||||
and return $TRUE;
|
||||
}
|
||||
|
||||
return $FALSE;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# Check whether the given element is in main::
|
||||
|
||||
sub _is_element_in_namespace_main {
|
||||
my ( $self, $elem ) = @_;
|
||||
my $current_elem = $elem;
|
||||
my $prior_elem;
|
||||
|
||||
while ( $current_elem ) {
|
||||
while ( $prior_elem = $current_elem->sprevious_sibling() ) {
|
||||
if ( $prior_elem->isa( 'PPI::Statement::Package' ) ) {
|
||||
return 'main' eq $prior_elem->namespace();
|
||||
}
|
||||
} continue {
|
||||
$current_elem = $prior_elem;
|
||||
}
|
||||
$current_elem = $current_elem->parent();
|
||||
}
|
||||
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ErrorHandling::RequireCarping - Use functions from L<Carp|Carp> instead of C<warn> or C<die>.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The C<die> and C<warn> functions both report the file and line number
|
||||
where the exception occurred. But if someone else is using your
|
||||
subroutine, they usually don't care where B<your> code blew up.
|
||||
Instead, they want to know where B<their> code invoked the subroutine.
|
||||
The L<Carp|Carp> module provides alternative methods that report the
|
||||
exception from the caller's file and line number.
|
||||
|
||||
By default, this policy will not complain about C<die> or C<warn>, if
|
||||
it can determine that the message will always result in a terminal
|
||||
newline. Since perl suppresses file names and line numbers in this
|
||||
situation, it is assumed that no stack traces are desired either and
|
||||
none of the L<Carp|Carp> functions are necessary.
|
||||
|
||||
die "oops" if $explosion; #not ok
|
||||
warn "Where? Where?!" if $tiger; #not ok
|
||||
|
||||
open my $mouth, '<', 'food'
|
||||
or die 'of starvation'; #not ok
|
||||
|
||||
if (! $dentist_appointment) {
|
||||
warn "You have bad breath!\n"; #ok
|
||||
}
|
||||
|
||||
die "$clock not set.\n" if $no_time; #ok
|
||||
|
||||
my $message = "$clock not set.\n";
|
||||
die $message if $no_time; #not ok, not obvious
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
By default, this policy allows uses of C<die> and C<warn> ending in an
|
||||
explicit newline. If you give this policy an
|
||||
C<allow_messages_ending_with_newlines> option in your F<.perlcriticrc>
|
||||
with a false value, then this policy will prohibit such uses.
|
||||
|
||||
[ErrorHandling::RequireCarping]
|
||||
allow_messages_ending_with_newlines = 0
|
||||
|
||||
If you give this policy an C<allow_in_main_unless_in_subroutine> option
|
||||
in your F<.perlcriticrc> with a true value, then this policy will allow
|
||||
C<die> and C<warn> in name space main:: unless they appear in a
|
||||
subroutine, even if they do not end in an explicit newline.
|
||||
|
||||
[ErrorHandling::RequireCarping]
|
||||
allow_in_main_unless_in_subroutine = 1
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Should allow C<die> when it is obvious that the "message" is a reference.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Carp::Always|Carp::Always>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,456 @@
|
|||
package Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Readonly;
|
||||
|
||||
use Scalar::Util qw< refaddr >;
|
||||
|
||||
use Perl::Critic::Utils qw< :booleans :characters :severities hashify
|
||||
precedence_of >;
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => 'Return value of eval not tested.';
|
||||
## no critic (RequireInterpolationOfMetachars)
|
||||
Readonly::Scalar my $EXPL =>
|
||||
q<You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed.>;
|
||||
## use critic
|
||||
|
||||
Readonly::Hash my %BOOLEAN_OPERATORS => hashify qw< || && // or and >;
|
||||
Readonly::Hash my %POSTFIX_OPERATORS =>
|
||||
hashify qw< for foreach if unless while until >;
|
||||
|
||||
Readonly::Scalar my $PRECEDENCE_OF_EQUALS => precedence_of( q{=} );
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw( core bugs ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem->content() ne 'eval';
|
||||
|
||||
my $evaluated = $elem->snext_sibling() or return; # Nothing to eval!
|
||||
my $following = $evaluated->snext_sibling();
|
||||
|
||||
return if _is_returned( $elem ); # GitHub #324
|
||||
return if _is_in_right_hand_side_of_assignment($elem);
|
||||
return if _is_in_postfix_expression($elem);
|
||||
return if
|
||||
_is_in_correct_position_in_a_condition_or_foreach_loop_collection(
|
||||
$elem,
|
||||
$following,
|
||||
);
|
||||
|
||||
return if _scan_backwards_for_grep( $elem ); # RT 69489
|
||||
|
||||
if ( $following and $following->isa('PPI::Token::Operator') ) {
|
||||
return if $BOOLEAN_OPERATORS{ $following->content() };
|
||||
return if q{?} eq $following->content;
|
||||
}
|
||||
|
||||
return $self->violation($DESC, $EXPL, $elem);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _is_in_right_hand_side_of_assignment {
|
||||
my ($elem) = @_;
|
||||
|
||||
my $previous = $elem->sprevious_sibling();
|
||||
|
||||
if (not $previous) {
|
||||
$previous =
|
||||
_grandparent_for_is_in_right_hand_side_of_assignment($elem);
|
||||
}
|
||||
|
||||
while ($previous) {
|
||||
my $base_previous = $previous;
|
||||
|
||||
EQUALS_SCAN:
|
||||
while ($previous) {
|
||||
if ( $previous->isa('PPI::Token::Operator') ) {
|
||||
return $TRUE if $previous->content() =~ m/= \Z/xms;
|
||||
last EQUALS_SCAN if _is_effectively_a_comma($previous);
|
||||
}
|
||||
$previous = $previous->sprevious_sibling();
|
||||
}
|
||||
|
||||
$previous =
|
||||
_grandparent_for_is_in_right_hand_side_of_assignment($base_previous);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _grandparent_for_is_in_right_hand_side_of_assignment {
|
||||
my ($elem) = @_;
|
||||
|
||||
my $parent = $elem->parent() or return;
|
||||
$parent->isa('PPI::Statement') or return;
|
||||
|
||||
my $grandparent = $parent->parent() or return;
|
||||
|
||||
if (
|
||||
$grandparent->isa('PPI::Structure::Constructor')
|
||||
or $grandparent->isa('PPI::Structure::List')
|
||||
) {
|
||||
return $grandparent;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $CONDITION_POSITION_IN_C_STYLE_FOR_LOOP => 1;
|
||||
|
||||
sub _is_in_correct_position_in_a_condition_or_foreach_loop_collection {
|
||||
my ($elem, $following) = @_;
|
||||
|
||||
my $parent = $elem->parent();
|
||||
while ($parent) {
|
||||
if ( $parent->isa('PPI::Structure::Condition') ) {
|
||||
return
|
||||
_is_in_correct_position_in_a_structure_condition(
|
||||
$elem, $parent, $following,
|
||||
);
|
||||
}
|
||||
|
||||
# TECHNICAL DEBT: This code is basically shared with
|
||||
# ProhibitUnusedCapture. I don't want to put this code
|
||||
# into Perl::Critic::Utils::*, but I don't have time to sort out
|
||||
# PPIx::Utilities::Structure::List yet.
|
||||
if (
|
||||
$parent->isa('PPI::Structure::List')
|
||||
and my $parent_statement = $parent->statement()
|
||||
) {
|
||||
return $TRUE if
|
||||
$parent_statement->isa('PPI::Statement::Compound')
|
||||
and $parent_statement->type() eq 'foreach';
|
||||
}
|
||||
|
||||
if ( $parent->isa('PPI::Structure::For') ) {
|
||||
my @for_loop_components = $parent->schildren();
|
||||
|
||||
my $condition =
|
||||
$for_loop_components[$CONDITION_POSITION_IN_C_STYLE_FOR_LOOP]
|
||||
or return;
|
||||
|
||||
return _descendant_of($elem, $condition);
|
||||
}
|
||||
|
||||
$parent = $parent->parent();
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _is_in_correct_position_in_a_structure_condition {
|
||||
my ($elem, $parent, $following) = @_;
|
||||
|
||||
my $level = $elem;
|
||||
while ($level and refaddr $level != $parent) {
|
||||
my $cursor = refaddr $elem == refaddr $level ? $following : $level;
|
||||
|
||||
IS_FINAL_EXPRESSION_AT_DEPTH:
|
||||
while ($cursor) {
|
||||
if ( _is_effectively_a_comma($cursor) ) {
|
||||
$cursor = $cursor->snext_sibling();
|
||||
while ( _is_effectively_a_comma($cursor) ) {
|
||||
$cursor = $cursor->snext_sibling();
|
||||
}
|
||||
|
||||
# Semicolon would be a syntax error here.
|
||||
return if $cursor;
|
||||
last IS_FINAL_EXPRESSION_AT_DEPTH;
|
||||
}
|
||||
|
||||
$cursor = $cursor->snext_sibling();
|
||||
}
|
||||
|
||||
my $statement = $level->parent();
|
||||
return $TRUE if not $statement; # Shouldn't happen.
|
||||
return $TRUE if not $statement->isa('PPI::Statement'); # Shouldn't happen.
|
||||
|
||||
$level = $statement->parent();
|
||||
if (
|
||||
not $level
|
||||
or (
|
||||
not $level->isa('PPI::Structure::List')
|
||||
and not $level->isa('PPI::Structure::Condition')
|
||||
)
|
||||
) {
|
||||
# Shouldn't happen.
|
||||
return $TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
return $TRUE;
|
||||
}
|
||||
|
||||
# Replace with PPI implementation once it is released.
|
||||
sub _descendant_of {
|
||||
my ($cursor, $potential_ancestor) = @_;
|
||||
|
||||
return $EMPTY if not $potential_ancestor;
|
||||
|
||||
while ( refaddr $cursor != refaddr $potential_ancestor ) {
|
||||
$cursor = $cursor->parent() or return $EMPTY;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _is_in_postfix_expression {
|
||||
my ($elem) = @_;
|
||||
|
||||
my $current_base = $elem;
|
||||
while ($TRUE) {
|
||||
my $previous = $current_base->sprevious_sibling();
|
||||
while ($previous) {
|
||||
if (
|
||||
$previous->isa('PPI::Token::Word')
|
||||
and $POSTFIX_OPERATORS{ $previous->content() }
|
||||
) {
|
||||
return $TRUE
|
||||
}
|
||||
$previous = $previous->sprevious_sibling();
|
||||
} # end while
|
||||
|
||||
my $parent = $current_base->parent() or return;
|
||||
if ( $parent->isa('PPI::Statement') ) {
|
||||
return if $parent->specialized();
|
||||
|
||||
my $grandparent = $parent->parent() or return;
|
||||
return if not $grandparent->isa('PPI::Structure::List');
|
||||
|
||||
$current_base = $grandparent;
|
||||
} else {
|
||||
$current_base = $parent;
|
||||
}
|
||||
|
||||
return if not $current_base->isa('PPI::Structure::List');
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _scan_backwards_for_grep {
|
||||
my ( $elem ) = @_;
|
||||
|
||||
while ( $elem ) {
|
||||
|
||||
my $parent = $elem->parent();
|
||||
|
||||
while ( $elem = $elem->sprevious_sibling() ) {
|
||||
$elem->isa( 'PPI::Token::Word' )
|
||||
and 'grep' eq $elem->content()
|
||||
and return $TRUE;
|
||||
$elem->isa( 'PPI::Token::Operator' )
|
||||
and precedence_of( $elem ) >= $PRECEDENCE_OF_EQUALS
|
||||
and return $FALSE;
|
||||
}
|
||||
|
||||
$elem = $parent;
|
||||
}
|
||||
|
||||
return $FALSE;
|
||||
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub _is_effectively_a_comma {
|
||||
my ($elem) = @_;
|
||||
|
||||
return if not $elem;
|
||||
|
||||
return
|
||||
$elem->isa('PPI::Token::Operator')
|
||||
&& (
|
||||
$elem->content() eq $COMMA
|
||||
|| $elem->content() eq $FATCOMMA
|
||||
);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
# GitHub #324 (https://github.com/Perl-Critic/Perl-Critic/issues/324)
|
||||
{
|
||||
Readonly::Scalar my $RETURN => 'return';
|
||||
|
||||
sub _is_returned {
|
||||
my ( $elem ) = @_;
|
||||
my $prev = $elem->sprevious_sibling();
|
||||
return
|
||||
$prev
|
||||
&&
|
||||
$prev->isa( 'PPI::Token::Word' )
|
||||
&&
|
||||
$RETURN eq $prev->content();
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords destructors
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval - You can't depend upon the value of C<$@>/C<$EVAL_ERROR> to tell whether an C<eval> failed.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A common idiom in perl for dealing with possible errors is to use
|
||||
C<eval> followed by a check of C<$@>/C<$EVAL_ERROR>:
|
||||
|
||||
eval {
|
||||
...
|
||||
};
|
||||
if ($EVAL_ERROR) {
|
||||
...
|
||||
}
|
||||
|
||||
There's a problem with this: the value of C<$EVAL_ERROR> can change
|
||||
between the end of the C<eval> and the C<if> statement. The issue is
|
||||
object destructors:
|
||||
|
||||
package Foo;
|
||||
|
||||
...
|
||||
|
||||
sub DESTROY {
|
||||
...
|
||||
eval { ... };
|
||||
...
|
||||
}
|
||||
|
||||
package main;
|
||||
|
||||
eval {
|
||||
my $foo = Foo->new();
|
||||
...
|
||||
};
|
||||
if ($EVAL_ERROR) {
|
||||
...
|
||||
}
|
||||
|
||||
Assuming there are no other references to C<$foo> created, when the
|
||||
C<eval> block in C<main> is exited, C<Foo::DESTROY()> will be invoked,
|
||||
regardless of whether the C<eval> finished normally or not. If the
|
||||
C<eval> in C<main> fails, but the C<eval> in C<Foo::DESTROY()>
|
||||
succeeds, then C<$EVAL_ERROR> will be empty by the time that the C<if>
|
||||
is executed. Additional issues arise if you depend upon the exact
|
||||
contents of C<$EVAL_ERROR> and both C<eval>s fail, because the
|
||||
messages from both will be concatenated.
|
||||
|
||||
Even if there isn't an C<eval> directly in the C<DESTROY()> method
|
||||
code, it may invoke code that does use C<eval> or otherwise affects
|
||||
C<$EVAL_ERROR>.
|
||||
|
||||
The solution is to ensure that, upon normal exit, an C<eval> returns a
|
||||
true value and to test that value:
|
||||
|
||||
# Constructors are no problem.
|
||||
my $object = eval { Class->new() };
|
||||
|
||||
# To cover the possibility that an operation may correctly return a
|
||||
# false value, end the block with "1":
|
||||
if ( eval { something(); 1 } ) {
|
||||
...
|
||||
}
|
||||
|
||||
eval {
|
||||
...
|
||||
1;
|
||||
}
|
||||
or do {
|
||||
# Error handling here
|
||||
};
|
||||
|
||||
Unfortunately, you can't use the C<defined> function to test the
|
||||
result; C<eval> returns an empty string on failure.
|
||||
|
||||
Various modules have been written to take some of the pain out of
|
||||
properly localizing and checking C<$@>/C<$EVAL_ERROR>. For example:
|
||||
|
||||
use Try::Tiny;
|
||||
try {
|
||||
...
|
||||
} catch {
|
||||
# Error handling here;
|
||||
# The exception is in $_/$ARG, not $@/$EVAL_ERROR.
|
||||
}; # Note semicolon.
|
||||
|
||||
"But we don't use DESTROY() anywhere in our code!" you say. That may
|
||||
be the case, but do any of the third-party modules you use have them?
|
||||
What about any you may use in the future or updated versions of the
|
||||
ones you already use?
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
See thread on perl5-porters starting here:
|
||||
L<http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-06/msg00537.html>.
|
||||
|
||||
For a nice, easy, non-magical way of properly handling exceptions, see
|
||||
L<Try::Tiny|Try::Tiny>.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Elliot Shank C<< <perl@galumph.com> >>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2008-2011 Elliot Shank.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,146 @@
|
|||
package Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities is_in_void_context };
|
||||
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $EXPL => q{Use IPC::Open3 instead};
|
||||
Readonly::Scalar my $DESC => q{Backtick operator used};
|
||||
|
||||
Readonly::Scalar my $VOID_EXPL => q{Assign result to a variable or use system() instead};
|
||||
Readonly::Scalar my $VOID_DESC => q{Backtick operator used in void context};
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters {
|
||||
return (
|
||||
{
|
||||
name => 'only_in_void_context',
|
||||
description => 'Allow backticks everywhere except in void contexts.',
|
||||
behavior => 'boolean',
|
||||
},
|
||||
);
|
||||
}
|
||||
|
||||
sub default_severity { return $SEVERITY_MEDIUM }
|
||||
sub default_themes { return qw(core maintenance) }
|
||||
sub applies_to { return qw(PPI::Token::QuoteLike::Backtick
|
||||
PPI::Token::QuoteLike::Command ) }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
if ( $self->{_only_in_void_context} ) {
|
||||
return if not is_in_void_context( $elem );
|
||||
|
||||
return $self->violation( $VOID_DESC, $VOID_EXPL, $elem );
|
||||
}
|
||||
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=for stopwords perlipc
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators - Discourage stuff like C<@files = `ls $directory`>.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Backticks are super-convenient, especially for CGI programs, but I
|
||||
find that they make a lot of noise by filling up STDERR with messages
|
||||
when they fail. I think its better to use IPC::Open3 to trap all the
|
||||
output and let the application decide what to do with it.
|
||||
|
||||
use IPC::Open3 'open3';
|
||||
$SIG{CHLD} = 'IGNORE';
|
||||
|
||||
@output = `some_command`; #not ok
|
||||
|
||||
my ($writer, $reader, $err);
|
||||
open3($writer, $reader, $err, 'some_command'); #ok;
|
||||
@output = <$reader>; #Output here
|
||||
@errors = <$err>; #Errors here, instead of the console
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
Alternatively, if you do want to use backticks, you can restrict
|
||||
checks to void contexts by adding the following to your
|
||||
F<.perlcriticrc> file:
|
||||
|
||||
[InputOutput::ProhibitBacktickOperators]
|
||||
only_in_void_context = 1
|
||||
|
||||
The purpose of backticks is to capture the output of an external
|
||||
command. Use of them in a void context is likely a bug. If the
|
||||
output isn't actually required, C<system()> should be used. Otherwise
|
||||
assign the result to a variable.
|
||||
|
||||
`some_command`; #not ok
|
||||
$output = `some_command`; #ok
|
||||
@output = `some_command`; #ok
|
||||
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
This policy also prohibits the generalized form of backticks seen as
|
||||
C<qx{}>.
|
||||
|
||||
See L<perlipc|perlipc> for more discussion on using C<wait()> instead
|
||||
of C<$SIG{CHLD} = 'IGNORE'>.
|
||||
|
||||
You might consider using the C<capture()> function from the
|
||||
L<IPC::System::Simple|IPC::System::Simple> module for a safer way of
|
||||
doing what backticks do, especially on Windows. The module also has a
|
||||
safe wrapper around C<system()>.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,114 @@
|
|||
package Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification :ppi };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Bareword file handle opened};
|
||||
Readonly::Scalar my $EXPL => [ 202, 204 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGHEST }
|
||||
sub default_themes { return qw( core pbp bugs certrec ) }
|
||||
sub applies_to { return 'PPI::Token::Word' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self, $elem, undef) = @_;
|
||||
|
||||
return if $elem->content() ne 'open';
|
||||
return if ! is_function_call($elem);
|
||||
|
||||
my $first_arg = ( parse_arg_list($elem) )[0];
|
||||
return if !$first_arg;
|
||||
my $first_token = $first_arg->[0];
|
||||
return if !$first_token;
|
||||
|
||||
if ( $first_token->isa('PPI::Token::Word') ) {
|
||||
if ( ($first_token ne 'my') && ($first_token !~ m/^STD(?:IN|OUT|ERR)$/xms ) ) {
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
}
|
||||
return; #ok!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles - Write C<open my $fh, q{<}, $filename;> instead of C<open FH, q{<}, $filename;>.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Using bareword symbols to refer to file handles is particularly evil
|
||||
because they are global, and you have no idea if that symbol already
|
||||
points to some other file handle. You can mitigate some of that risk
|
||||
by C<local>izing the symbol first, but that's pretty ugly. Since Perl
|
||||
5.6, you can use an undefined scalar variable as a lexical reference
|
||||
to an anonymous filehandle. Alternatively, see the
|
||||
L<IO::Handle|IO::Handle> or L<IO::File|IO::File> or
|
||||
L<FileHandle|FileHandle> modules for an object-oriented approach.
|
||||
|
||||
open FH, '<', $some_file; #not ok
|
||||
open my $fh, '<', $some_file; #ok
|
||||
my $fh = IO::File->new($some_file); #ok
|
||||
|
||||
There are three exceptions: STDIN, STDOUT and STDERR. These three
|
||||
standard filehandles are always package variables.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<IO::Handle|IO::Handle>
|
||||
|
||||
L<IO::File|IO::File>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,121 @@
|
|||
package Perl::Critic::Policy::InputOutput::ProhibitExplicitStdin;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities :classification &parse_arg_list };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Use "<>" or "<ARGV>" or a prompting module instead of "<STDIN>"};
|
||||
Readonly::Scalar my $EXPL => [216,220,221];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGH }
|
||||
sub default_themes { return qw( core pbp maintenance ) }
|
||||
sub applies_to { return 'PPI::Token::QuoteLike::Readline' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ( $self, $elem, undef ) = @_;
|
||||
|
||||
return if $elem ne '<STDIN>';
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::InputOutput::ProhibitExplicitStdin - Use "<>" or "<ARGV>" or a prompting module instead of "<STDIN>".
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Perl has a useful magic filehandle called C<*ARGV> that checks the
|
||||
command line and if there are any arguments, opens and reads those as
|
||||
files. If there are no arguments, C<*ARGV> behaves like C<*STDIN>
|
||||
instead. This behavior is almost always what you want if you want to
|
||||
create a program that reads from C<STDIN>. This is often written in
|
||||
one of the following two equivalent forms:
|
||||
|
||||
while (<ARGV>) {
|
||||
# ... do something with each input line ...
|
||||
}
|
||||
# or, equivalently:
|
||||
while (<>) {
|
||||
# ... do something with each input line ...
|
||||
}
|
||||
|
||||
If you want to prompt for user input, try special purpose modules like
|
||||
L<IO::Prompt|IO::Prompt>.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 CAVEATS
|
||||
|
||||
Due to a bug in the current version of PPI (v1.119_03) and earlier,
|
||||
the readline operator is often misinterpreted as less-than and
|
||||
greater-than operators after a comma. Therefore, this policy misses
|
||||
important cases like
|
||||
|
||||
my $content = join '', <STDIN>;
|
||||
|
||||
because it interprets that line as the nonsensical statement:
|
||||
|
||||
my $content = join '', < STDIN >;
|
||||
|
||||
When that PPI bug is fixed, this policy should start catching those
|
||||
violations automatically.
|
||||
|
||||
=head1 CREDITS
|
||||
|
||||
Initial development of this policy was supported by a grant from the
|
||||
Perl Foundation.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2007-2011 Chris Dolan. Many rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself. The full text of this license
|
||||
can be found in the LICENSE file included with this module
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
|
|
@ -0,0 +1,83 @@
|
|||
package Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Readonly;
|
||||
|
||||
use Perl::Critic::Utils qw{ :severities };
|
||||
use base 'Perl::Critic::Policy';
|
||||
|
||||
our $VERSION = '1.140';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
Readonly::Scalar my $DESC => q{Use IO::Interactive::is_interactive() instead of -t};
|
||||
Readonly::Scalar my $EXPL => [ 218 ];
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub supported_parameters { return () }
|
||||
sub default_severity { return $SEVERITY_HIGHEST }
|
||||
sub default_themes { return qw( core pbp bugs certrule ) }
|
||||
sub applies_to { return 'PPI::Token::Operator' }
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
sub violates {
|
||||
my ($self, $elem, $doc) = @_;
|
||||
return if $elem->content() ne '-t';
|
||||
return $self->violation( $DESC, $EXPL, $elem );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest - Use prompt() instead of -t.
|
||||
|
||||
=head1 AFFILIATION
|
||||
|
||||
This Policy is part of the core L<Perl::Critic|Perl::Critic>
|
||||
distribution.
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The C<-t> operator is fragile and complicated. When you are testing
|
||||
whether C<STDIN> is interactive, It's much more robust to use
|
||||
well-tested CPAN modules like L<IO::Interactive|IO::Interactive>.
|
||||
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
This Policy is not configurable except for the standard options.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Chris Dolan <cdolan@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006-2011 Chris Dolan.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
# Local Variables:
|
||||
# mode: cperl
|
||||
# cperl-indent-level: 4
|
||||
# fill-column: 78
|
||||
# indent-tabs-mode: nil
|
||||
# c-indentation-style: bsd
|
||||
# End:
|
||||
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue