--- /dev/null
+use strict;
+use warnings;
+use Module::Build;
+
+my $builder = Module::Build->new(
+
+ module_name => 'Perl::Critic',
+ dist_author => 'Jeffrey Thalhammer <thaljef@cpan.org>',
+ dist_abstract => 'Critique Perl source for style and standards',
+ license => 'perl',
+
+ requires => {'PPI' => 1.103,
+ 'Config::Tiny' => 2,
+ 'File::Spec' => 0,
+ 'List::MoreUtils' => 0,
+ 'List::Util' => 0,
+ 'Pod::Usage' => 0,
+ 'Pod::PlainText' => 0,
+ 'IO::String' => 0,
+ 'String::Format' => 1.13,
+
+ },
+
+ build_requires => {'Test::More' => 0,
+ },
+
+ recommends => {'Perl::Tidy' => 0,},
+ script_files => ['bin/perlcritic'],
+);
+
+$builder->create_build_script();
--- /dev/null
+[0.13] Released on 051031
+
+ Production release of 0.12_03. No code major changes.
+
+[0.12_03] Not released
+
+ Renamed -Policy option to -include. Added -exclude to give the
+ opposite effect.
+
+ Refactored constructor of Perl::Critic. Now, most of the work
+ is delegated to Perl::Critic::Config. I'm not sure I like how
+ this turned out, but we'll see how it goes.
+
+ Renamed some Policy modules to be a bit more comprehensible. Note
+ that you may need to change your .perlcriticrc file accordingly.
+ I also suggest removing your current Perl::Critic installation
+ before installing this one.
+
+ Name Changes:
+ * ProhibitUnpackagedCode => RequireExplicitPackage
+ * RequireQuotedWords => ProhibitQuotedWordLists
+
+ Improved error message when Perl::Critic dies because PPI can't
+ parsee the input code.
+
+ Changed output of -help to be more terse.
+
+ Edited POD.
+
+[0.12_02] Not released
+
+ Added -Policy option to perlcritic. The idea is to provide a
+ compact interface for selecting Policy modules at the command-line.
+ This feature is experimental and subject to change.
+
+ Added a warning message if -verbose value looks strange. In most
+ applications, the -verbose option does not require a value, so people
+ might be puzzled when they write 'perlcritic -verbose my_file.pm' and
+ nothing seems to happen.
+
+ Command-line options to perlcritic are now case-sensitive. This
+ makes it easier to abbreviate options that start with the same letters
+ (e.g. 'Version' and 'verbose')
+
+ Fixed the new Policy modules that were misnamed and misplaced in the
+ previous distribution.
+
+[0.12_01] Not released
+
+ Rewrote some of the ControlStructures and BuiltinFunction
+ policies to be simpler (and probably a little faster).
+
+ Edited POD. Fixed some typos. Added PREREQUISITES section
+ to Perl::Critic documentation.
+
+ Fixed the -verbose FORMAT option so that you can put metachars
+ in the FORMAT specification. If using perlcritic, be careful to
+ protect them from getting munged by the shell first.
+
+ Replaced ProhibitRequireStatements with RequireBarewordIncludes
+ module. Courtesy of Chris Dolan <cdolan@cpan.org>
+
+ Added configuration to ProhibitInterpolationOfLiterals so that
+ certain flavors of quotes can be exempt. This is for folks who
+ have configured their editor to use special syntax highlighting
+ for certain kinds of strings (SQL, for example).
+
+ perlcritic now accepts multiple file arguments, so now you can
+ critique your entire distribution in one shot. As a result, the
+ output-formats have changed slightly.
+
+ New Policy modules:
+ * BuiltinFunctions::ProhibitLvalueSubstr
+ * BuiltinFunctions::ProhibitSleepViaSelect
+ * ClassHierarchies::ProhibitOneArgBless
+ * CodeLayout::RequireTrailingCommas
+ * CodeLayout::RequireQuotedWordLists
+ * InputOutput::ProhibitTwoArgOpen
+ * InputOutput::ProhibitOneArgSelect
+ * InputOutput::ProhibitBarewordFileHandles
+ * Miscellanea::RequireRcsKeywords
+ * Modules::RequireVersionVar
+ * RegularExpressions::RequireExtendedFormatting
+ * RegularExpressions::RequireLineBoundaryMatching
+
+
+ Bug fixes:
+ 14923: 'require' is now permitted. See RequireBarewordIncludes.
+ 15022: Fixed false-positives when keywords are used as hash keys.
+ 15023: Fixed spurious Violations by removing magic shebang.
+ 15031: Fixed spelling mistakes (and probably added some new ones).
+ 15233: Postfix 'if' is now allowed with 'die', 'croak', etc.
+
+[0.12] Released 051010
+
+ Redesigned the 'verbose' feature. Now the output format
+ can be user-defined using a sprintf-like specification.
+ perlciritc also has a predefined output format that is
+ compatible with grep mode in editors like vim and emacs.
+
+ 'return' is now exempt from ProhibitParensWithBuiltins. I may
+ extend this exemption to all unary functions.
+
+ Edited POD. Added a super brief description of each policy
+ in the main Perl::Critic documentation. Added details about
+ editor integration.
+
+ Additional Prerequisites:
+ * String::Format
+
+[0.11] Not released
+
+ The internal dynamics and API of Perl::Critic have changed
+ considerably. The result is a 300% increase in performance.
+ See the POD in Perl::Critic::Policy for details.
+
+ New Features:
+ * Added -verbose option to put more stuff in the output. In the
+ extreme, you can get the POD from Policy attached to each
+ and every violation.
+
+ Additional Prerequisites:
+ * IO::String
+ * Pod::PlainText
+
+[0.10] Released 051005
+
+ Fixed stupid bug in newest Policy modules. They were returning
+ PPI objects instead of Perl::Critic::Violation objects. Doh!
+
+ Fixed test scripts to prevent failures if the user already has a
+ .perlcriticrc file.
+
+ 'ProhibitHardTabs' now allows leading tabs by default.
+
+ Put the Changes file in reverse-chronological order, so the most
+ recent stuff is easy to find at the top of the file
+
+[0.09] Released 051004
+
+ Fixed several bugs:
+ * 14810: Now you are allowed to create your own 'import' function,
+ since this is frequently done with fancy modules.
+ * 14817: Parens, brackets, and braces are now excluded from
+ 'ProhibitNoisyQuotes' since they look better in quotes anyway.
+ * 14787: $1..$9 and '_' are exempt from ProhibitPunctuationVars
+ * 14899: Object methods with the same name as a built-in can
+ be called with parens (ProhibitParensWithBuiltins).
+ * 14901: Normalized the exit status of perlcritic to 0, 1, or 2.
+ See documentation for explanation.
+ * 14855: Partially fixed home directory discovery. Still not
+ completely portable, but at least doesn't create warnings.
+
+ New features:
+ * 14734: Limit for number separators is now configurable
+
+ New Policy modules:
+ * CodeLayout::ProhibitHardTabs
+ * ControlStructures::ProhibitUnlessBlocks
+ * ControlStructures::ProhibitUntilBlocks
+ * ControlStructures::ProhibitCStyleForLoops
+
+ Changed the syntax for the magic comments. Adam had the
+ idea of using a pragma-like notation. I liked it.
+
+[0.08_2] Released 050927
+
+ Fixed problems with Perl::Critic::Config that caused File::Spec
+ to emit 'uninitialized value' warnings during the build.
+
+ Added 1 Policy module contributed by Graham TerMarsch
+
+ Switched from File::Spec::Functions to plain File::Spec because
+ I think its usage is more common.
+
+ Removed 'FindBin' from the test files so I can be sure that the
+ right libraries are getting loaded. This means I'll have to
+ use the -l option with C<prove>.
+
+ Edited more POD.
+
+[0.08_01] Not released
+
+ Fixed "ProhibitParensWithBuiltins" to allow parens to be used with
+ object method calls that have the same name as a builtin functions.
+
+ Introduced magical comments that allow developers to configure
+ Perl::Critic on-the-fly from within their code.
+
+ Added META.yml files and POD tests to the build. I did this
+ mostly just to boost the Kwalitee score on CPANTS.
+
+ Switched from "Config::Std" to "Config::Tiny" because it doesn't
+ require those fancy Damian modules that don't seem to work on
+ some older versions of Perl.
+
+[0.07] Released on 050921
+
+ Fixed bugs in the ProhibitCascadingIfElse policy.
+
+ Added ProhibitExplicitReturnUndef policy
+
+ Made ProhibitUnpackagedCode configurable so you can exempt scripts,
+ which typically don't have an explicit 'package' statement.
+
+ ProhibitPackageVars policy now exempts vars in ALL_CAPS. This
+ is to permit common package variables like @EXPORT and $VERSION.
+
+ Renamed "ProhibitStringyGrep and "ProhibitStringyMap" because
+ the so-called string form doesn't really exist. Now called
+ "RequireBlockGrep" and "RequireBlockMap"
+
+ Corrected documentation on defining Policy names within the
+ configuration file. This still isn't very clear and needs
+ to be rewritten.
+
+ Perl::Critic now requires PPI version 1.003, which has a few bug
+ fixes of its own.
+
+ Rewrite some code just to make Perl::Critic more self-compliant.
+
+ Added test cases to verify the configuration functionality. These
+ are not completely thorough and need more work.
+
+[0.06] Released on 050917
+
+ Now called 'Perl::Critic'.
+
+ Added 4 new policy modules.
+
+ Fixed bugs in build process.
+
+ Added support for Module::Build.
+
+[0.05] Released on 050917
+
+ End of 'Perl::Review' releases. I have changed the name to
+ 'Perl::Critic' to avoid possible confusion with "The Perl Review"
+ magazine.
+
+[0.04] Released on 050914
+
+ Version 0.03 was a bust because I uploaded the wrong tarball to PAUSE.
+
+[0.03] Released on 050913.
+
+ Fixed some POD links.
+
+ Removed test cases for missing policy module.
+
+[0.02] Released on 050913.
+
+ Major overhaul based on feedback from Perl community.
+
+ Factored coding standards into separate modules (known as
+ Policies). The idea here is to allow other developers to easily
+ contribute additional coding standards.
+
+ Reworked Perl::Review into a simple engine for loading and running
+ Policy modules.
+
+ Gave perlreview a command-line interface and configuration file
+ for selecting which Policy modules to use.
+
+[0.01] Released on 050816.
+
+ Initial version.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
--- /dev/null
+######################################################################
+# Perl::Critic #
+# Version 0.13 #
+# by Jeffrey R. Thalhammer #
+# <thaljef@cpan.org> #
+######################################################################
+
+
+NOTICE
+
+ The Perl::Critic distribution contains a fairly large number
+ of modules. And since it is still developing rapidly, some
+ of those modules may disappear or be renamed fron one release
+ to the next. Therefore, I suggest removing any existing
+ installation of Perl::Critic before installing a new one.
+
+INSTALLATION
+
+ To install Perl::Critic with C<make> give the following
+ commands to your favorite shell:
+
+ tar -zxf Perl-Critic-0.13.tar.gz
+ cd Perl-Critic-0.13
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+ Or if you prefer C<Module::Build>, try this:
+
+ tar -zxf Perl-Critic-0.13.tar.gz
+ cd Perl-Critic-0.13
+ perl Build.pl
+ ./Build
+ ./Build test
+ ./Build install
\ No newline at end of file
--- /dev/null
+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"
+
+----------------------------------------------------------------------------
+
+The General Public License (GPL)
+Version 2, June 1991
+
+Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave,
+Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute
+verbatim copies of this license document, but changing it is not allowed.
+
+Preamble
+
+The licenses for most software are designed to take away your freedom to share
+and change it. By contrast, the GNU 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. This General Public License applies to most of
+the Free Software Foundation's software and to any other program whose
+authors commit to using it. (Some other Free Software Foundation software is
+covered by the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+When we speak of free software, we are referring to freedom, not price. Our
+General Public Licenses are designed to make sure that you have the freedom
+to distribute copies of free software (and charge for this service if you wish), 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 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 show
+them these terms so they know 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.
+
+Finally, any free program is threatened constantly by software patents. We wish
+to avoid the danger that redistributors of a free program will individually obtain
+patent licenses, in effect making the program proprietary. To prevent this, we
+have made it clear that any patent must be licensed for everyone's free use or
+not licensed at all.
+
+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 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
+derivative work under copyright law: that is to say, a work containing the
+Program or a portion of it, either verbatim or with modifications and/or translated
+into another language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not covered by
+this License; they are outside its scope. The act of running the Program is not
+restricted, and the output from the Program is covered only if its contents
+constitute a work based on the Program (independent of having been made by
+running the Program). Whether that is true depends on what the Program does.
+
+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 License and to the absence of any
+warranty; and give any other recipients of the Program a copy of this License
+along with the Program.
+
+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.
+
+2. You may modify your copy or copies of the Program or any portion of it, thus
+forming a work based on the Program, and copy and distribute such
+modifications or work under the terms of Section 1 above, provided that you also
+meet all of these conditions:
+
+a) You must cause the modified files to carry prominent notices stating that you
+changed the files and the date of any change.
+
+b) You must cause any work that you distribute or publish, that in whole or in
+part contains or is derived from the Program or any part thereof, to be licensed
+as a whole at no charge to all third parties under the terms of this License.
+
+c) If the modified program normally reads commands interactively when run, you
+must cause it, when started running for such interactive use in the most ordinary
+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 License. (Exception: if the
+Program itself is interactive but does not normally print such an announcement,
+your work based on the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If identifiable
+sections of that work are not derived from the Program, and can be reasonably
+considered independent and separate works in themselves, then this License,
+and its terms, do not apply to those sections when you distribute them as
+separate works. But when you distribute the same sections as part of a whole
+which is a work based on the Program, the distribution of the whole must be on
+the terms of this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest your rights to
+work written entirely by you; rather, the intent is to exercise the right to control
+the distribution of derivative or collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program with the
+Program (or with a work based on the Program) on a volume of a storage or
+distribution medium does not bring the other work under the scope of this
+License.
+
+3. You may copy and distribute the Program (or a work based on it, under
+Section 2) in object code or executable form under the terms of Sections 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 Sections 1 and 2 above on a
+medium customarily used for software interchange; or,
+
+b) Accompany it with a written offer, valid for at least three years, to give any
+third party, for a charge no more than your cost of physically performing source
+distribution, a complete machine-readable copy of the corresponding source
+code, to be distributed under the terms of Sections 1 and 2 above on a medium
+customarily used for software interchange; or,
+
+c) Accompany it with the information you received as to the offer to distribute
+corresponding source code. (This alternative is allowed only for noncommercial
+distribution and only if you received the program in object code or executable
+form with such an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for making
+modifications to it. For an executable work, complete source code means all the
+source code for all modules it contains, plus any associated interface definition
+files, plus the scripts used to control compilation and installation of the
+executable. However, as a special exception, the source code distributed need
+not include anything that is normally distributed (in either source or binary form)
+with the major components (compiler, kernel, and so on) of the operating system
+on which the executable runs, unless that component itself accompanies the
+executable.
+
+If distribution of executable or object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the source
+code from the same place counts as distribution of the source code, even though
+third parties are not compelled to copy the source along with the object code.
+
+4. You may not copy, modify, sublicense, or distribute the Program except as
+expressly provided under this License. Any attempt otherwise to copy, modify,
+sublicense or distribute the Program is void, and will automatically terminate
+your rights under this License. However, parties who have received copies, or
+rights, from you under this License will not have their licenses terminated so long
+as such parties remain in full compliance.
+
+5. You are not required to accept this License, since you have not signed it.
+However, nothing else grants you permission to modify or distribute the Program
+or its derivative works. These actions are prohibited by law if you do not accept
+this License. Therefore, by modifying or distributing 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 for copying, distributing or modifying the
+Program or works based on it.
+
+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. You are not responsible for enforcing compliance by third parties
+to this License.
+
+7. If, as a consequence of a court judgment or allegation of patent infringement
+or for any other reason (not limited to patent issues), conditions are imposed on
+you (whether by court order, agreement or otherwise) that contradict the
+conditions of this License, they do not excuse you from the conditions of this
+License. If you cannot distribute so as to satisfy simultaneously your obligations
+under this License and any other pertinent obligations, then as a consequence
+you may not distribute the Program at all. For example, if a patent license would
+not permit royalty-free redistribution of the Program by all those who receive
+copies directly or indirectly through you, then the only way you could satisfy
+both it and this License would be to refrain entirely from distribution of the
+Program.
+
+If any portion of this section is held invalid or unenforceable under any particular
+circumstance, the balance of the section is intended to apply and the section as
+a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any patents or other
+property right claims or to contest validity of any such claims; this section has
+the sole purpose of protecting the integrity of the free software distribution
+system, which is implemented by public license practices. Many people have
+made generous contributions to the wide range of software distributed through
+that system in reliance on consistent application of that system; it is up to the
+author/donor to decide if he or she is willing to distribute software through any
+other system and a licensee cannot impose that choice.
+
+This section is intended to make thoroughly clear what is believed to be a
+consequence of the rest of this License.
+
+8. If the distribution and/or use of the Program is restricted in certain countries
+either by patents or by copyrighted interfaces, the original copyright holder who
+places the Program under this License may add an explicit geographical
+distribution limitation excluding those countries, so that distribution is permitted
+only in or among countries not thus excluded. In such case, this License
+incorporates the limitation as if written in the body of this License.
+
+9. 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 this 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 this License, you may choose any version ever
+published by the Free Software Foundation.
+
+10. 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
+
+11. 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.
+
+12. 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
+
+
--- /dev/null
+bin/perlcritic
+Build.PL
+Changes
+INSTALL
+lib/Perl/Critic.pm
+lib/Perl/Critic/Config.pm
+lib/Perl/Critic/Policy.pm
+lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitLvalueSubstr.pm
+lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitSleepViaSelect.pm
+lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringyEval.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/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/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/ProhibitPostfixControls.pm
+lib/Perl/Critic/Policy/ControlStructures/ProhibitUnlessBlocks.pm
+lib/Perl/Critic/Policy/ControlStructures/ProhibitUntilBlocks.pm
+lib/Perl/Critic/Policy/InputOutput/ProhibitBacktickOperators.pm
+lib/Perl/Critic/Policy/InputOutput/ProhibitBarewordFileHandles.pm
+lib/Perl/Critic/Policy/InputOutput/ProhibitOneArgSelect.pm
+lib/Perl/Critic/Policy/InputOutput/ProhibitTwoArgOpen.pm
+lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.pm
+lib/Perl/Critic/Policy/Modules/ProhibitMultiplePackages.pm
+lib/Perl/Critic/Policy/Modules/ProhibitSpecificModules.pm
+lib/Perl/Critic/Policy/Modules/RequireBarewordIncludes.pm
+lib/Perl/Critic/Policy/Modules/RequireExplicitPackage.pm
+lib/Perl/Critic/Policy/Modules/RequireVersionVar.pm
+lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseSubs.pm
+lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.pm
+lib/Perl/Critic/Policy/RegularExpressions/RequireExtendedFormatting.pm
+lib/Perl/Critic/Policy/RegularExpressions/RequireLineBoundaryMatching.pm
+lib/Perl/Critic/Policy/Subroutines/ProhibitBuiltinHomonyms.pm
+lib/Perl/Critic/Policy/Subroutines/ProhibitExplicitReturnUndef.pm
+lib/Perl/Critic/Policy/Subroutines/ProhibitSubroutinePrototypes.pm
+lib/Perl/Critic/Policy/TestingAndDebugging/RequirePackageStricture.pm
+lib/Perl/Critic/Policy/TestingAndDebugging/RequirePackageWarnings.pm
+lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitConstantPragma.pm
+lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyQuotes.pm
+lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitInterpolationOfLiterals.pm
+lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLeadingZeros.pm
+lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNoisyQuotes.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/ProhibitLocalVars.pm
+lib/Perl/Critic/Policy/Variables/ProhibitPackageVars.pm
+lib/Perl/Critic/Policy/Variables/ProhibitPunctuationVars.pm
+lib/Perl/Critic/Utils.pm
+lib/Perl/Critic/Violation.pm
+LICENSE
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/00_modules.t
+t/01_config.t
+t/02_policies.t
+t/03_pragmas.t
+t/04_criticize.t
+t/98_pod-syntax.t
+t/99_pod-coverage.t
+t/samples/perlcriticrc.all
+t/samples/perlcriticrc.levels
+t/samples/perlcriticrc.none
+TODO
--- /dev/null
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Perl-Critic
+version: 0.13
+version_from: lib/Perl/Critic.pm
+installdirs: site
+requires:
+ Config::Tiny: 2
+ File::Spec: 0
+ IO::String: 0
+ List::MoreUtils: 0
+ List::Util: 0
+ Pod::PlainText: 0
+ Pod::Usage: 0
+ PPI: 1.103
+ String::Format: 1.13
+ Test::More: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
--- /dev/null
+use strict;
+use warnings;
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile( NAME => 'Perl::Critic',
+ AUTHOR => 'Jeffrey Thalhammer <thaljef@cpan.org>',
+ ABSTRACT_FROM => 'lib/Perl/Critic.pm',
+ VERSION_FROM => 'lib/Perl/Critic.pm',
+ EXE_FILES => ['bin/perlcritic'],
+ PL_FILES => {},
+ PREREQ_PM => {'PPI' => 1.103,
+ 'Config::Tiny' => 2,
+ 'File::Spec' => 0,
+ 'List::MoreUtils' => 0,
+ 'List::Util' => 0,
+ 'Pod::Usage' => 0,
+ 'Pod::PlainText' => 0,
+ 'Test::More' => 0,
+ 'IO::String' => 0,
+ 'String::Format' => 1.13,
+ },
+
+);
--- /dev/null
+NAME
+ Perl::Critic - Critique Perl source for style and standards
+
+SYNOPSIS
+ use Perl::Critic;
+
+ #Create Critic and load Policies from default config file
+ $critic = Perl::Critic->new();
+
+ #Create Critic and load only the most important Polices
+ $critic = Perl::Critic->new(-priority => 1);
+
+ #Create Critic and load Policies from specific config file
+ $critic = Perl::Critic->new(-profile => $file);
+
+ #Create Critic and load Policy by hand
+ $critic = Perl::Critic->new(-profile => 'NONE');
+ $critic->add_policy('MyPolicyModule');
+
+ #Analyze code for policy violations
+ @violations = $critic->critique($source_code);
+
+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 Policies are based on Damian Conway's book Perl Best
+ Practices. You can choose and customize those Polices through the
+ Perl::Critic interface. You can also create new Policy modules that suit
+ your own tastes.
+
+ For a convenient 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 a nice interface that is
+ suitable for test scripts.
+
+CONSTRUCTOR
+ new ( [ -profile => $FILE, -priority => $N, -include => \@PATTERNS,
+ -exclude => \@PATTERNS, -force => 1 ] )
+ 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. 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 it defaults to include all the Policy modules that
+ ship with Perl::Critic. See "CONFIGURATION" for more
+ information.
+
+ -priority is the maximum priority value of Policies that should
+ be added to the Perl::Critic::Config. 1 is the "highest"
+ priority, and all numbers larger than 1 have "lower" priority.
+ Once the user-preferences have been read from the "-profile",
+ All Policies that are configured with a priority greater than $N
+ will be removed from this Config. For a given "-profile",
+ increasing $N will result in more Policy violations. The default
+ "-priority" is 1. See "CONFIGURATION" for more information.
+
+ -include is a reference to a list of @PATTERNS. Once the
+ user-preferences have been read from the "-profile", all
+ Policies that do not match at least one "m/$PATTERN/imx" will be
+ removed from this Config. Using the "-include" option causes the
+ <-priority> option to be ignored.
+
+ -exclude is a reference to a list of @PATTERNS. Once the
+ user-preferences have been read from the "-profile", all
+ Policies that match at least one "m/$PATTERN/imx" will be
+ removed from the Config. Using the "-exclude" option causes the
+ <-priority> option to be ignored. The "-exclude" patterns are
+ applied after the <-include> patterns, therefore, the "-exclude"
+ patterns take precedence.
+
+ -force controls whether Perl::Critic observes the magical ""no
+ critic"" pseudo-pragmas 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 overlook code that is
+ tagged with these comments. See "BENDING THE RULES" for more
+ information.
+
+METHODS
+ add_policy( -policy => $STRING [, -config => \%HASH ] )
+ Loads a Policy into this Critic engine. The engine will attempt
+ to "require" the module named by $STRING and instantiate it. If
+ the module fails to load or cannot be instantiated, it will
+ throw a warning and return a false value. Otherwise, it returns
+ a reference to this Critic engine.
+
+ -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.
+
+ -config is an optional reference to a hash of Policy
+ configuration parameters (Note that this is not a
+ Perl::Critic::Config object). 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.
+
+ 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 string
+ of actual Perl code. Otherwise, it is treated as a path to a
+ file containing Perl code. 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, returns an empty
+ list.
+
+ policies( void )
+ 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.
+
+CONFIGURATION
+ The default configuration file is called .perlcriticrc.
+ Perl::Critic::Config 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, Perl::Critic::Config defaults to
+ include all the policies that are shipped with Perl::Critic.
+
+ The format of the configuration file is a series of named sections 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. The general recipe is a series of blocks like this:
+
+ [Perl::Critic::Policy::Category::PolicyName]
+ priority = 1
+ 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. All Policy
+ modules must be a subclass of Perl::Critic::Policy.
+
+ "priority" is the level of importance you wish to assign to this policy.
+ 1 is the "highest" priority level, and all numbers greater than 1 have
+ increasingly "lower" priority. Only those policies with a priority less
+ than or equal to the "-priority" value given to the constructor will be
+ loaded. The priority can be an arbitrarily large positive integer. If
+ the priority is not defined, it defaults to 1.
+
+ The remaining key-value pairs are configuration parameters for that
+ specific Policy and will be passed into the constructor of the
+ Perl::Critic::Policy subclass. The constructors for most Policy modules
+ do not support arguments, and those that do should have reasonable
+ defaults. See the documentation on the appropriate Policy module for
+ more details.
+
+ By default, all the policies that are distributed with Perl::Critic are
+ added to the Config. Rather than assign a priority level to a Policy,
+ you can simply "turn off" a Policy by prepending a '-' to the name of
+ the module in the config file. In this manner, the Policy will never be
+ loaded, regardless of the "-priority" given to the constructor.
+
+ A simple configuration might look like this:
+
+ #--------------------------------------------------------------
+ # These are really important, so always load them
+
+ [TestingAndDebugging::RequirePackageStricture]
+ priority = 1
+
+ [TestingAndDebugging::RequirePackageWarnings]
+ priority = 1
+
+ #--------------------------------------------------------------
+ # These are less important, so only load when asked
+
+ [Variables::ProhibitPackageVars]
+ priority = 2
+
+ [ControlStructures::ProhibitPostfixControls]
+ priority = 2
+
+ #--------------------------------------------------------------
+ # I do not agree with these, so never load them
+
+ [-NamingConventions::ProhibitMixedCaseVars]
+ [-NamingConventions::ProhibitMixedCaseSubs]
+
+THE POLICIES
+ The following Policy modules are distributed with Perl::Critic. The
+ Policy modules have been categorized according to the table of contents
+ in Damian Conway's book 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 "RequireSomething" or
+ "ProhibitSomething". See the documentation of each module for it's
+ specific details.
+
+ Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr
+ Use 4-argument "substr" instead of writing "substr($foo, 2, 6) = $bar"
+
+ Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect
+ Use Time::HiRes instead of "select(undef, undef, undef, .05)"
+
+ Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval
+ Write "eval { my $foo; bar($foo) }" instead of "eval "my $foo;
+ bar($foo);""
+
+ Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep
+ Write "grep { $_ =~ /$pattern/ } @list" instead of "grep /$pattern/,
+ @list"
+
+ Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap
+ Write "map { $_ =~ /$pattern/ } @list" instead of "map /$pattern/,
+ @list"
+
+ Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction
+ Use "glob q{*}" instead of <*>
+
+ Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless
+ Write "bless {}, $class;" instead of just "bless {};"
+
+ Perl::Critic::Policy::CodeLayout::ProhibitHardTabs
+ Use spaces instead of tabs
+
+ Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins
+ Write "open $handle, $path" instead of "open($handle, $path)"
+
+ Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists
+ Write " qw(foo bar baz) " instead of " ('foo', 'bar', 'baz') "
+
+ Perl::Critic::Policy::CodeLayout::RequireTidyCode
+ Must run code through perltidy
+
+ Perl::Critic::Policy::CodeLayout::RequireTrailingCommas
+ Put a comma at the end of every multi-line list declaration, including
+ the last one
+
+ Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse
+ Don't write long "if-elsif-elsif-elsif-elsif...else" chains
+
+ Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops
+ Write "for(0..20)" instead of "for($i=0; $i<=20; $i++)"
+
+ Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls
+ Write "if($condition){ do_something() }" instead of "do_something() if
+ $condition"
+
+ Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks
+ Write "if(! $condition)" instead of "unless($condition)"
+
+ Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks
+ Write "while(! $condition)" instead of "until($condition)"
+
+ Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators
+ Discourage stuff like "@files = `ls $directory`"
+
+ Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles
+ Write "open my $fh, q{<}, $filename;" instead of "open FH, q{<},
+ $filename;"
+
+ Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect
+ Never write "select($fh)"
+
+ Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen
+ Write "open $fh, q{<}, $filename;" instead of "open $fh, "<$filename";"
+
+ Perl::Critic::Policy::Miscellanea::RequireRcsKeywords
+ Put source-control keywords in every file.
+
+ Perl::Critic::Policy::Modules::ProhibitMultiplePackages
+ Put packages (especially subclasses) in separate files
+
+ Perl::Critic::Policy::Modules::RequireBarewordIncludes
+ Write "require Module" instead of "require 'Module.pm'"
+
+ Perl::Critic::Policy::Modules::ProhibitSpecificModules
+ Don't use evil modules
+
+ Perl::Critic::Policy::Modules::RequireExplicitPackage
+ Always make the "package" explicit
+
+ Perl::Critic::Policy::Modules::RequireVersionVar
+ Give every module a $VERSION number
+
+ Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching
+ Always use the "/m" modifier with regular expressions
+
+ Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting
+ Always use the "/x" modifier with regular expressions
+
+ Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs
+ Write "sub my_function{}" instead of "sub MyFunction{}"
+
+ Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars
+ Write "$my_variable = 42" instead of "$MyVariable = 42"
+
+ Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms
+ Don't declare your own "open" function.
+
+ Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef
+ Return failure with bare "return" instead of "return undef"
+
+ Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes
+ Don't write "sub my_function (@@) {}"
+
+ Perl::Critic::Policy::TestingAndDebugging::RequirePackageStricture
+ Always "use strict"
+
+ Perl::Critic::Policy::TestingAndDebugging::RequirePackageWarnings
+ Always "use warnings"
+
+ Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma
+ Don't " use constant $FOO =" 15 >
+
+ Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes
+ Write "q{}" instead of ''
+
+ Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals
+ Always use single quotes for literal strings.
+
+ Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros
+ Write "oct(755)" instead of 0755
+
+ Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes
+ Use "q{}" or "qq{}" instead of quotes for awkward-looking strings
+
+ Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars
+ Warns that you might have used single quotes when you really wanted
+ double-quotes.
+
+ Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators
+ Write " 141_234_397.0145 " instead of 141234397.0145
+
+ Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator
+ Write " print <<'THE_END' " or " print <<"THE_END" "
+
+ Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator
+ Write " <<'THE_END'; " instead of " <<'theEnd'; "
+
+ Perl::Critic::Policy::Variables::ProhibitLocalVars
+ Use "my" instead of "local", except when you have to.
+
+ Perl::Critic::Policy::Variables::ProhibitPackageVars
+ Eliminate globals declared with "our" or "use vars"
+
+ Perl::Critic::Policy::Variables::ProhibitPunctuationVars
+ Write $EVAL_ERROR instead of $@
+
+BENDING THE RULES
+ NOTE: This feature changed in version 0.09 and is not backward
+ compatible with earlier versions.
+
+ 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 (or 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 pseudo-pragmas:
+
+ 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" comments direct Perl::Critic to overlook the
+ remaining lines of code until the end of the current block, or until a
+ "## use critic" comment is found (whichever comes first). If the "## no
+ critic" comment 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" comments, use the "-force" option.
+
+ Use this feature wisely. "## no critic" should be used in the smallest
+ possible scope, or only on individual lines of code. If Perl::Critic
+ complains about your code, try and find a compliant solution before
+ resorting to this feature.
+
+EXTENDING THE CRITIC
+ The modular design of Perl::Critic is intended to facilitate the
+ addition of new Policies. To create a new Policy, make a subclass of
+ Perl::Critic::Policy and override the "violates()" method. Your module
+ should go somewhere in the Perl::Critic::Policy namespace. To use the
+ new Policy, just add it to your .perlcriticrc file. You'll need to have
+ some understanding of PPI, but most Policy modules are pretty
+ straightforward and only require about 20 lines of code.
+
+ If you develop any new Policy modules, feel free to send them to
+ <thaljef@cpan.org> and I'll be happy to put them into the Perl::Critic
+ distribution.
+
+IMPORTANT CHANGES
+ As new Policy modules were added to Perl::Critic, the overall
+ performance started to deteriorate rapidly. Since each module would
+ traverse the document (several times for some modules), a lot of time
+ was spent iterating over the same document nodes. So starting in version
+ 0.11, I have switched to a stream-based approach where the document is
+ traversed once and every Policy module is tested at each node. The
+ result is roughly 300% a improvement. Unfortunately, Policy modules
+ prior to version 0.11 won't be compatible. Hopefully, few people have
+ started creating their own Policy modules. Converting them to the
+ stream-based model is fairly easy, and actually results in somewhat
+ cleaner code. Look at the ControlStrucutres::* modules for some
+ examples.
+
+PREREQUISITES
+ Perl::Critic requires the following modules:
+
+ PPI
+
+ Config::Tiny
+
+ File::Spec
+
+ List::Util
+
+ List::MoreUtils
+
+ Pod::Usage
+
+ Pod::PlainText
+
+ IO::String
+
+ String::Format
+
+ The following modules are optional, but recommended for complete
+ testing:
+
+ Test::Pod
+
+ Test::Pod::Coverage
+
+ Test::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 to
+ <http://rt.cpan.org/NoAuth/Bugs.html?Dist=Perl-Critic>. Thanks.
+
+CREDITS
+ Adam Kennedy - For creating PPI, the heart and soul of Perl::Critic.
+
+ Damian Conway - For writing Perl Best Practices
+
+ Giuseppe Maxia - For all the great ideas and enhancements.
+
+ Chris Dolan - For numerous bug reports and suggestions.
+
+ Sharon, my wife - For putting up with my all-night code sessions
+
+AUTHOR
+ Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+COPYRIGHT
+ Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
+
--- /dev/null
+######################################################################
+# Perl::Critic #
+# Version 0.13 #
+# by Jeffrey R. Thalhammer #
+# <thaljef@cpan.org> #
+######################################################################
+
+POLICIES TO ADD:
+
+- Require labels for loops.
+- Require labels for loop breaks.
+- Require global variables to be localized
+- Prohibit 'no strict' (maybe)
+- Prohibit 'no warnings' (maybe)
+- Require fat commas for hashes
+
+NEW FEATURES:
+
+- Report safari sections instead of book page numbers.
+
+MISC:
+
+- Need test cases for perlcritc command-line interface.
+
--- /dev/null
+#!/usr/bin/perl
+
+package main;
+
+use strict;
+use warnings;
+use Pod::Usage;
+use Getopt::Long;
+use English qw(-no_match_vars);
+use Perl::Critic::Utils;
+use Perl::Critic;
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+#---------------------------------------------------------------
+# Begin script
+
+my %opts = get_options();
+my @input = get_input( @ARGV );
+my %config = map { ("-$_" => $opts{$_}) } keys %opts;
+my $violations = critique( \%config, @input );
+my $status = $violations ? 2 : 0;
+exit $status;
+
+#----------------------------------------------------------------
+# Begin subroutines
+
+sub get_options {
+
+ my %opts = ();
+ my @opt_specs = qw(priority=s profile=s noprofile verbose=s
+ force help|? man Version safari
+ include=s@ exclude=s@);
+
+ Getopt::Long::Configure('no_ignore_case');
+ GetOptions( \%opts, @opt_specs ) || pod2usage(); #Exits
+
+ if ( $opts{help} ) { pod2usage( -verbose => 0 ) } #Exits
+ if ( $opts{man} ) { pod2usage( -verbose => 2 ) } #Exits
+ if ( $opts{Version} ) { print "$VERSION\n"; exit 0; } #Exits
+
+ #Sanity checks
+ if ( $opts{noprofile} && $opts{profile} ) {
+ my $msg = 'Cannot use -noprofile with -profile';
+ pod2usage( -exitstatus => 1, -message => $msg ); #Exits
+ }
+
+ #Warn users who might forget that -verbose requires a value
+ if ( $opts{verbose} && $opts{verbose} !~ m{ (?: \d+ | %[fmlcdp] ) }mx ) {
+ my $msg = qq{Warning: -verbose value '$opts{verbose}' looks odd.\n};
+ warn $msg;
+ }
+
+ #Override profile, if -noprofile
+ if ( $opts{noprofile} ) { $opts{profile} = $EMPTY }
+
+ #All good!
+ return %opts;
+}
+
+sub get_input {
+
+ if ( @_ ) {
+
+ #Reading code from a file...
+ for (@_ ) { -f $_ || die qq{'$_' is not a file} }
+ return @_;
+ }
+ else {
+
+ #Reading code from STDIN
+ my $code_string = do { local $RS; <STDIN> }; #Slurping
+ $code_string =~ m{ \S+ }mx || die 'Nothing to critique';
+ return \$code_string; #Convert to SCALAR ref for PPI
+ }
+}
+
+sub critique {
+ my $config = shift;
+ my $count = 0;
+
+ #Construct Critic
+ my $critic = Perl::Critic->new( %{$config} );
+
+ for my $file (@_) {
+ my @violations = $critic->critique($file);
+ $count += scalar @violations;
+
+ #HACK! This is so I can recycle the same $critic
+ for ( @{ $critic->policies() } ) { $_->{_tested} = 0 }
+ print_report($file, $config->{-verbose}, @violations);
+ }
+ return $count;
+}
+
+
+sub print_report {
+ my ($file, $verbosity, @violations) = @_;
+ $file = -f $file ? $file : 'stdin';
+ $verbosity ||= @ARGV > 1 ? 3 : 2;
+
+ my %FORMAT_OF = (
+ 1 => "%f:%l:%c:%m\n",
+ 2 => "%m at line %l, column %c. %e.\n",
+ 3 => "%f: %m at line %l, column %c. %e.\n",
+ 4 => "[%p] %m at line %l, column %c. %e.\n",
+ 5 => "[%p] %m at line %l, column %c. %e.\n%d\n",
+ );
+
+ my $fmt = $verbosity =~ m{ \A [+-]? \d+ \z }mx ?
+ ($FORMAT_OF{abs $verbosity} || $FORMAT_OF{2}) : _interpolate($verbosity);
+ $fmt =~ s{\%f}{$file}mxg; #HACK! Vilation objects don't know the file
+
+ no warnings 'once'; #Ugh. It's tough to be a perfectionist.
+ local $Perl::Critic::Violation::FORMAT = $fmt; ## no critic
+ print @violations;
+ return 1;
+}
+
+sub _interpolate {
+ my $literal = shift;
+ my $interpolated = undef;
+ eval "\$interpolated = \"$literal\""; ## no critic
+ return $interpolated;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+perlcritic - Command-line interface to critique Perl source
+
+=head1 SYNOPSIS
+
+ perlcritic [options] FILE1 [ FILE2 FILE3... ] #Read from FILE(s)
+ perlcritic [options] #Read from STDIN
+ perlciritc -man #To see the manual
+
+=head1 DESCRIPTION
+
+C<perlcritic> is a Perl source code analyzer. It is the executable
+front-end to the L<Perl::Critic> engine, which attempts to identify
+awkward, hard to read, error-prone, or unconventional constructs in
+your code. Most of the rules are based on Damian Conway's book B<Perl
+Best Practices>. I highly recommend that you get a copy!
+
+If you want to integrate perlcritic with your build process, the
+L<Test::Perl::Critic> module provides a nice interface that is
+suitable for test scripts.
+
+=head1 ARGUMENTS
+
+The arguments are paths to the files you wish to analyze. You may
+specify multiple files. If no file is specified, then the input is
+read from STDIN.
+
+=head1 OPTIONS
+
+Option names can be abbreviated to uniqueness and can be stated with
+singe or double dashes, and option values can be separated from the
+option name by a space or '=' (a la L<Getopt::Long>). Option names
+are case-sensitive.
+
+=over 8
+
+=item -profile FILE
+
+Directs perlcritic to use a profile named by FILE rather than looking
+for the default F<.perlcriticrc> file in the current directory or your
+home directory. See L<"CONFIGURATION"> for more information.
+
+=item -noprofile
+
+Directs perlcritic not to load any configuration file, thus defaulting
+to load all the Policy modules that are distributed with
+L<Perl::Critic>.
+
+=item -priority N
+
+Sets the the maximum priority value of Policies that should be loaded
+from the C<-profile>. 1 is the "highest" priority, and all numbers
+larger than 1 have "lower" priority. Only Policies that have been
+configured with a priority value less than or equal to N will be
+loaded. For a given C<-profile>, increasing N will result in more
+violations. The default priority is 1. See L<"CONFIGURATION"> for
+more information.
+
+=item -include PATTERN
+
+Directs perlcritic to load only Policy modules from your C<-profile>
+that match the regex C</PATTERN/imx>. The idea here is to provide a
+compact interface for selecting Policies at the command-line. You can
+specify multiple C<-include> options and you can use it in conjunction
+with the C<-exclude> option. Note that C<-exclude> takes precedence
+over C<-include> when a Policy matches both patterns. Using
+C<-exclude> or C<-include> causes the C<-priority> settings to be
+silently ignored.
+
+=item -exclude PATTERN
+
+Directs perlcritic to load Policy modules from your C<-profile> that
+do not match the regex C</PATTERN/imx>. The idea here is to provide a
+compact interface for selecting Policies at the command-line. You can
+specify multiple C<-exclude> options and you can use it in conjunction
+with the C<-include> option. Note that C<-exclude> takes precedence
+over C<-include> when a Policy matches both patterns. Using
+C<-exclude> or C<-include> causes the C<-priority> settings to be
+silently ignored.
+
+=item -force
+
+Directs perlcritic not to observe the magical C<## no critic>
+pseudo-pragmas in the source code. See L<"BENDING THE RULES"> for more
+information.
+
+=item -verbose N | FORMAT
+
+Sets the verbosity level or format for reporting violations. If given
+a number (N), perlcritic reports violations using one of the
+predefined formats described below. If given a string (FORMAT), it is
+interpreted to be an actual format specification. If the C<-verbose>
+option is not specified, it defaults to either 2 or 3, depending on
+whether multiple files were given as arguments to perlcritic.
+
+ Verbosity Format Specification
+ ----------- -------------------------------------------------
+ 1 "%f:%l:%c:%m.\n"
+ 2 "%m at line %l, column %c. %e.\n"
+ 3 "%f: %m at line %l, column %c. %e.\n"
+ 4 "[%p] %m at line %1, column %c. %e.\n"
+ 5 "[%p] %m at line %1, column %c. %e.\n %d\n"
+
+Formats are a combination of literal and escape characters similar to
+the way C<sprintf> works. See L<String::Format> for a full
+explanation of the formatting capabilities. Valid escape characters
+are:
+
+ Escape Meaning
+ ------- -----------------------------------------------------
+ %m Brief description of the violation
+ %f Name of the file where the violation occurred.
+ %l Line number where the violation occurred
+ %c Column number where the violation occurred
+ %e Explanation of violation or page numbers in PBP
+ %d Full diagnostic discussion of the violation
+ %p Name of the Policy module that created the violation
+
+The purpose of these formats is to provide some compatibility with
+editors that have an interface for parsing certain kinds of input. See
+L<"EDITOR INTEGRATION"> for more information about that.
+
+=item -safari
+
+Report "Perl Best Practice" citations as section numbers from
+L<http://safari.oreilly.com> instead of page numbers from the actual
+book. NOTE: This feature is not implemented yet.
+
+=item -help
+
+=item -?
+
+Displays a brief summary of options and exits.
+
+=item -man
+
+Displays the complete perlcritic manual and exits.
+
+=item -Version
+
+=item -V
+
+Displays the version number of perlcritic and exits.
+
+=back
+
+=head1 CONFIGURATION
+
+The default configuration file is called F<.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
+configuration file in another location. If none of these files exist,
+And the C<-profile> option is not given at the command-line,
+perlcritic defaults to loading all the Policies that are distributed
+with L<Perl::Critic>.
+
+The format of the configuration file is a series of named sections
+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. The general recipe is a series of
+blocks like this:
+
+ [Perl::Critic::Policy::Category::PolicyName]
+ priority = 1
+ arg1 = value1
+ arg2 = value2
+
+C<Perl::Critic::Policy::Category::PolicyName> is the full name of a
+module that implements the policy you want to load into the engine.
+The Policy modules distributed with Perl::Critic have been grouped
+into categories according to the table of contents in Damian Conway's
+book B<Perl Best Practices>. For brevity, you can omit the
+C<'Perl::Critic::Policy'> part of the module name. The module must be
+a subclass of L<Perl::Critic::Policy>.
+
+C<priority> is the level of importance you wish to assign to this
+policy. 1 is the "highest" priority level, and all numbers greater
+than 1 have increasingly "lower" priority. Only those policies with a
+priority less than or equal to the C<-priority> value given on the
+command-line will be loaded. The priority can be an arbitrarily large
+positive integer. If the priority is not defined, it defaults to 1.
+
+The remaining key-value pairs are configuration parameters for that
+specific Policy and will be passed into the constructor of the
+L<Perl::Critic::Policy> subclass. The constructors for most Policy
+modules do not support arguments, and those that do should have
+reasonable defaults. See the documentation in the relevant Policy
+module for more details.
+
+By default, all the policies that are distributed with C<Perl::Critic>
+are loaded. Rather than assign a priority level to a Policy, you can
+simply "turn off" a Policy by prepending a '-' to the name of the
+module in the config file. In this manner, the Policy will never be
+loaded, regardless of the C<-priority> option given at the
+command-line.
+
+
+A sample configuration might look like this:
+
+ #--------------------------------------------------------------
+ # These are really important, so always load them
+
+ [TestingAndDebugging::RequirePackageStricture]
+ priority = 1
+
+ [TestingAndDebugging::RequirePackageWarnings]
+ priority = 1
+
+ #--------------------------------------------------------------
+ # These are less important, so only load when asked
+
+ [Variables::ProhibitPackageVars]
+ priority = 2
+
+ [ControlStructures::ProhibitPostfixControls]
+ priority = 2
+
+ #--------------------------------------------------------------
+ # I don't agree with these, so never load them
+
+ [-NamingConventions::ProhibitMixedCaseVars]
+ [-NamingConventions::ProhibitMixedCaseSubs]
+
+=head1 THE POLICIES
+
+The following Policy modules are distributed with Perl::Critic. 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>. See the documentation of each module for
+it's specific details.
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr>
+
+Use 4-argument C<substr> instead of writing C<substr($foo, 2, 6) = $bar>
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect>
+
+Use L<Time::HiRes> instead of something like C<select(undef, undef, undef, .05)>
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval>
+
+Write C<eval { my $foo; bar($foo) }> instead of C<eval "my $foo; bar($foo);">
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep>
+
+Write C<grep { $_ =~ /$pattern/ } @list> instead of C<grep /$pattern/, @list>
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap>
+
+Write C<map { $_ =~ /$pattern/ } @list> instead of C<map /$pattern/, @list>
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction>
+
+Use C<glob q{*}> instead of <*>
+
+=head2 L<Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless>
+
+Write C<bless {}, $class;> instead of just C<bless {};>
+
+=head2 L<Perl::Critic::Policy::CodeLayout::ProhibitHardTabs>
+
+Use spaces instead of tabs
+
+=head2 L<Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins>
+
+Write C<open $handle, $path> instead of C<open($handle, $path)>
+
+=head2 L<Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists>
+
+Write C< qw(foo bar baz) > instead of C< ('foo', 'bar', 'baz') >
+
+=head2 L<Perl::Critic::Policy::CodeLayout::RequireTidyCode>
+
+Must run code through L<perltidy>
+
+=head2 L<Perl::Critic::Policy::CodeLayout::RequireTrailingCommas>
+
+Put a comma at the end of every multi-line list declaration, including the last one
+
+=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse>
+
+Don't write long "if-elsif-elsif-elsif-elsif...else" chains
+
+=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops>
+
+Write C<for(0..20)> instead of C<for($i=0; $i<=20; $i++)>
+
+=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls>
+
+Write C<if($condition){ do_something() }> instead of C<do_something() if $condition>
+
+=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks>
+
+Write C<if(! $condition)> instead of C<unless($condition)>
+
+=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks>
+
+Write C<while(! $condition)> instead of C<until($condition)>
+
+=head2 L<Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators>
+
+Discourage stuff like C<@files = `ls $directory`>
+
+=head2 L<Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles>
+
+Write C<open my $fh, q{<}, $filename;> instead of C<open FH, q{<}, $filename;>
+
+=head2 L<Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect>
+
+Never write C<select($fh)>
+
+=head2 L<Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen>
+
+Write C<open $fh, q{<}, $filename;> instead of C<open $fh, "<$filename";>
+
+=head2 L<Perl::Critic::Policy::Miscellanea::RequireRcsKeywords>
+
+Put source-control keywords in every file.
+
+=head2 L<Perl::Critic::Policy::Modules::ProhibitMultiplePackages>
+
+Put packages (especially subclasses) in separate files
+
+=head2 L<Perl::Critic::Policy::Modules::RequireBarewordIncludes>
+
+Write C<require Module> instead of C<require 'Module.pm'>
+
+=head2 L<Perl::Critic::Policy::Modules::ProhibitSpecificModules>
+
+Don't use evil modules
+
+=head2 L<Perl::Critic::Policy::Modules::RequireExplicitPackage>
+
+Always make the C<package> explicit
+
+=head2 L<Perl::Critic::Policy::Modules::RequireVersionVar>
+
+Give every module a C<$VERSION> number
+
+=head2 L<Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching>
+
+Always use the C</m> modifier with regular expressions
+
+=head2 L<Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting>
+
+Always use the C</x> modifier with regular expressions
+
+=head2 L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs>
+
+Write C<sub my_function{}> instead of C<sub MyFunction{}>
+
+=head2 L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars>
+
+Write C<$my_variable = 42> instead of C<$MyVariable = 42>
+
+=head2 L<Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms>
+
+Don't declare your own C<open> function.
+
+=head2 L<Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef>
+
+Return failure with bare C<return> instead of C<return undef>
+
+=head2 L<Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes>
+
+Don't write C<sub my_function (@@) {}>
+
+=head2 L<Perl::Critic::Policy::TestingAndDebugging::RequirePackageStricture>
+
+Always C<use strict>
+
+=head2 L<Perl::Critic::Policy::TestingAndDebugging::RequirePackageWarnings>
+
+Always C<use warnings>
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma>
+
+Don't C< use constant $FOO => 15 >
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes>
+
+Write C<q{}> instead of C<''>
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals>
+
+Always use single quotes for literal strings.
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros>
+
+Write C<oct(755)> instead of C<0755>
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes>
+
+Use C<q{}> or C<qq{}> instead of quotes for awkward-looking strings
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars>
+
+Warns that you might have used single quotes when you really wanted double-quotes.
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators>
+
+Write C< 141_234_397.0145 > instead of C< 141234397.0145 >
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator>
+
+Write C< print <<'THE_END' > or C< print <<"THE_END" >
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator>
+
+Write C< <<'THE_END'; > instead of C< <<'theEnd'; >
+
+=head2 L<Perl::Critic::Policy::Variables::ProhibitLocalVars>
+
+Use C<my> instead of C<local>, except when you have to.
+
+=head2 L<Perl::Critic::Policy::Variables::ProhibitPackageVars>
+
+Eliminate globals declared with C<our> or C<use vars>
+
+=head2 L<Perl::Critic::Policy::Variables::ProhibitPunctuationVars>
+
+Write C<$EVAL_ERROR> instead of C<$@>
+
+=head1 BENDING THE RULES
+
+B<NOTE:> This feature changed in version 0.09 and is not backward
+compatible with earlier versions.
+
+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
+(or 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 pseudo-pragmas:
+
+ 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 C<"## no critic"> comments direct Perl::Critic to overlook the
+remaining lines of code until the end of the current block, or until a
+C<"## use critic"> comment is found (whichever comes first). If the
+C<"## no critic"> comment is on the same line as a code statement,
+then only that line of code is overlooked. To direct perlcritic to
+ignore the C<"## no critic"> comments, use the C<-force> option.
+
+Use this feature wisely. C<"## no critic"> should be used in the
+smallest possible scope, or only on individual lines of code. If
+Perl::Critic complains about your code, try and find a compliant
+solution before resorting to this feature.
+
+=head1 EDITOR INTEGRATION
+
+For ease-of-use, perlcritic can be integrated with your favorite text
+editor. The output-formatting capabilities of perlcritic are
+specifically intended for use with the "grep" or "compile" modes
+available in editors like C<emacs> and C<vim>. In these modes, you can
+run an arbitrary command and the editor will parse the output into an
+interactive buffer that you can click on and jump to the relevant line
+of code.
+
+=head2 EMACS
+
+Entering C<'Meta-x compile'> causes emacs to switch to compile-mode.
+Next, enter the following command in the minibuffer:
+
+ perlcritic -verbose 1 path/to/your/file
+
+When the results are displayed, pressing [Enter] on any of the
+Violation messages will move the pointer to the relevant location
+within the file. Type C<'Ctrl-h a compile'> for information about
+compile-mode.
+
+=head2 VIM
+
+Configure the grep format as follows:
+
+ set grepformat=%f:%l:%c:m
+ set grepprg=perlcritic\ -verbose\ 1\ %
+
+Then, you can run perlcritic on the current buffer with:
+
+ :grep
+
+Navigation and display instructions can be found under C<:help grep>.
+Someone with stronger Vim-fu may wish to convert this to a real macro.
+
+=head1 EXIT STATUS
+
+If perlcritic has any errors itself, exits with status == 1. If there
+are no errors, but perlcritic finds Policy violations in your source
+code, exits with status == 2. If there were no errors and no
+violations were found, exits with status == 0.
+
+=head1 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 to
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Perl-Critic>. Thanks.
+
+=head1 CREDITS
+
+Adam Kennedy - For creating L<PPI>, the heart and soul of Perl::Critic.
+
+Damian Conway - For writing B<Perl Best Practices>.
+
+Giuseppe Maxia - For all the great ideas and enhancements.
+
+Chris Dolan - For numerous bug reports and suggestions.
+
+Sharon, my wife - For putting up with my all-night code sessions.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic;
+
+use strict;
+use warnings;
+use File::Spec;
+use English qw(-no_match_vars);
+use Perl::Critic::Config;
+use Perl::Critic::Utils;
+use Carp;
+use PPI;
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+#----------------------------------------------------------------------------
+#
+sub new {
+
+ my ( $class, %args ) = @_;
+
+ # Default arguments
+ my $priority = defined $args{-priority} ? $args{-priority} : 0;
+ my $profile_path = $args{-profile};
+ my $force = $args{-force} || 0;
+
+ # Create and init object
+ my $self = bless {}, $class;
+ $self->{_force} = $force;
+ $self->{_policies} = [];
+
+ # Read profile and add policies
+ my $config = Perl::Critic::Config->new( %args );
+ while ( my ( $policy, $params ) = each %{$config} ) {
+ $self->add_policy( -policy => $policy, -config => $params );
+ }
+ return $self;
+}
+
+#----------------------------------------------------------------------------
+#
+sub add_policy {
+
+ my ( $self, %args ) = @_;
+ my $module_name = $args{-policy} || return;
+ my $config = $args{-config} || {};
+
+ #Qualify name if full module name not given
+ my $namespace = 'Perl::Critic::Policy';
+ if ( $module_name !~ m{ \A $namespace }mx ) {
+ $module_name = $namespace . q{::} . $module_name;
+ }
+
+ #Convert module name to file path. I'm trying to do
+ #this in a portable way, but I'm not sure it actually is.
+ my $module_file = File::Spec->catfile( split q{::}, $module_name );
+ $module_file .= '.pm';
+
+ #Try to load module and instantiate
+ eval {
+ require $module_file; ## no critic
+ my $policy = $module_name->new( %{$config} );
+ push @{ $self->{_policies} }, $policy;
+ };
+
+ #Failure to load is not fatal
+ if ($EVAL_ERROR) {
+ carp qq{Cannot load policy module $module_name: $EVAL_ERROR};
+ return;
+ }
+
+ return $self;
+}
+
+#----------------------------------------------------------------------------
+#
+sub critique {
+ # Here we go!
+ my ( $self, $source_code ) = @_;
+
+ # Parse the code
+ my $doc = PPI::Document->new($source_code);
+
+ # Bail on error
+ if( ! defined $doc ) {
+ my $errstr = PPI::Document::errstr();
+ my $file = -f $source_code ? $source_code : 'stdin';
+ die qq{Cannot parse code: $errstr of '$file'\n};
+ }
+
+ # Pre-index location of each node (for speed)
+ $doc->index_locations();
+
+ # Filter exempt code, if desired
+ $self->{_force} || _filter_code($doc);
+
+ # Remove the magic shebang fix
+ _unfix_shebang($doc);
+
+ # Run engine, testing each Policy at each element
+ my $elems = $doc->find( 'PPI::Element' ) || return; #Nothing to do!
+ my @pols = @{ $self->policies() }; @pols || return; #Nothing to do!
+ return map { my $e = $_; map { $_->violates($e, $doc) } @pols } @{$elems};
+}
+
+#----------------------------------------------------------------------------
+#
+sub policies { $_[0]->{_policies} }
+
+#============================================================================
+#PRIVATE SUBS
+
+sub _filter_code {
+
+ my $doc = shift;
+ my $nodes_ref = $doc->find('PPI::Token::Comment') || return;
+ my $no_critic = qr{\A \s* \#\# \s* no \s+ critic}mx;
+ my $use_critic = qr{\A \s* \#\# \s* use \s+ critic}mx;
+
+ PRAGMA:
+ for my $pragma ( grep { $_ =~ $no_critic } @{$nodes_ref} ) {
+
+ #Handle single-line usage
+ if ( my $sib = $pragma->sprevious_sibling() ) {
+ if ( $sib->location->[0] == $pragma->location->[0] ) {
+ $sib->statement->delete();
+ next PRAGMA;
+ }
+ }
+
+ SIB:
+ while ( my $sib = $pragma->next_sibling() ) {
+ my $ended = $sib->isa('PPI::Token::Comment') && $sib =~ $use_critic;
+ $sib->delete(); #$sib is undef now.
+ last SIB if $ended;
+ }
+ }
+ continue {
+ $pragma->delete();
+ }
+}
+
+sub _unfix_shebang {
+
+
+ #When you install a script 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 script using a shell, like `sh my_script`. Unfortunately,
+ #this code causes several Policy violations, so we just remove it.
+
+ my $doc = shift;
+ my $first_stmnt = $doc->schild(0) || return;
+
+
+ #Different versions of MakeMaker and Build use slightly differnt
+ #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.+;};
+ if ( $first_stmnt =~ $fixin_rx ) { $first_stmnt->delete() }
+}
+
+1;
+
+#----------------------------------------------------------------------------
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic - Critique Perl source for style and standards
+
+=head1 SYNOPSIS
+
+ use Perl::Critic;
+
+ #Create Critic and load Policies from default config file
+ $critic = Perl::Critic->new();
+
+ #Create Critic and load only the most important Polices
+ $critic = Perl::Critic->new(-priority => 1);
+
+ #Create Critic and load Policies from specific config file
+ $critic = Perl::Critic->new(-profile => $file);
+
+ #Create Critic and load Policy by hand
+ $critic = Perl::Critic->new(-profile => 'NONE');
+ $critic->add_policy('MyPolicyModule');
+
+ #Analyze code for policy violations
+ @violations = $critic->critique($source_code);
+
+=head1 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 L<Perl::Critic::Policy> modules that attempt to enforce
+various coding guidelines. Most Policies are based on Damian Conway's
+book B<Perl Best Practices>. You can choose and customize those
+Polices through the Perl::Critic interface. You can also create new
+Policy modules that suit your own tastes.
+
+For a convenient command-line interface to Perl::Critic, see the
+documentation for L<perlcritic>. If you want to integrate
+Perl::Critic with your build process, L<Test::Perl::Critic> provides a
+nice interface that is suitable for test scripts.
+
+=head1 CONSTRUCTOR
+
+=over 8
+
+=item new ( [ -profile => $FILE, -priority => $N, -include => \@PATTERNS, -exclude => \@PATTERNS, -force => 1 ] )
+
+Returns a reference to a new Perl::Critic object. Most arguments are
+just passed directly into L<Perl::Critic::Config>, but I have described
+them here as well. All arguments are optional key-value pairs as
+follows:
+
+B<-profile> is a path to a configuration file. If C<$FILE> is not
+defined, Perl::Critic::Config attempts to find a F<.perlcriticrc>
+configuration file in the current directory, and then in your home
+directory. Alternatively, you can set the C<PERLCRITIC> environment
+variable to point to a file in another location. If a configuration
+file can't be found, or if C<$FILE> is an empty string, then it
+defaults to include all the Policy modules that ship with
+Perl::Critic. See L<"CONFIGURATION"> for more information.
+
+B<-priority> is the maximum priority value of Policies that should be
+added to the Perl::Critic::Config. 1 is the "highest" priority,
+and all numbers larger than 1 have "lower" priority. Once the
+user-preferences have been read from the C<-profile>, All Policies
+that are configured with a priority greater than C<$N> will be removed
+from this Config. For a given C<-profile>, increasing C<$N> will
+result in more Policy violations. The default C<-priority> is 1. See
+L<"CONFIGURATION"> for more information.
+
+B<-include> is a reference to a list of C<@PATTERNS>. Once the
+user-preferences have been read from the C<-profile>, all Policies
+that do not match at least one C<m/$PATTERN/imx> will be removed
+from this Config. Using the C<-include> option causes the <-priority>
+option to be ignored.
+
+B<-exclude> is a reference to a list of C<@PATTERNS>. Once the
+user-preferences have been read from the C<-profile>, all Policies
+that match at least one C<m/$PATTERN/imx> will be removed from
+the Config. Using the C<-exclude> option causes the <-priority>
+option to be ignored. The C<-exclude> patterns are applied after the
+<-include> patterns, therefore, the C<-exclude> patterns take
+precedence.
+
+B<-force> controls whether Perl::Critic observes the magical C<"no
+critic"> pseudo-pragmas 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 overlook code that is tagged with these
+comments. See L<"BENDING THE RULES"> for more information.
+
+=back
+
+=head1 METHODS
+
+=over 8
+
+=item add_policy( -policy => $STRING [, -config => \%HASH ] )
+
+Loads a Policy into this Critic engine. The engine will attempt to
+C<require> the module named by $STRING and instantiate it. If the
+module fails to load or cannot be instantiated, it will throw a
+warning and return a false value. Otherwise, it returns a reference
+to this Critic engine.
+
+B<-policy> is the name of a L<Perl::Critic::Policy> subclass
+module. The C<'Perl::Critic::Policy'> portion of the name can be
+omitted for brevity. This argument is required.
+
+B<-config> is an optional reference to a hash of Policy configuration
+parameters (Note that this is B<not> a Perl::Critic::Config object). 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.
+
+=item critique( $source_code )
+
+Runs the C<$source_code> through the Perl::Critic engine using all the
+policies that have been loaded into this engine. If C<$source_code>
+is a scalar reference, then it is treated as string of actual Perl
+code. Otherwise, it is treated as a path to a file containing Perl
+code. Returns a list of L<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,
+returns an empty list.
+
+=item policies( void )
+
+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.
+
+=back
+
+=head1 CONFIGURATION
+
+The default configuration file is called F<.perlcriticrc>.
+Perl::Critic::Config 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
+C<-profile> option is not given to the constructor,
+Perl::Critic::Config defaults to include all the policies that are
+shipped with Perl::Critic.
+
+The format of the configuration file is a series of named sections
+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. The general recipe is a series of
+blocks like this:
+
+ [Perl::Critic::Policy::Category::PolicyName]
+ priority = 1
+ arg1 = value1
+ arg2 = value2
+
+C<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 B<Perl Best Practices>. For
+brevity, you can omit the C<'Perl::Critic::Policy'> part of the
+module name. All Policy modules must be a subclass of
+L<Perl::Critic::Policy>.
+
+C<priority> is the level of importance you wish to assign to this
+policy. 1 is the "highest" priority level, and all numbers greater
+than 1 have increasingly "lower" priority. Only those policies with a
+priority less than or equal to the C<-priority> value given to the
+constructor will be loaded. The priority can be an arbitrarily large
+positive integer. If the priority is not defined, it defaults to 1.
+
+The remaining key-value pairs are configuration parameters for that
+specific Policy and will be passed into the constructor of the
+L<Perl::Critic::Policy> subclass. The constructors for most Policy
+modules do not support arguments, and those that do should have
+reasonable defaults. See the documentation on the appropriate Policy
+module for more details.
+
+By default, all the policies that are distributed with Perl::Critic
+are added to the Config. Rather than assign a priority level to a
+Policy, you can simply "turn off" a Policy by prepending a '-' to the
+name of the module in the config file. In this manner, the Policy
+will never be loaded, regardless of the C<-priority> given to the
+constructor.
+
+
+A simple configuration might look like this:
+
+ #--------------------------------------------------------------
+ # These are really important, so always load them
+
+ [TestingAndDebugging::RequirePackageStricture]
+ priority = 1
+
+ [TestingAndDebugging::RequirePackageWarnings]
+ priority = 1
+
+ #--------------------------------------------------------------
+ # These are less important, so only load when asked
+
+ [Variables::ProhibitPackageVars]
+ priority = 2
+
+ [ControlStructures::ProhibitPostfixControls]
+ priority = 2
+
+ #--------------------------------------------------------------
+ # I do not agree with these, so never load them
+
+ [-NamingConventions::ProhibitMixedCaseVars]
+ [-NamingConventions::ProhibitMixedCaseSubs]
+
+=head1 THE POLICIES
+
+The following Policy modules are distributed with Perl::Critic. 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>. See the documentation of each module for
+it's specific details.
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr>
+
+Use 4-argument C<substr> instead of writing C<substr($foo, 2, 6) = $bar>
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect>
+
+Use L<Time::HiRes> instead of C<select(undef, undef, undef, .05)>
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval>
+
+Write C<eval { my $foo; bar($foo) }> instead of C<eval "my $foo; bar($foo);">
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep>
+
+Write C<grep { $_ =~ /$pattern/ } @list> instead of C<grep /$pattern/, @list>
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap>
+
+Write C<map { $_ =~ /$pattern/ } @list> instead of C<map /$pattern/, @list>
+
+=head2 L<Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction>
+
+Use C<glob q{*}> instead of <*>
+
+=head2 L<Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless>
+
+Write C<bless {}, $class;> instead of just C<bless {};>
+
+=head2 L<Perl::Critic::Policy::CodeLayout::ProhibitHardTabs>
+
+Use spaces instead of tabs
+
+=head2 L<Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins>
+
+Write C<open $handle, $path> instead of C<open($handle, $path)>
+
+=head2 L<Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists>
+
+Write C< qw(foo bar baz) > instead of C< ('foo', 'bar', 'baz') >
+
+=head2 L<Perl::Critic::Policy::CodeLayout::RequireTidyCode>
+
+Must run code through L<perltidy>
+
+=head2 L<Perl::Critic::Policy::CodeLayout::RequireTrailingCommas>
+
+Put a comma at the end of every multi-line list declaration, including the last one
+
+=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse>
+
+Don't write long "if-elsif-elsif-elsif-elsif...else" chains
+
+=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops>
+
+Write C<for(0..20)> instead of C<for($i=0; $i<=20; $i++)>
+
+=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls>
+
+Write C<if($condition){ do_something() }> instead of C<do_something() if $condition>
+
+=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks>
+
+Write C<if(! $condition)> instead of C<unless($condition)>
+
+=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks>
+
+Write C<while(! $condition)> instead of C<until($condition)>
+
+=head2 L<Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators>
+
+Discourage stuff like C<@files = `ls $directory`>
+
+=head2 L<Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles>
+
+Write C<open my $fh, q{<}, $filename;> instead of C<open FH, q{<}, $filename;>
+
+=head2 L<Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect>
+
+Never write C<select($fh)>
+
+=head2 L<Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen>
+
+Write C<open $fh, q{<}, $filename;> instead of C<open $fh, "<$filename";>
+
+=head2 L<Perl::Critic::Policy::Miscellanea::RequireRcsKeywords>
+
+Put source-control keywords in every file.
+
+=head2 L<Perl::Critic::Policy::Modules::ProhibitMultiplePackages>
+
+Put packages (especially subclasses) in separate files
+
+=head2 L<Perl::Critic::Policy::Modules::RequireBarewordIncludes>
+
+Write C<require Module> instead of C<require 'Module.pm'>
+
+=head2 L<Perl::Critic::Policy::Modules::ProhibitSpecificModules>
+
+Don't use evil modules
+
+=head2 L<Perl::Critic::Policy::Modules::RequireExplicitPackage>
+
+Always make the C<package> explicit
+
+=head2 L<Perl::Critic::Policy::Modules::RequireVersionVar>
+
+Give every module a C<$VERSION> number
+
+=head2 L<Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching>
+
+Always use the C</m> modifier with regular expressions
+
+=head2 L<Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting>
+
+Always use the C</x> modifier with regular expressions
+
+=head2 L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs>
+
+Write C<sub my_function{}> instead of C<sub MyFunction{}>
+
+=head2 L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars>
+
+Write C<$my_variable = 42> instead of C<$MyVariable = 42>
+
+=head2 L<Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms>
+
+Don't declare your own C<open> function.
+
+=head2 L<Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef>
+
+Return failure with bare C<return> instead of C<return undef>
+
+=head2 L<Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes>
+
+Don't write C<sub my_function (@@) {}>
+
+=head2 L<Perl::Critic::Policy::TestingAndDebugging::RequirePackageStricture>
+
+Always C<use strict>
+
+=head2 L<Perl::Critic::Policy::TestingAndDebugging::RequirePackageWarnings>
+
+Always C<use warnings>
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma>
+
+Don't C< use constant $FOO => 15 >
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes>
+
+Write C<q{}> instead of C<''>
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals>
+
+Always use single quotes for literal strings.
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros>
+
+Write C<oct(755)> instead of C<0755>
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes>
+
+Use C<q{}> or C<qq{}> instead of quotes for awkward-looking strings
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars>
+
+Warns that you might have used single quotes when you really wanted double-quotes.
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators>
+
+Write C< 141_234_397.0145 > instead of C< 141234397.0145 >
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator>
+
+Write C< print <<'THE_END' > or C< print <<"THE_END" >
+
+=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator>
+
+Write C< <<'THE_END'; > instead of C< <<'theEnd'; >
+
+=head2 L<Perl::Critic::Policy::Variables::ProhibitLocalVars>
+
+Use C<my> instead of C<local>, except when you have to.
+
+=head2 L<Perl::Critic::Policy::Variables::ProhibitPackageVars>
+
+Eliminate globals declared with C<our> or C<use vars>
+
+=head2 L<Perl::Critic::Policy::Variables::ProhibitPunctuationVars>
+
+Write C<$EVAL_ERROR> instead of C<$@>
+
+=head1 BENDING THE RULES
+
+B<NOTE:> This feature changed in version 0.09 and is not backward
+compatible with earlier versions.
+
+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
+(or 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 pseudo-pragmas:
+
+ 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 C<"## no critic"> comments direct Perl::Critic to overlook the
+remaining lines of code until the end of the current block, or until a
+C<"## use critic"> comment is found (whichever comes first). If the
+C<"## no critic"> comment is on the same line as a code statement,
+then only that line of code is overlooked. To direct perlcritic to
+ignore the C<"## no critic"> comments, use the C<-force> option.
+
+Use this feature wisely. C<"## no critic"> should be used in the
+smallest possible scope, or only on individual lines of code. If
+Perl::Critic complains about your code, try and find a compliant
+solution before resorting to this feature.
+
+=head1 EXTENDING THE CRITIC
+
+The modular design of Perl::Critic is intended to facilitate the
+addition of new Policies. To create a new Policy, make a subclass of
+L<Perl::Critic::Policy> and override the C<violates()> method. Your
+module should go somewhere in the Perl::Critic::Policy namespace. To
+use the new Policy, just add it to your F<.perlcriticrc> file. You'll
+need to have some understanding of L<PPI>, but most Policy modules are
+pretty straightforward and only require about 20 lines of code.
+
+If you develop any new Policy modules, feel free to send them to
+<thaljef@cpan.org> and I'll be happy to put them into the Perl::Critic
+distribution.
+
+=head1 IMPORTANT CHANGES
+
+As new Policy modules were added to Perl::Critic, the overall
+performance started to deteriorate rapidly. Since each module would
+traverse the document (several times for some modules), a lot of time
+was spent iterating over the same document nodes. So starting in
+version 0.11, I have switched to a stream-based approach where the
+document is traversed once and every Policy module is tested at each
+node. The result is roughly a 300% improvement.
+
+Unfortunately, Policy modules prior to version 0.11 won't be
+compatible. Hopefully, few people have started creating their own
+Policy modules. Converting them to the stream-based model is fairly
+easy, and actually results in somewhat cleaner code. Look at the
+ControlStrucutres::* modules for some examples.
+
+=head1 PREREQUISITES
+
+Perl::Critic requires the following modules:
+
+L<PPI>
+
+L<Config::Tiny>
+
+L<File::Spec>
+
+L<List::Util>
+
+L<List::MoreUtils>
+
+L<Pod::Usage>
+
+L<Pod::PlainText>
+
+L<IO::String>
+
+L<String::Format>
+
+The following modules are optional, but recommended for complete
+testing:
+
+L<Test::Pod>
+
+L<Test::Pod::Coverage>
+
+L<Test::Perl::Critic>
+
+=head1 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 to
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Perl-Critic>. Thanks.
+
+=head1 CREDITS
+
+Adam Kennedy - For creating L<PPI>, the heart and soul of Perl::Critic.
+
+Damian Conway - For writing B<Perl Best Practices>
+
+Giuseppe Maxia - For all the great ideas and enhancements.
+
+Chris Dolan - For numerous bug reports and suggestions.
+
+Sharon, my wife - For putting up with my all-night code sessions
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Config;
+
+use strict;
+use warnings;
+use File::Spec;
+use Config::Tiny;
+use English qw(-no_match_vars);
+use List::MoreUtils qw(any none);
+use Perl::Critic::Utils;
+use Carp qw(croak);
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+#-------------------------------------------------------------------------
+
+sub new {
+
+ my ( $class, %args ) = @_;
+ my $self = bless {}, $class;
+
+ #Avoid 'uninitialized' warnings
+ my $ref_type = defined $args{-profile} ? ref $args{-profile} : $EMPTY;
+
+ #Allow empty config. This is useful for testing
+ return $self if defined $args{-profile} && $args{-profile} eq 'NONE';
+
+ #Now load profile in various ways
+ if ( $ref_type eq 'SCALAR' ) {
+ %{ $self } = _load_from_string( %args );
+ }
+ elsif ( $ref_type eq 'ARRAY' ) {
+ %{ $self } = _load_from_array( %args );
+ }
+ elsif ( $ref_type eq 'HASH' ){
+ %{ $self } = _load_from_hash( %args );
+ }
+ else {
+ %{ $self } = _load_from_file( %args );
+ }
+
+ #Filter config by patterns or priority
+ if ( $args{-exclude} || $args{-include} ) {
+ _filter_by_pattern( $self, %args );
+ }
+ else {
+ _filter_by_priority( $self, %args );
+ }
+
+ #All done!
+ return $self;
+}
+
+#------------------------------------------------------------------------
+#Begin PRIVATE methods
+
+sub _load_from_file {
+
+ my %args = @_;
+ my $file = $args{-profile};
+ $file = defined $file ? $file : find_profile_path();
+
+ my %profile = ();
+ if (! $file ){
+
+ #No profile exists, so just construct hash from
+ #default policy lists, using no parameters
+ %profile = map { ( $_ => {} ) } default_policies();
+ }
+ else {
+
+ #Load user's configuration and merge it with the
+ #default profile, using the user's parameters
+ croak qq{'$file' is not a file} if ! -f $file;
+ my $user_prefs = Config::Tiny->read($file);
+ %profile = _merge_profile( $user_prefs );
+ }
+ return %profile;
+}
+
+#------------------------------------------------------------------------
+
+sub _load_from_array {
+ my %args = @_;
+ my $joined = join qq{\n}, @{ $args{-profile} };
+ my $user_prefs = Config::Tiny->read_string( $joined );
+ return _merge_profile( $user_prefs );
+}
+
+#------------------------------------------------------------------------
+
+sub _load_from_string {
+ my %args = @_;
+ my $string = ${ $args{-profile} };
+ my $user_prefs = Config::Tiny->read_string( $string );
+ return _merge_profile( $user_prefs );
+}
+
+#------------------------------------------------------------------------
+
+sub _load_from_hash {
+ my %args = @_;
+ my $user_prefs = $args{-profile};
+ return _merge_profile( $user_prefs );
+}
+
+#------------------------------------------------------------------------
+
+sub _merge_profile {
+ my $user_prefs = shift;
+ my %config = ();
+
+ #Add user's custom policies first
+ while ( my ($policy, $params) = each %{ $user_prefs } ) {
+ next if $policy eq $EMPTY; #Skip default section
+ next if $policy =~ m{ \A - }mx; #Skip negated policies
+ $config{$policy} = $params || {};
+ }
+
+ #Now add default policies
+ for my $policy ( default_policies() ){
+ next if defined $user_prefs->{"-$policy"}; #Skip negated policies
+ $config{$policy} = $user_prefs->{$policy} || {};
+ }
+
+ return %config;
+}
+
+#------------------------------------------------------------------------
+
+sub _filter_by_pattern {
+ my ($config, %args) = @_;
+ my $in_patterns = $args{-include} || [];
+ my $ex_patterns = $args{-exclude} || [];
+
+ for my $policy ( keys %{ $config } ) {
+ if ( none {$policy =~ m{ $_ }imx} @{ $in_patterns }
+ or any {$policy =~ m{ $_ }imx} @{ $ex_patterns } ) {
+ delete $config->{$policy};
+ }
+ }
+ return $config;
+}
+
+#------------------------------------------------------------------------
+
+sub _filter_by_priority {
+ my ($config, %args) = @_;
+ my $max_priority = $args{-priority} || 1;
+
+ for my $policy ( keys %{ $config } ) {
+ $config->{$policy}->{priority} ||= 1; #Default to 1
+ if( $config->{$policy}->{priority} > $max_priority ) {
+ delete $config->{$policy};
+ }
+ }
+ return $config;
+}
+
+#----------------------------------------------------------------------------
+# Begin PUBLIC STATIC methods
+
+sub find_profile_path {
+
+ #Define default filename
+ my $rc_file = '.perlcriticrc';
+
+ #Check explicit environment setting
+ return $ENV{PERLCRITIC} if exists $ENV{PERLCRITIC};
+
+ #Check current directory
+ return $rc_file if -f $rc_file;
+
+ #Check usual environment vars
+ for my $var (qw(HOME USERPROFILE HOMESHARE)) {
+ next if !defined $ENV{$var};
+ my $path = File::Spec->catfile( $ENV{$var}, $rc_file );
+ return $path if -f $path;
+ }
+
+ #No profile found!
+ return;
+}
+
+#----------------------------------------------------------------------------
+
+sub all_policies {
+ return sort default_policies(), optional_policies();
+}
+
+#----------------------------------------------------------------------------
+
+sub default_policies {
+ return qw(
+ BuiltinFunctions::ProhibitLvalueSubstr
+ BuiltinFunctions::ProhibitSleepViaSelect
+ BuiltinFunctions::ProhibitStringyEval
+ BuiltinFunctions::RequireBlockGrep
+ BuiltinFunctions::RequireBlockMap
+ BuiltinFunctions::RequireGlobFunction
+ ClassHierarchies::ProhibitOneArgBless
+ CodeLayout::ProhibitHardTabs
+ CodeLayout::ProhibitParensWithBuiltins
+ CodeLayout::ProhibitQuotedWordLists
+ CodeLayout::RequireTrailingCommas
+ ControlStructures::ProhibitCascadingIfElse
+ ControlStructures::ProhibitCStyleForLoops
+ ControlStructures::ProhibitPostfixControls
+ ControlStructures::ProhibitUnlessBlocks
+ ControlStructures::ProhibitUntilBlocks
+ InputOutput::ProhibitBacktickOperators
+ InputOutput::ProhibitBarewordFileHandles
+ InputOutput::ProhibitOneArgSelect
+ Modules::ProhibitMultiplePackages
+ Modules::ProhibitSpecificModules
+ Modules::RequireExplicitPackage
+ Modules::RequireBarewordIncludes
+ Modules::RequireVersionVar
+ NamingConventions::ProhibitMixedCaseSubs
+ NamingConventions::ProhibitMixedCaseVars
+ Subroutines::ProhibitExplicitReturnUndef
+ RegularExpressions::RequireExtendedFormatting
+ RegularExpressions::RequireLineBoundaryMatching
+ Subroutines::ProhibitBuiltinHomonyms
+ Subroutines::ProhibitSubroutinePrototypes
+ TestingAndDebugging::RequirePackageStricture
+ TestingAndDebugging::RequirePackageWarnings
+ ValuesAndExpressions::ProhibitConstantPragma
+ ValuesAndExpressions::ProhibitEmptyQuotes
+ ValuesAndExpressions::ProhibitInterpolationOfLiterals
+ ValuesAndExpressions::ProhibitLeadingZeros
+ ValuesAndExpressions::ProhibitNoisyQuotes
+ ValuesAndExpressions::RequireInterpolationOfMetachars
+ ValuesAndExpressions::RequireNumberSeparators
+ ValuesAndExpressions::RequireQuotedHeredocTerminator
+ ValuesAndExpressions::RequireUpperCaseHeredocTerminator
+ Variables::ProhibitLocalVars
+ Variables::ProhibitPackageVars
+ Variables::ProhibitPunctuationVars
+ );
+}
+
+#----------------------------------------------------------------------------
+
+sub optional_policies {
+ return qw(
+ CodeLayout::RequireTidyCode
+ Miscellanea::RequireRcsKeywords
+ );
+}
+
+#----------------------------------------------------------------------------
+
+sub pbp_policies {
+ return qw(
+ BuiltinFunctions::ProhibitLvalueSubstr
+ BuiltinFunctions::ProhibitSleepViaSelect
+ BuiltinFunctions::ProhibitStringyEval
+ BuiltinFunctions::RequireBlockGrep
+ BuiltinFunctions::RequireBlockMap
+ BuiltinFunctions::RequireGlobFunction
+ ClassHierarchies::ProhibitOneArgBless
+ CodeLayout::ProhibitHardTabs
+ CodeLayout::ProhibitParensWithBuiltins
+ CodeLayout::RequireTrailingCommas
+ ControlStructures::ProhibitCascadingIfElse
+ ControlStructures::ProhibitCStyleForLoops
+ ControlStructures::ProhibitPostfixControls
+ ControlStructures::ProhibitUnlessBlocks
+ ControlStructures::ProhibitUntilBlocks
+ InputOutput::ProhibitBarewordFileHandles
+ InputOutput::ProhibitOneArgSelect
+ NamingConventions::ProhibitMixedCaseSubs
+ NamingConventions::ProhibitMixedCaseVars
+ Subroutines::ProhibitExplicitReturnUndef
+ RegularExpressions::RequireExtendedFormatting
+ RegularExpressions::RequireLineBoundaryMatching
+ Subroutines::ProhibitBuiltinHomonyms
+ Subroutines::ProhibitSubroutinePrototypes
+ TestingAndDebugging::RequirePackageStricture
+ TestingAndDebugging::RequirePackageWarnings
+ ValuesAndExpressions::ProhibitConstantPragma
+ ValuesAndExpressions::ProhibitEmptyQuotes
+ ValuesAndExpressions::ProhibitInterpolationOfLiterals
+ ValuesAndExpressions::ProhibitLeadingZeros
+ ValuesAndExpressions::ProhibitNoisyQuotes
+ ValuesAndExpressions::RequireInterpolationOfMetachars
+ ValuesAndExpressions::RequireNumberSeparators
+ ValuesAndExpressions::RequireQuotedHeredocTerminator
+ ValuesAndExpressions::RequireUpperCaseHeredocTerminator
+ Variables::ProhibitLocalVars
+ Variables::ProhibitPackageVars
+ Variables::ProhibitPunctuationVars
+ );
+}
+
+
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Config - Load Perl::Critic user-preferences
+
+=head1 DESCRIPTION
+
+Perl::Critic::Config takes care of finding and processing
+user-preferences for L<Perl::Critic>. The Config dictates which
+Policy modules will be loaded into the Perl::Critic engine and how
+they should be configured. You should never need to instantiate
+Perl::Critic::Config directly as the L<Perl::Critic> constructor will
+do it for you.
+
+=head1 CONSTRUCTOR
+
+=over 8
+
+=item new ( [ -profile => $FILE, -priority => $N, -include => \@PATTERNS, -exclude => \@PATTERNS ] )
+
+Returns a reference to a new Perl::Critic::Config object, which is
+basically just a blessed hash of configuration parameters. There
+aren't any special methods for getting and setting individual values,
+so just treat it like an ordinary hash. All arguments are optional
+key-value pairs as follows:
+
+B<-profile> is a path to a configuration file. If C<$FILE> is not
+defined, Perl::Critic::Config attempts to find a F<.perlcriticrc>
+configuration file in the current directory, and then in your home
+directory. Alternatively, you can set the C<PERLCRITIC> environment
+variable to point to a file in another location. If a configuration
+file can't be found, or if C<$FILE> is an empty string, then it
+defaults to include all the Policy modules that ship with
+Perl::Critic. See L<"CONFIGURATION"> for more information.
+
+B<-priority> is the maximum priority value of Policies that should be
+added to the Perl::Critic::Config. 1 is the "highest" priority, and
+all numbers larger than 1 have "lower" priority. Once the
+user-preferences have been read from the C<-profile>, all Policies
+that are configured with a priority greater than C<$N> will be removed
+from this Config. For a given C<-profile>, increasing C<$N> will
+result in more Policy violations. The default C<-priority> is 1. See
+L<"CONFIGURATION"> for more information.
+
+B<-include> is a reference to a list of C<@PATTERNS>. Once the
+user-preferences have been read from the C<-profile>, all Policies
+that do not match at least one C<m/$PATTERN/imx> will be removed
+from this Config. Using the C<-include> option causes the <-priority>
+option to be ignored.
+
+B<-exclude> is a reference to a list of C<@PATTERNS>. Once the
+user-preferences have been read from the C<-profile>, all Policies
+that match at least one C<m/$PATTERN/imx> will be removed from
+this Config. Using the C<-exclude> option causes the <-priority>
+option to be ignored. The C<-exclude> patterns are applied after the
+<-include> patterns, therefore, the C<-exclude> patterns take
+precedence.
+
+=back
+
+=head1 SUBROUTINES
+
+Perl::Critic::Config has a few static subroutines that are used
+internally, but may be useful to you in some way.
+
+=over 8
+
+=item find_profile_path( void )
+
+Searches the C<PERLCRITIC> environment variable, the current
+directory, and you home directory (in that order) for a
+F<.perlcriticrc> file. If the file is found, the full path is
+returned. Otherwise, returns undef;
+
+=item default_policies( void )
+
+Returns a list of the default Policy modules that are automatically
+included in the Config. This includes all the Policy modules that
+ship with Perl::Critic except those that depend on optional external
+modules.
+
+=item optional_policies( void )
+
+Returns a list of the optional Policy modules that ship with
+Perl::Critic but are not part of the default setup. These Policies
+are usually optional because they depend on external modules.
+
+=item all_policies( void )
+
+Returns a list of all the Policy modules that ship with Perl::Critic.
+In other words it is the union of C<default_policies()> and
+C<optional_policies()>.
+
+=item pbp_policies( void )
+
+Returns a list of only those Policy modules based on Damian Conway's
+book "Perl Best Practices." In the future, Perl::Critic may support
+some option to use only PBP Policies.
+
+=back
+
+=head1 CONFIGURATION
+
+The default configuration file is called F<.perlcriticrc>.
+Perl::Critic::Config 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
+C<-profile> option is not given to the constructor,
+Perl::Critic::Config defaults to inlucde all the policies that are
+shipped with Perl::Critic.
+
+The format of the configuration file is a series of named sections
+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. The general recipe is a series of
+blocks like this:
+
+ [Perl::Critic::Policy::Category::PolicyName]
+ priority = 1
+ arg1 = value1
+ arg2 = value2
+
+C<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 B<Perl Best Practices>. For
+brevity, you can ommit the C<'Perl::Critic::Policy'> part of the
+module name. All Policy modules must be a subclass of
+L<Perl::Critic::Policy>.
+
+C<priority> is the level of importance you wish to assign to this
+policy. 1 is the "highest" priority level, and all numbers greater
+than 1 have increasingly "lower" priority. Only those policies with a
+priority less than or equal to the C<-priority> value given to the
+constructor will be loaded. The priority can be an arbitrarily large
+positive integer. If the priority is not defined, it defaults to 1.
+
+The remaining key-value pairs are configuration parameters for that
+specific Policy and will be passed into the constructor of the
+L<Perl::Critic::Policy> subclass. The constructors for most Policy
+modules do not support arguments, and those that do should have
+reasonable defaults. See the documentation on the appropriate Policy
+module for more details.
+
+By default, all the policies that are distributed with Perl::Critic
+are added to the Config. Rather than assign a priority level to a
+Policy, you can simply "turn off" a Policy by prepending a '-' to the
+name of the module in the config file. In this manner, the Policy
+will never be loaded, regardless of the C<-priority> given to the
+constructor.
+
+
+A simple configuration might look like this:
+
+ #--------------------------------------------------------------
+ # These are really important, so always load them
+
+ [TestingAndDebugging::RequirePackageStricture]
+ priority = 1
+
+ [TestingAndDebugging::RequirePackageWarnings]
+ priority = 1
+
+ #--------------------------------------------------------------
+ # These are less important, so only load when asked
+
+ [Variables::ProhibitPackageVars]
+ priority = 2
+
+ [ControlStructures::ProhibitPostfixControls]
+ priority = 2
+
+ #--------------------------------------------------------------
+ # I do not agree with these, so never load them
+
+ [-NamingConventions::ProhibitMixedCaseVars]
+ [-NamingConventions::ProhibitMixedCaseSubs]
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+#----------------------------------------------------------------------------
+
+sub new { return bless {}, shift }
+sub violates { _abstract_method() }
+
+sub _abstract_method {
+ my $method_name = ( caller 1 )[3];
+ my ( $file, $line ) = ( caller 2 )[ 1, 2 ];
+ die "Can't call abstract method '$method_name' at $file line $line.\n";
+}
+
+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. Your job is to implement and override its methods in a
+subclass. To work with the L<Perl::Critic> engine, your
+implementation must behave as described below.
+
+=head1 IMPORTANT CHANGES
+
+As new Policy modules were added to Perl::Critic, the overall
+performance started to deteriorate rapidily. Since each module would
+traverse the document (several times for some modules), a lot of time
+was spent iterating over the same document nodes. So starting in
+version 0.11, I have switched to a stream-based approach where the
+document is traversed once and every Policy module is tested at each
+node. The result is roughly a 300% improvement, and the Perl::Critic
+engine will scale better as more Policies are added.
+
+Unfortunately, Policy modules prior to version 0.11 won't be
+compatible. Converting them to the stream-based model is fairly easy,
+and it actually results in somewhat cleaner code. Look at the
+ControlStrucutres::* modules for some good examples.
+
+=head1 METHODS
+
+=over 8
+
+=item new(key1 => value1, key2 => value2...)
+
+Returns a reference to a new subclass of Perl::Critic::Policy. If
+your Policy requires any special arguments, they should be passed
+in here as key-value paris. Users of L<perlcritic> can specify
+these in their config file. Unless you override the C<new> method,
+the default method simply returns a reference to an empty hash that
+has been blessed into your subclass.
+
+=item violates( $element, $document )
+
+Given a L<PPI::Element> and a L<PPI::Document>, returns one or more
+L<Perl::Critic::Violation> object if the C<$element> violates this
+policy. If there are no violations, then it returns an empty list.
+
+L<Perl::Critic> will call C<violates()> on every C<$element> in the
+C<$document>. Some Policies may need to look at the entire
+C<$document> and probably only need to be executed once. In that
+case, you should write C<violates()> so that it short-circuts if the
+Policy has already been executed. See
+L<Perl::Critic::Policy::Modules::ProhibitUnpackagedCode> for an
+example of such a Policy.
+
+C<violates()> is an abstract method and it will croak if you attempt
+to invoke it directly. Your subclass B<must> override this method.
+
+=back
+
+=head1 DOCUMENTATION
+
+When your Policy module first C<use>s L<Perl::Critic::Violation>, it
+will try and extrace 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 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic;
+
+my $desc = q{Lvalue form of 'substr' used};
+my $expl = [165];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ($self, $elem, $doc) = @_;
+ $elem->isa('PPI::Token::Word') && $elem eq 'substr' || return;
+ return if is_method_call($elem);
+ return if is_hash_key($elem);
+
+ my $sib = $elem;
+ while ($sib = $sib->snext_sibling()) {
+ next if ! ( $sib->isa( 'PPI::Token::Operator') && $sib eq q{=} );
+ return Perl::Critic::Violation->new($desc, $expl, $sib->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::BuiltinFunctions::ProhibitLValueSubstr
+
+=head1 DESCRIPTION
+
+Conway discourages the use of C<substr()> as an lvalue, instead
+recommending that the 4-arg version of C<substr()> be used instead.
+
+ substr($something, 1, 2) = $newvalue; # not ok
+ substr($something, 1, 2, $newvalue); # ok
+
+=head1 AUTHOR
+
+Graham TerMarsch <graham@howlingfrog.com>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005 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
--- /dev/null
+package Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic;
+
+my $desc = q{'select' used to emmulate 'sleep'};
+my $expl = [168];
+
+#------------------------------------------------------------------------
+
+sub violates {
+ my ($self, $elem, $doc) = @_;
+ $elem->isa('PPI::Token::Word') && $elem eq 'select' || return;
+ return if is_method_call($elem);
+ return if is_hash_key($elem);
+
+ if ( 3 == grep {$_->[0] eq 'undef' } parse_arg_list($elem) ){
+ return Perl::Critic::Violation->new($desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect
+
+=head1 DESCRIPTION
+
+Conway discourages the use of C<select()> for performing non-integer
+sleeps. Although its documented in L<perlfunc>, its something that
+generally requires the reader to RTFM to figure out what C<select()>
+is supposed to 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 SEE ALSO
+
+L<Time::HiRes>.
+
+=head1 AUTHOR
+
+Graham TerMarsch <graham@howlingfrog.com>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005 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
--- /dev/null
+package Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Expression form of 'eval'};
+my $expl = [161];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Word') && $elem eq 'eval' || return;
+ return if is_hash_key($elem);
+
+ my $sib = $elem->snext_sibling() || return;
+ my $arg = $sib->isa('PPI::Structure::List') ? $sib->schild(0) : $sib;
+ return if !$arg || $arg->isa('PPI::Structure::Block');
+
+ #Must not be a block
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval
+
+=head1 DESCRIPTION
+
+The string form of 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 SEE ALSO
+
+L<Perl::Critic::Policy::ControlStrucutres::ProhibitStringyGrep>
+
+L<Perl::Critic::Policy::ControlStrucutres::ProhibitStringyMap>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Expression form of 'grep'};
+my $expl = [169];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Word') && $elem eq 'grep' || return;
+ return if is_method_call($elem);
+ return if is_hash_key($elem);
+
+ my $sib = $elem->snext_sibling() || return;
+ my $arg = $sib->isa('PPI::Structure::List') ? $sib->schild(0) : $sib;
+ return if !$arg || $arg->isa('PPI::Structure::Block');
+
+ #Must not be a block
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep
+
+=head1 DESCRIPTION
+
+The expression form of C<grep> and C<map> is 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 SEE ALSO
+
+L<Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval>
+
+L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Expression form of 'map'};
+my $expl = [169];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Word') && $elem eq 'map' || return;
+ return if is_method_call($elem);
+ return if is_hash_key($elem);
+
+ my $sib = $elem->snext_sibling() || return;
+ my $arg = $sib->isa('PPI::Structure::List') ? $sib->schild(0) : $sib;
+ return if !$arg || $arg->isa('PPI::Structure::Block');
+
+ #Must not be a block
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap
+
+=head1 DESCRIPTION
+
+The expression form of C<grep> and C<map> is 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 SEE ALSO
+
+L<Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval>
+
+L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $glob_rx = qr{ [\*\?] }x;
+my $desc = q{Glob written as <...>};
+my $expl = [167];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::QuoteLike::Readline') || return;
+ if ( $elem =~ $glob_rx ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction
+
+=head1 DESCRIPTION
+
+Conway discourages the use of the C<E<lt>..E<gt>> construct for globbing, as
+its heavily associated with I/O in most people's minds. 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 AUTHOR
+
+Graham TerMarsch <graham@howlingfrog.com>
+
+Copyright (C) 2005 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.
--- /dev/null
+package Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{One-argument 'bless' used};
+my $expl = [ 365 ];
+
+#--------------------------------------------------------------------------
+
+sub violates {
+ my ($self, $elem, $doc) = @_;
+ $elem->isa('PPI::Token::Word') && $elem eq 'bless' || return;
+ return if is_method_call($elem);
+ return if is_hash_key($elem);
+
+ if( scalar parse_arg_list($elem) == 1 ) {
+ return Perl::Critic::Violation->new($desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless
+
+=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 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005 Jeffrey Ryan Thalhammer. All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
--- /dev/null
+package Perl::Critic::Policy::CodeLayout::ProhibitHardTabs;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Hard tabs used};
+my $expl = [20];
+
+#----------------------------------------------------------------------------
+
+sub new {
+ my ( $class, %args ) = @_;
+ my $self = bless {}, $class;
+
+ #Set config, if defined
+ $self->{_allow_leading_tabs} =
+ defined $args{allow_leading_tabs} ? $args{allow_leading_tabs} : 1;
+
+ return $self;
+}
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token') && $elem =~ m{ \t }mx || return;
+
+ #Permit leading tabs, if allowed
+ return if $self->{_allow_leading_tabs} && $elem->location->[1] == 1;
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::CodeLayout::ProhibitHardTabs
+
+=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 differnently, 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>
+also does this for you.
+
+This Policy catches all tabs in your source code, including POD, quotes,
+and HEREDOCS. However, tabs in a leading position are allowed. If you want
+to forbid all tabs everywhere, put this to your F<.perlcriticrc> file:
+
+ [CodeLayout::ProhibitHardTabs]
+ allow_leading_tabs = 0
+
+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 <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use List::MoreUtils qw(any);
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my %allow = ( my => 1, our => 1, local => 1, return => 1, );
+my $desc = q{Builtin function called with parens};
+my $expl = [13];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Word') || return;
+ return if exists $allow{"$elem"};
+ if ( any { $elem eq $_ } @BUILTINS ) {
+ if ( _sibling_is_list($elem) && !_is_object_method($elem) ) {
+ return Perl::Critic::Violation->new( $desc, $expl,
+ $elem->location() );
+ }
+ }
+ return; #ok!
+}
+
+sub _sibling_is_list {
+ my $elem = shift;
+ my $sib = $elem->snext_sibling() || return;
+ return $sib->isa('PPI::Structure::List');
+}
+
+sub _is_object_method {
+ my $elem = shift;
+ my $sib = $elem->sprevious_sibling() || return;
+ return $sib->isa('PPI::Token::Operator') && $sib eq q{->};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins
+
+=head1 DESCRIPTION
+
+Conway suggests that all built-in functions should be called without
+parenthesis 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 parenthesis when
+called with multiple arguments. C<return> is also exempt because
+technically it is a named unary operator, not a function.
+
+ open($handle, '>', $filename); #not ok
+ open $handle, '>', $filename; #ok
+
+ split(/$pattern/, @list); #not ok
+ split /$pattern/, @list; #ok
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{List of quoted literal words};
+my $expl = q{Use 'qw()' instead};
+
+#---------------------------------------------------------------------------
+
+sub new {
+ my ($class, %args) = @_;
+ my $self = bless {}, $class;
+
+ #Set configuration if defined
+ $self->{_min} = defined $args{min_elements} ? $args{min_elements} : 2;
+ return $self;
+}
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Structure::List') || return;
+
+ #Don't worry about subroutine calls
+ my $sib = $elem->sprevious_sibling() || return;
+ return if $sib->isa('PPI::Token::Word');
+ return if $sib->isa('PPI::Token::Symbol');
+
+ #Get the list elements
+ my $expr = $elem->schild(0) || return;
+ my @children = $expr->schildren();
+ @children || return;
+
+ my $count = 0;
+ for my $child ( @children ) {
+ next if $child->isa('PPI::Token::Operator') && $child eq $COMMA;
+ return if ! _is_literal($child);
+ return if $child =~ m{ \s }mx;
+ $count++;
+ }
+
+ #Were there enough?
+ return if $count < $self->{_min};
+
+ #If we get here, then all children were literals
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+}
+
+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;
+
+=head1 DESCRIPTION
+
+Conway doesn't mention this, but I think C<qw()> is an underutilized
+feature of Perl. Whenever you need to declare a list of one-word
+literals, the C<qw()> operator is wonderfully concise and saves you
+lots of keystrokes. And uusing C<qw()> makes it easy to add to the
+list in the future.
+
+ @list = ('foo', 'bar', 'baz'); #not ok
+ @list = qw(foo bar baz); #ok
+
+=head1 CONSTRUCTOR
+
+This Policy accepts an additional key-value pair in the constructor.
+The key must be 'min_elements' and the value is the minimum number of
+elements in the list. Lists with fewer elements will be overlooked by
+this Policy. The default is 2. Users of Perl::Critic can configure
+this in their F<.perlcriticrc> file like this:
+
+ [CodeLayout::ProhibitQuotedWordLists]
+ min_elements = 4
+
+=head1 NOTES
+
+In the PPI parlance, a "list" is almost anything with parens. 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 "RequireQuotedWords" which seemed a
+little counterintuitive. If you get lots of "Cannot load policy
+module" errors, then you probably need to change "RequireQuotedWords"
+to "ProhibitQuotedWordLists" in your F<.perlcriticrc> file.
+
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. All rights reserved.
+
+=head1 COPYRIGHT
+
+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
--- /dev/null
+package Perl::Critic::Policy::CodeLayout::RequireTidyCode;
+
+use strict;
+use warnings;
+use Perl::Tidy;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Code is not tidy};
+my $expl = [33];
+
+#----------------------------------------------------------------------------
+
+sub new {
+ my ( $class, %args ) = shift;
+ my $self = bless {}, $class;
+ $self->{_tested} = 0;
+ return $self;
+}
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ return if $self->{_tested}; #Only test this once!
+ $self->{_tested} = 1;
+
+ my $source = "$doc";
+ my $dest = $EMPTY;
+ my $logfile = $EMPTY;
+ my $errfile = $EMPTY;
+ my $stderr = $EMPTY;
+
+ Perl::Tidy::perltidy(
+ source => \$source,
+ destination => \$dest,
+ stderr => \$stderr,
+ logfile => \$logfile,
+ errorfile => \$errfile
+ );
+
+ if ($stderr) {
+
+ # Looks like perltidy had problems
+ $desc = q{perltidy had errors!!};
+ }
+
+ if ( $source eq $dest ) {
+ return Perl::Critic::Violation->new( $desc, $expl, [ 0, 0 ] );
+ }
+
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::CodeLayout::RequireTidyCode
+
+=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>. This policy will complain if
+you're code hasn't been run through Perl::Tidy.
+
+=head1 NOTES
+
+Since L<Perl::Tidy> is not widely deployed, this is the only policy in
+the L<Perl::Critic> distribution that is not enabled by default. To
+enable it, put this line in your F<.perlcriticrc> file:
+
+ [CodeLayout::RequireTidyCode]
+
+=head1 SEE ALSO
+
+L<Perl::Tidy>
+
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::CodeLayout::RequireTrailingCommas;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{List declaration without trailing comma};
+my $expl = [ 17 ];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Structure::List') && $elem =~ m{ \n }mx || return;
+
+ #Is it an assignment of some kind?
+ my $sib = $elem->sprevious_sibling() || return;
+ $sib->isa('PPI::Token::Operator') && $sib =~ m{ = }mx || return;
+
+ #List elements are children of an expression
+ my $expr = $elem->schild(0) || return;
+
+ #Does the list have more than 1 element?
+ my @children = $expr->schildren();
+ (grep { $_ eq $COMMA } @children) > 1 || return;
+
+ #Is the last element a comma?
+ my $last = $children[-1] || return;
+ if ( ! ($last->isa('PPI::Token::Operator') && $last eq $COMMA) ) {
+ return Perl::Critic::Violation->new($desc, $expl, $last->location() );
+ }
+
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::CodeLayout::RequireTrailingCommas
+
+=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 NOTES
+
+In the PPI parlance, a "list" is almost anything with parens. 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 <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops;
+
+use strict;
+use warnings;
+use Perl::Critic::Violation;
+use Perl::Critic::Utils;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{C-style 'for' loop used};
+my $expl = [97];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Structure::ForLoop') || return;
+ if ( _is_cstyle($elem) ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+sub _is_cstyle {
+ my $elem = shift;
+ my $nodes_ref = $elem->find('PPI::Token::Structure') || return;
+ my @semis = grep { $_ eq $SCOLON } @{$nodes_ref};
+ return scalar @semis == 2;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops
+
+=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 Perl-ish
+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 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse;
+
+use strict;
+use warnings;
+use Perl::Critic::Violation;
+use Perl::Critic::Utils;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Cascading if-elsif chain};
+my $expl = [ 117, 118 ];
+
+#----------------------------------------------------------------------------
+
+sub new {
+ my ( $class, %args ) = @_;
+ my $self = bless {}, $class;
+
+ #Set configuration
+ $self->{_max} = defined $args{max_elsif} ? $args{max_elsif} : 2;
+
+ return $self;
+}
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement::Compound') && $elem->type() eq 'if' || return;
+ if ( _count_elsifs($elem) > $self->{_max} ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+sub _count_elsifs {
+ my $elem = shift;
+ return
+ grep { $_->isa('PPI::Token::Word') && $_ eq 'elsif' } $elem->schildren();
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse
+
+=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. See L<Switch> for another approach.
+
+ if ($condition1) { #ok
+ $foo = 1;
+ }
+ elseif ($condition2) { #ok
+ $foo = 2;
+ }
+ elsif ($condition3) { #ok
+ $foo = 3;
+ }
+ elsif ($condition4) { #too many!
+ $foo = 4;
+ }
+ else{ #ok
+ $foo = $default;
+ }
+
+=head1 CONSTRUCTOR
+
+This policy accepts an additional key-value pair in the C<new> method.
+The key should be 'max' and the value should be an integer indicating
+the maximum number of C<elsif> alternatives to allow. The default is
+2. When using the L<Perl::Critic> engine, these can be configured in
+the F<.perlcriticrc> file like this:
+
+ [ControlStructures::ProhibitCascadingIfElse]
+ max_elsif = 3
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
+
+
--- /dev/null
+package Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls;
+
+use strict;
+use warnings;
+use Perl::Critic::Violation;
+use Perl::Critic::Utils;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my %pages_of = (
+ if => [ 93, 94 ],
+ unless => [ 96, 97 ],
+ until => [ 96, 97 ],
+ for => [ 96 ],
+ while => [ 96 ],
+);
+
+my %exemptions = (
+ warn => 1,
+ die => 1,
+ carp => 1,
+ croak => 1,
+ cluck => 1,
+ confess => 1,
+ goto => 1,
+);
+
+#----------------------------------------------------------------------------
+
+sub new {
+ my ( $class, %args ) = @_;
+ my $self = bless {}, $class;
+ $self->{_allow} = {};
+
+ #Set config, if defined
+ if ( defined $args{allow} ) {
+ for my $control ( split m{ \s+ }mx, $args{allow} ) {
+ $self->{_allow}->{$control} = 1;
+ }
+ }
+ return $self;
+}
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Word') && exists $pages_of{$elem} || return;
+ return if is_hash_key($elem);
+
+ # Skip controls that are allowed
+ return if exists $self->{_allow}{$elem};
+
+ # Skip Compound variety (these are good)
+ my $stmnt = $elem->statement() || return;
+ return if $stmnt->isa('PPI::Statement::Compound');
+
+ #Handle special cases
+ if ( $elem eq 'if' ) {
+ #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 $exemptions{ $stmnt->schild(0) };
+ }
+
+
+ # If we get here, it must be postfix.
+ my $desc = qq{Postfix control '$elem' used};
+ my $expl = $pages_of{$elem};
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls
+
+=head1 DESCRIPTION
+
+Conway discourages using postfix control structures (C<if>, C<for>,
+C<unless>, C<until>, C<while>). The C<unless> and C<until> controls
+are particularly evil becuase the lead to double-negatives that are
+hard to comprehend. The only tolerable usage of a postfix C<if> 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
+ }
+
+=head1 CONSTRUCTOR
+
+This policy accepts an additional key-value pair in the C<new> method.
+The key should be 'allow' and the value is a string of space-delimited
+keywords. Choose from C<if>, C<for>, C<unless>, C<until>,and
+C<while>. When using the L<Perl::Critic> engine, these can be
+configured in the F<.perlcriticrc> file like this:
+
+ [ControlStructures::ProhibitPostfixControls]
+ allow = for if until
+
+By default, all postfix control keywords are prohibited.
+
+=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.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks;
+
+use strict;
+use warnings;
+use Perl::Critic::Violation;
+use Perl::Critic::Utils;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{'unless' block used};
+my $expl = [97];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement::Compound') || return;
+ if ( $elem->first_element() eq 'unless' ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks
+
+=head1 DESCRIPTION
+
+Conway discourages using C<unless> becuase 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 'ProhibitPostfixControls'.
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks;
+
+use strict;
+use warnings;
+use Perl::Critic::Violation;
+use Perl::Critic::Utils;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{'until' block used};
+my $expl = [97];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement') || return;
+ if ( $elem->first_element() eq 'until' ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks
+
+=head1 DESCRIPTION
+
+Conway discourages using C<until> becuase 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 'ProhibitPostfixControls'.
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $expl = q{Use IPC::Open3 instead};
+my $desc = q{Backtick operator used};
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ if ( $elem->isa('PPI::Token::QuoteLike::Backtick')
+ || $elem->isa('PPI::Token::QuoteLike::Command') )
+ {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators
+
+=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;
+
+ @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 NOTES
+
+This policy also prohibits the generalized form of backticks seen as
+C<qx{}>.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Bareword file handle opened};
+my $expl = [ 224 ];
+
+#--------------------------------------------------------------------------
+
+sub violates {
+ my ($self, $elem, $doc) = @_;
+ $elem->isa('PPI::Token::Word') && $elem eq 'open' || return;
+ return if is_method_call($elem);
+ return if is_hash_key($elem);
+
+ my $first = ( parse_arg_list($elem) )[0] || return;
+ $first = $first->[0] || return; #Ick!
+
+ if( $first->isa('PPI::Token::Word') && !($first eq 'my') ) {
+ return Perl::Critic::Violation->new($desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles
+
+=head1 DESCRIPTION
+
+=head1 SEE ALSO
+
+L<IO::Handle>
+
+L<IO::File>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005 Jeffrey Ryan Thalhammer. All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
--- /dev/null
+package Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{One-argument 'select' used};
+my $expl = [224];
+
+#--------------------------------------------------------------------------
+
+sub violates {
+ my ($self, $elem, $doc) = @_;
+ $elem->isa('PPI::Token::Word') && $elem eq 'select' || return;
+ return if is_method_call($elem);
+ return if is_hash_key($elem);
+
+ if( scalar parse_arg_list($elem) == 1 ) {
+ return Perl::Critic::Violation->new($desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect
+
+=head1 DESCRIPTION
+
+Conway discurages the use of a raw C<select()> when setting
+autoflushes. We'll extend that further by simply prohibiting the
+one-arg form of C<select()> entirely; if you really need it you should
+know when/where/why that is. For performing autoflushes, Conway
+recommends the use of C<IO::Handle> instead.
+
+ select((select($fh), $|=1)[0]); # not ok
+ select $fh; # not ok
+
+ use IO::Handle;
+ $fh->autoflush(); # ok
+ *STDOUT->autoflush(); # ok
+
+=head1 SEE ALSO
+
+L<IO::Handle>.
+
+=head1 AUTHOR
+
+Graham TerMarsch <graham@howlingfrog.com>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005 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
--- /dev/null
+package Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Two-argument 'select' used};
+my $expl = [224];
+
+#--------------------------------------------------------------------------
+
+sub violates {
+ my ($self, $elem, $doc) = @_;
+ $elem->isa('PPI::Token::Word') && $elem eq 'open' || return;
+ return if is_method_call($elem);
+ return if is_hash_key($elem);
+
+ if( scalar parse_arg_list($elem) == 2 ) {
+ return Perl::Critic::Violation->new($desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen
+
+=head1 DESCRIPTION
+
+The three-argument form of C<open> (introduced in Perl 5.6) prevents
+subtle bugs that occur when the filename starts with funny characters
+like '>' or '<'. The L<IO::File> module provides a nice OO interface
+to filehanldes, which I think is more elegant anyway.
+
+ open( $fh, '>output.txt' ); # not ok
+ open( $fh, q{>}, 'output.txt ); # ok
+
+ use IO::File;
+ my $fh = IO::File->new( 'output.txt', q{>} ); # even better!
+
+=head1 NOTES
+
+The only time you should use the two-argument form is when you re-open
+STDIN, STDOUT, or STDERR. But for now, this Policy doesn't provide
+that loophole.
+
+=head1 SEE ALSO
+
+L<IO::Handle>
+
+L<IO::File>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005 Jeffrey Ryan Thalhammer. All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
--- /dev/null
+package Perl::Critic::Policy::Miscellanea::RequireRcsKeywords;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use List::MoreUtils qw(none);
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $expl = [ 441 ];
+
+#---------------------------------------------------------------------------
+
+sub new {
+ my ($class, %config) = @_;
+ my $self = bless {}, $class;
+ $self->{_keywords} = [ qw(Revision Source Date) ];
+ $self->{_tested} = 0;
+
+ #Set configuration, if defined.
+ if ( defined $config{keywords} ) {
+ $self->{_keywords} = [ split m{ \s+ }mx, $config{keywords} ];
+ }
+
+ return $self;
+}
+
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ return if $self->{_tested}; #Only do this once!
+ my @viols = ();
+
+ my $nodes = $doc->find( \&_wanted );
+ for my $keyword ( @{ $self->{_keywords} } ) {
+ if ( (!$nodes) || none { $_ =~ m{ \$$keyword.*\$ }mx } @{$nodes} ) {
+ my $desc = qq{RCS keyword '\$$keyword\$' not found};
+ push @viols, Perl::Critic::Violation->new( $desc, $expl, [0,0] );
+ }
+ }
+
+ $self->{_tested} = 1;
+ return @viols;
+}
+
+sub _wanted {
+ my ($doc, $elem) = @_;
+ return $elem->isa('PPI::Token::Comment')
+ || $elem->isa('PPI::Token::Quote::Single')
+ || $elem->isa('PPI::Token::Quote::Literal');
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::Miscellanea::RequireRcsKeywords
+
+=head1 DESCRIPTION
+
+Every code file, no matter how small, should be kept in a
+source-control repository. Adding the magical RCS keywords to your
+file helps the reader know where the file comes from, in case he or
+she needs to modify it. This Policy scans your file for comments that
+look like this:
+
+ # $Revision: 2.14 $
+ # $Source: /myproject/lib/foo.pm $
+
+A common practice is to use the C<$Revision$> keyword to automatically
+define the C<$VERSION> variable like this:
+
+ our ($VERSION) = '$Revision: 1.01 $' =~ m{ \$Revision: \s+ (\S+) }x;
+
+=head1 CONSTRUCTOR
+
+By default, this policy only requires the C<$Revision$>, C<$Source$>,
+and C<$Date$> keywords. To specify alternate keywords, pass them into
+the constructor as a key-value pair, where the key is 'keywords' and
+the value is a whitespace delimited series of keywords (without the
+dollar-signs). Or specify them in your F<.perlcriticrc> file like
+this:
+
+ [Miscellanea::RequireRcsKeywords]
+ keywords = Revision Source Date Author Id
+
+See the doumentation on RCS for a list of supported keywords. Many
+source control systems are descended from RCS, so the keywords
+supported by CVS and Subversion are probably the same.
+
+=head1 NOTES
+
+Not every system has source-control tools, so this policy is not
+loaded by default. To have it loaded into Perl::Critic, put this in
+your F<.perlcriticrc> file:
+
+ [Miscellanea::RequireRcsKeywords]
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::Modules::ProhibitMultiplePackages;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Multiple 'package' declarations};
+my $expl = q{Limit to one per file};
+my $tested = 0;
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ return if $tested; #Only do this once !
+ $tested = 1;
+
+ my $nodes_ref = $doc->find('PPI::Statement::Package') || return;
+ my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : ();
+ return
+ map { Perl::Critic::Violation->new( $desc, $expl, $_->location() ) }
+ @matches;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::Modules::ProhibitMultiplePackages
+
+=head1 DESCRIPTION
+
+Conway doesn't specifically mention this, but I find it annoying when
+there are multiple packages in the same file. When searching for
+methods or keywords in your editor, it makes it hard to find the right
+chunk of code, especially if each package is a subclass of the same
+base.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::Modules::ProhibitSpecificModules;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $expl = q{Find an alternative module};
+my $desc = q{Prohibited module used};
+
+#----------------------------------------------------------------------------
+
+sub new {
+ my ( $class, %args ) = @_;
+ my $self = bless {}, $class;
+
+ #Set config, if defined
+ if ( defined $args{modules} ) {
+ for my $module ( split m{ \s+ }mx, $args{modules} ) {
+ $self->{_evil_modules}->{$module} = 1;
+ }
+ }
+ return $self;
+}
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement::Include') || return;
+ if ( exists $self->{_evil_modules}->{ $elem->module() } ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::Modules::ProhibitSpecificModules
+
+=head1 DESCRIPTION
+
+Use this policy if you wish to prohibit the use of certain modules.
+These may be modules that you feel are deprecated, buggy, unsupported,
+insecure, or just don't like.
+
+=head1 CONSTRUCTOR
+
+This policy accepts an additional key-value pair in the C<new> method.
+The key should be 'modules' and the value is a string of
+space-delimited fully qualified module names. These can be configured in the
+F<.perlcriticrc> file like this:
+
+ [Modules::ProhibitSpecificModules]
+ modules = Getopt::Std Autoload
+
+By default, there aren't any prohibited modules (although I can think
+of a few that should be).
+
+=head1 NOTES
+
+Note that this policy doesn't apply to pragmas. Future versions may
+allow you to specify an alternative for each prohibited module, which
+can be suggested by L<Perl::Critic>.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::Modules::RequireBarewordIncludes;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $expl = q{Use a bareword instead};
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement::Include') || return;
+ my $child = $elem->schild(1) || return;
+
+ if( $child->isa('PPI::Token::Quote') ) {
+ my $type = $elem->type();
+ my $desc = qq{'$type' statement with library name as string};
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::Modules::RequireBarewordIncludes
+
+=head1 DESCRIPTION
+
+When including another module (or library) via the C<require> or
+C<use> statements, it is best to identify the module (or library)
+using a bareword rather than an explicit path. This is because paths
+are usually not portable from one machine to another. Also, Perl
+automatically assumes that the filename ends in '.pm' when the library
+is expressed as a bareword. So as a side-effect, this Policy
+encourages people to write '*.pm' modules instead of the old-school
+'*.pl' libraries.
+
+ use 'My/Perl/Module.pm'; #not ok
+ use My::Perl::Module; #ok
+
+=head1 NOTES
+
+This Policy is a replacement for 'ProhibitRequireStatements', which
+completely banned the use of C<require> for the sake of eliminating
+the old '*.pl' libraries from Perl4. Upon further consideration, I
+realized that C<require> is quite useful and necessary to enable
+run-time loading. Thus, 'RequireBarewordIncludes' does allow you to
+use C<require>, but still encourages you to write '*.pm' modules.
+
+Sometimes, you may want to load modules at run-time, but you don't
+know at design-time exactly which module you will need to load
+(L<Perl::Critic> is an example of this). In that case, just attach
+the C<'## no critic'> pseudo-pragma like so:
+
+ require $module_name; ## no critic
+
+
+=head1 CREDITS
+
+Chris Dolan <cdolan@cpan.org> was instrumental in identifying the
+correct motivation for and behavior of this Policy. Thanks Chris.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. All rights reserved.
+
+=head1 COPYRIGHT
+
+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
--- /dev/null
+package Perl::Critic::Policy::Modules::RequireExplicitPackage;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $expl = q{Violates encapsulation};
+my $desc = q{Code not contained in explicit package};
+
+#----------------------------------------------------------------------------
+
+sub new {
+ my ( $class, %args ) = @_;
+ my $self = bless {}, $class;
+ $self->{_tested} = 0;
+
+ #Set config, if defined
+ $self->{_exempt_scripts} =
+ defined $args{exempt_scripts} ? $args{exempt_scripts} : 0;
+
+ return $self;
+}
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ return if $self->{_tested}; # Only do this once!
+ $self->{_tested} = 1;
+
+ # You can configure this policy to exclude scripts
+ return if $self->{_exempt_scripts} && _is_script($doc);
+
+ my $match = $doc->find_first( sub { $_[1]->significant() } ) || return;
+ return
+ if $match->isa('PPI::Statement::Package'); #First statement is 'package'
+ return Perl::Critic::Violation->new( $desc, $expl, $match->location() );
+}
+
+sub _is_script {
+ my $doc = shift;
+ my $first_comment = $doc->find_first('PPI::Token::Comment') || return;
+ $first_comment->location()->[0] == 1 || return;
+ return $first_comment =~ m{ \A \#\! }mx;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::Modules::RequireExplicitPackage
+
+=head1 DESCRIPTION
+
+Conway doesn't specifically mention this, but I've come across it in
+my own work. In general, the first statement of any Perl module or
+library should be a C<package> statement. Otherwise, all the code
+that comes before the C<package> statement is getting executed in the
+caller's package, and you have no idea who that is. Good
+encapsulation and common decency require your module to keep its
+innards to itself.
+
+As for scripts, most people understand that the default package is
+C<main>, but it doesn't hurt to be explicit about it either. But if
+you insist on omitting C<package main;> from your scripts, you can
+configure this policy to overlook any file that looks like a script,
+which is determined by looking for a shebang line at the top of the
+file. To activate this behavior, add the following to your
+F<.perlcriticrc> file
+
+ [Modules::RequireExplicitPackage]
+ exempt_scripts = 1
+
+There are some valid reasons for not having a C<package> statement at
+all. But make sure you understand them before assuming that you
+should do it too.
+
+=head1 IMPORTANT CHANGES
+
+This policy was formerly called "ProhibitUnpackagedCode" which sounded
+a bit odd. If you get lots of "Cannot load policy module" errors,
+then you probably need to change "ProhibitUnpackagedCode" to
+"RequireExplicitPackage" in your F<.perlcriticrc> file.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::Modules::RequireVersionVar;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use List::MoreUtils qw(any);
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{No 'VERSION' variable found};
+my $expl = [ 404 ];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ return if $self->{_tested}; #Only do this once!
+ $self->{_tested} = 1;
+
+ return if $doc->find_first( \&_wanted );
+
+ #If we get here, then no $VERSION was found
+ return Perl::Critic::Violation->new( $desc, $expl, [0,0] );
+}
+
+sub _wanted {
+ return _our_VERSION(@_) || _vars_VERSION(@_) || _package_VERSION(@_);
+}
+
+sub _our_VERSION {
+ my ($doc, $elem) = @_;
+ $elem->isa('PPI::Statement::Variable') || return 0;
+ $elem->type() eq 'our' || return 0;
+ return any { $_ eq '$VERSION' } $elem->variables(); ## no critic
+}
+
+sub _vars_VERSION {
+ my ($doc, $elem) = @_;
+ $elem->isa('PPI::Statement::Include') || return 0;
+ $elem->pragma() eq 'vars' || return 0;
+ return $elem =~ m{ \$VERSION }mx; #Crude, but usually works
+}
+
+sub _package_VERSION {
+ my ($doc, $elem) = @_;
+ $elem->isa('PPI::Token::Symbol') || return 0;
+ return $elem =~ m{ \A \$ \S+ ::VERSION \z }mx;
+ #TODO: ensure that it is in _this_ package!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::Modules::RequireVersionVar
+
+=head1 DESCRIPTION
+
+Every Perl file (modules, libraries, and scripts) should have a
+C<$VERSION> variable. The C<$VERSION> allows clients to insist on a
+particular revision of your file like this:
+
+ use SomeModule 2.4; #Only loads version 2.4
+
+This Policy scans your file for any package variable named
+C<$VERSION>. I'm assuming that you are using C<strict>, so you'll
+have to declare it like one of these:
+
+ our $VERSION = 1.01;
+ $MyPackage::VERSION = 1.01;
+ use vars qw($VERSION);
+
+A common practice is to use the C<$Revision$> keyword to automatically
+define the C<$VERSION> variable like this:
+
+ our ($VERSION) = '$Revision: 1.01 $' =~ m{ \$Revision: \s+ (\S+) }x;
+
+=head1 NOTES
+
+Conway recommends using the C<version> pragma instead of raw numbers
+or 'v-strings.' However, this Policy only insists that the
+C<$VERSION> be defined somehow. I may try to extend this in the
+future.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs;
+
+use strict;
+use warnings;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $mixed_rx = qr/ [A-Z][a-z] | [a-z][A-Z] /x;
+my $desc = 'Mixed-case subroutine name';
+my $expl = [44];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement::Sub') || return;
+ if ( $elem->name() =~ $mixed_rx ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs
+
+=head1 DESCRIPTION
+
+Conway's recommended naming convention is to use lower-case words
+separated by underscores. Well-recognized acronyms can be in ALL
+CAPS, but must be separated by underscores from other parts of the
+name.
+
+ sub foo_bar{} #ok
+ sub foo_BAR{} #ok
+ sub FOO_bar{} #ok
+ sub FOO_BAR{} #ok
+
+ sub FooBar {} #not ok
+ sub FOObar {} #not ok
+ sub fooBAR {} #not ok
+ sub fooBar {} #Not ok
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars;
+
+use strict;
+use warnings;
+use List::MoreUtils qw(any);
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $mixed_rx = qr/ [A-Z][a-z] | [a-z][A-Z] /x;
+my $desc = 'Mixed-case variable name(s)';
+my $expl = [44];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement::Variable') || return;
+ if ( _has_mixed_case_vars($elem) ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+sub _has_mixed_case_vars {
+ my $elem = shift;
+ return any { $_ =~ $mixed_rx } $elem->variables();
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars
+
+=head1 DESCRIPTION
+
+Conway's recommended naming convention is to use lower-case words
+separated by underscores. Well-recognized acronyms can be in ALL
+CAPS, but must be separated by underscores from other parts of the
+name.
+
+ my $foo_bar #ok
+ my $foo_BAR #ok
+ my @FOO_bar #ok
+ my %FOO_BAR #ok
+
+ my $FooBar #not ok
+ my $FOObar #not ok
+ my @fooBAR #not ok
+ my %fooBar #not ok
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting;
+
+use strict;
+use warnings;
+use Perl::Critic::Violation;
+use Perl::Critic::Utils;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Regular expression without '/x' flag};
+my $expl = [ 236 ];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Regexp') || return;
+
+ #Note: as of PPI 1.103, 'modifiers' is not part of the published
+ #API. I'm cheating by accessing it here directly.
+
+ if ( ! defined $elem->{modifiers}->{x} ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting
+
+=head1 DESCRIPTION
+
+Extended regular expression formatting allows you mix whitespace and
+comments into the pattern, thus making them much more readable.
+
+ # Match a single-quoted string efficiently...
+
+ m{'[^\\']*(?:\\.[^\\']*)*'}; #Huh?
+
+ #Same thing with extended format...
+
+ m{ ' #an opening single quote
+ [^\\'] #any non-special chars (i.e. not backslash or single quote)
+ (?: #then all of...
+ \\ . # any explicitly backslashed char
+ [^\\']* # followed by an non-special chars
+ )* #...repeated zero or more times
+ ' # a closing single quote
+ }x;
+
+=head1 NOTES
+
+For common regular expessions like e-mail addresses, phone numbers,
+dates, etc., have a look at the L<Regex::Common> module. Also, be
+cautions about slapping modifier flags onto existing regular
+expressions, as they can drastically alter their meaning. See
+L<http://www.perlmonks.org/?node_id=484238> for an interesting
+discussion on the effects of blindly modifying regular expression
+flags.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching;
+
+use strict;
+use warnings;
+use Perl::Critic::Violation;
+use Perl::Critic::Utils;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Regular expression without '/m' flag};
+my $expl = [ 237 ];
+
+#----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Regexp') || return;
+
+ #Note: as of PPI 1.103, 'modifiers' is not part of the published
+ #API. I'm cheating by accessing it here directly.
+
+ if ( ! defined $elem->{modifiers}->{m} ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching
+
+=head1 DESCRIPTION
+
+Folks coming from a C<sed> or C<awk> background tend to assume that
+C<'$'> and C<'^'> match the beginning and and of the line, rather than
+then beginning and ed of the string. Adding the '/m' flag to your
+regex makes it behave as most people expect it should.
+
+ my $match = m{ ^ $pattern $ }x; #not ok
+ my $match = m{ ^ $pattern $ }xm; #ok
+
+=head1 NOTES
+
+For common regular expessions like e-mail addresses, phone numbers,
+dates, etc., have a look at the L<Regex::Common> module. Also, be
+cautions about slapping modifier flags onto existing regular
+expressions, as they can drastically alter their meaning. See
+L<http://www.perlmonks.org/?node_id=484238> for an interesting
+discussion on the effects of blindly modifying regular expression
+flags.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use List::MoreUtils qw(any);
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my %allow = ( import => 1 );
+my $desc = q{Subroutine name is a homonym for builtin function};
+my $expl = [177];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement::Sub') || return;
+ return if exists $allow{ $elem->name() };
+ if ( any { $elem->name() eq $_ } @BUILTINS ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms
+
+=head1 DESCRIPTION
+
+Common sense dictates that you shouldn't declare subroutines with the
+same name as one of Perl's built-in functions. See C<perldoc perlfunc>
+for a list of built-ins.
+
+ sub open {} #not ok
+ sub exit {} #not ok
+ sub print {} #not ok
+
+ #You get the idea...
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{'return' statement with explicit 'undef'};
+my $expl = [199];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Word') && $elem eq 'return' || return;
+ return if is_hash_key($elem);
+
+ my $sib = $elem->snext_sibling() || return;
+ $sib->isa('PPI::Token::Word') && $sib eq 'undef' || return;
+
+ #Must be 'return undef'
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef
+
+=head1 DESCRIPTION
+
+Returning C<undef> upon failure from a subroutine is pretty common.
+But if the subroutine is called in list context, an explicit C<return
+undef;> statement will return a one-element list containing
+C<(undef)>. Now if that list is subsequently put in a boolean context
+to test for failure, then it evaluates to true. But you probably
+wanted it to be false.
+
+ sub read_file {
+ my $file = shift;
+ -f $file || return undef; #file doesn't exist!
+
+ #Continue reading file...
+ }
+
+ #and later...
+
+ if ( my @data = read_file($filename) ){
+
+ # if $filename doesn't exist,
+ # @data will be (undef),
+ # but I'll still be in here!
+
+ process(@data);
+ }
+ else{
+
+ # This is my error handling code.
+ # I probably want to be in here
+ # if $filname doesn't exist.
+
+ die "$filename not found";
+ }
+
+The solution is to just use a bare C<return> statement whenever you
+want to return failure. In list context, Perl will then give you an
+empty list (which is false), and C<undef> in scalar context (which is
+also false).
+
+ sub read_file {
+ my $file = shift;
+ -f $file || return; #DWIM!
+
+ #Continue reading file...
+ }
+
+=head1 NOTES
+
+You can fool this policy pretty easily by hiding C<undef> in a boolean
+expression. But don't bother trying. In fact, using return values to
+indicate failure is pretty poor technique anyway. Consider using
+C<die> or C<croak> with C<eval>, or the L<Error> module for a much
+more robust exception-handling model. Conway has a real nice
+discussion on error handling in chapter 13 of PBB.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Subroutine prototypes used};
+my $expl = [194];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement::Sub') || return;
+ if ( $elem->prototype() ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes
+
+=head1 DESCRIPTION
+
+Contrary to common belief, subroutine prototypes do not enable
+compile-time checks for proper arguments. Don't use them.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::TestingAndDebugging::RequirePackageStricture;
+
+use strict;
+use warnings;
+use List::Util qw(first);
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Code before strictures are enabled};
+my $expl = [429];
+my $tested = 0;
+
+#---------------------------------------------------------------------------
+
+sub new {
+ my ( $class, %args ) = @_;
+ my $self = bless {}, $class;
+ $self->{_tested} = 0;
+ return $self;
+}
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ return if $self->{_tested}; # Only do this once
+ $self->{_tested} = 1;
+
+ #Find first statement that isn't 'use', 'require', or 'package'
+ my $nodes_ref = $doc->find('PPI::Statement') || return;
+ my $other_stmnt = first {
+ !$_->isa('PPI::Statement::Package')
+ && !$_->isa('PPI::Statement::Include');
+ }
+ @{$nodes_ref};
+
+ #Find the first 'use strict' statement
+ my $strict_stmnt = first {
+ $_->isa('PPI::Statement::Include')
+ && $_->type() eq 'use'
+ && $_->pragma() eq 'strict';
+ }
+ @{$nodes_ref};
+
+ $other_stmnt || return; #Both of these...
+ $strict_stmnt ||= $other_stmnt; #need to be defined
+ my $other_at = $other_stmnt->location()->[0];
+ my $strict_at = $strict_stmnt->location()->[0];
+
+ if ( $other_at <= $strict_at ) {
+ my $loc = $other_stmnt->location();
+ return Perl::Critic::Violation->new( $desc, $expl, $loc );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::TestingAndDebugging::RequirePackageStricture
+
+=head1 DESCRIPTION
+
+Using strictures is probably the single most effective way to improve
+the quality of your code. This policy requires that the C<'use
+strict'> statement must come before any other staments except
+C<package>, C<require>, and other C<use> statements. Thus, all the
+code in the entire package will be affected.
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::TestingAndDebugging::RequirePackageWarnings>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::TestingAndDebugging::RequirePackageWarnings;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use List::Util qw(first);
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Code before warnings are enabled};
+my $expl = [431];
+
+#---------------------------------------------------------------------------
+
+sub new {
+ my ( $class, %args ) = @_;
+ my $self = bless {}, $class;
+ $self->{_tested} = 0;
+ return $self;
+}
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ return if $self->{_tested}; # Only do this once
+ $self->{_tested} = 1;
+
+ #Find first statement that isn't 'use', 'require', or 'package'
+ my $nodes_ref = $doc->find('PPI::Statement') || return;
+ my $other_stmnt = first {
+ !$_->isa('PPI::Statement::Package')
+ && !$_->isa('PPI::Statement::Include');
+ }
+ @{$nodes_ref};
+
+ #Find the first 'use warnings' statement
+ my $strict_stmnt = first {
+ $_->isa('PPI::Statement::Include')
+ && $_->type() eq 'use'
+ && $_->pragma() eq 'warnings';
+ }
+ @{$nodes_ref};
+
+ $other_stmnt || return; #Both of these...
+ $strict_stmnt ||= $other_stmnt; #need to be defined
+ my $other_at = $other_stmnt->location()->[0];
+ my $strict_at = $strict_stmnt->location()->[0];
+
+ if ( $other_at <= $strict_at ) {
+ my $loc = $other_stmnt->location();
+ return Perl::Critic::Violation->new( $desc, $expl, $loc );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::TestingAndDebugging::RequirePackageWarnings
+
+=head1 DESCRIPTION
+
+Using warnings is probably the single most effective way to improve
+the quality of your code. This policy requires that the C<'use
+warnings'> statement must come before any other staments except
+C<package>, C<require>, and other C<use> statements. Thus, all the
+code in the entire package will be affected.
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::TestingAndDebugging::RequirePackageStricture>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Pragma 'constant' used};
+my $expl = [55];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement::Include') || return;
+ if ( $elem->type() eq 'use' && $elem->pragma() eq 'constant' ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma
+
+=head1 DESCRIPTION
+
+Named constants are a good thing. But don't use the C<constant>
+pragma because barewords don't interpolate. Instead use the
+L<Readonly> module.
+
+ use constant FOOBAR => 42; #not ok
+
+ use Readonly;
+ Readonly my $FOOBAR => 42; #ok
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $empty_rx = qr{\A ["|'] \s* ['|"] \z}x;
+my $desc = q{Quotes used with an empty string};
+my $expl = [53];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Quote') || return;
+
+ if ( $elem =~ $empty_rx ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes
+
+=head1 DESCRIPTION
+
+Don't use quotes for an empty string or any string that is pure whitespace.
+Instead, use C<q{}> to improve legibility. Better still, created named values
+like this. Use the C<x> operator to repeat characters.
+
+ $message = ''; #not ok
+ $message = ""; #not ok
+ $message = " "; #not ok
+
+ $message = q{}; #better
+ $message = q{ } #better
+
+ $EMPTY = q{};
+ $message = $EMPTY; #best
+
+ $SPACE = q{ };
+ $message = $SPACE x 5; #best
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyStrings>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+
+package Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Useless interpolation of literal string};
+my $expl = [51];
+
+#---------------------------------------------------------------------------
+
+sub new {
+ my ( $class, %args ) = @_;
+ my $self = bless {}, $class;
+ $self->{_allow} = [];
+
+ #Set configuration, if defined
+ if ( defined $args{allow} ) {
+ my @allow = split m{ \s+ }mx, $args{allow};
+ #Try to be forgiving with the configuration...
+ for (@allow) { m{ \A qq }mx || ($_ = 'qq' . $_) } #Add 'qq'
+ for (@allow) { (length $_ <= 3) || chop } #Chop closing char
+ $self->{_allow} = \@allow;
+ }
+
+ return $self;
+}
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Quote::Double')
+ || $elem->isa('PPI::Token::Quote::Interpolate')
+ || return;
+
+ #Overlook allowed quote styles
+ for my $allowed ( @{ $self->{_allow} } ) {
+ return if $elem =~ m{ \A \Q$allowed\E }mx;
+ }
+
+ if ( !_has_interpolation($elem) ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+sub _has_interpolation {
+ my $elem = shift || return;
+ return $elem =~ m{ (?<!\\) [\$\@] \S+ }mx #Contains unescaped $. or @.
+ || $elem =~ m{ \\[tnrfae0xcNLuLUEQ] }mx; #Containts escaped metachars
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals
+
+=head1 DESCRIPTION
+
+Don't use double-quotes or C<qq//> if your string doesn't require
+interpolation. This saves the interpreter a bit of work and it lets
+the reader know that you really did intend the string to be literal.
+
+ print "foobar"; #not ok
+ print 'foobar'; #ok
+ print qq/foobar/; #not ok
+ print q/foobar/; #ok
+
+ print "$foobar"; #ok
+ print "foobar\n"; #ok
+ print qq/$foobar/; #ok
+ print qq/foobar\n/; #ok
+
+ print qq{$foobar}; #preferred
+ print qq{foobar\n}; #preferred
+
+=head1 CONSTRUCTOR
+
+This Policy accepts an additional key-value pair in the constructor,
+The key is 'allow' and the value is a string of quote styles
+that are exempt from this policy. Valid styles are C<qq{}>, C<qq()>,
+C<qq[]>, and C<qq//>. Multiple styles should be separated by
+whitespace. This is useful because some folks have configured their
+editor to apply special syntax highlighting within certain styles of
+quotes. For example, you can tweak C<vim> to use SQL highlighting for
+everything that appears within C<qq{}> or C<qq[]> quotes. But if
+those strings are literal, Perl::Critic will complain. To prevent
+this, put the following in your F<.perlcriticrc> file:
+
+ [ValuesAndExpressions::ProhibitInterpolationOfLiterals]
+ allow = qq{} qq[]
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $leading_rx = qr{\A -? 0+ \d+ \z }x;
+my $desc = q{Integer with leading zeros};
+my $expl = [55];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Number') || return;
+ if ( $elem =~ $leading_rx ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros
+
+=head1 DESCRIPTION
+
+Perl interprets numbers with leading zeros as octal. If that's what
+you really want, its better to use C<oct> and make it obvious.
+
+ $var = 041; #not ok, actually 33
+ $var = oct(41); #ok
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $noise_rx = qr{\A ["|'] [^ \w () {} [\] <> ]{1,2} ['|"] \z}x;
+my $desc = q{Quotes used with a noisy string};
+my $expl = [53];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Quote::Double')
+ || $elem->isa('PPI::Token::Quote::Single')
+ || return;
+
+ if ( $elem =~ $noise_rx ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes
+
+=head1 DESCRIPTION
+
+Don't use quotes for one or two-character strings of non-alphanumeric
+characters (i.e. noise). These tend to be hard to read. For
+legibility, use C<q{}> or a named value. However, braces, parens, and
+brackets tend do to look better in quotes, so those are allowed.
+
+ $str = join ',', @list; #not ok
+ $str = join ",", @list; #not ok
+ $str = join q{,}, @list; #better
+
+ $COMMA = q{,};
+ $str = join $COMMA, @list; #best
+
+ $lbrace = '('; #ok
+ $rbrace = ')'; #ok
+ print '(', @list, ')'; #ok
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{String *may* require interpolation};
+my $expl = [51];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Quote::Single')
+ || $elem->isa('PPI::Token::Quote::Literal')
+ || return;
+
+ if ( _has_interpolation($elem) ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok;
+}
+
+sub _has_interpolation {
+ my $elem = shift || return;
+ return $elem =~ m{ (?<!\\) [\$\@] \S+ }mx #Contains unescaped $. or @.
+ || $elem =~ m{ \\[tnrfae0xcNLuLUEQ] }mx; #Containts escaped metachars
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars
+
+=head1 DESCRIPTION
+
+This policy warns you if you use single-quotes or C<q//> with a string
+that has unescaped metacharacters that may need interpoation. Its hard
+to know for sure if a string really should be interpolated without
+looking into the symbol table. This policy just makes an educated
+guess by looking for metachars and sigils which usually indicate that
+the string should be interpolated.
+
+=head1 NOTES
+
+Perl's own C<warnings> pragma also warns you about this.
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Long number not separated with underscores};
+my $expl = [55];
+
+#---------------------------------------------------------------------------
+
+sub new {
+ my ( $class, %args ) = @_;
+ my $self = bless {}, $class;
+
+ #Set configuration, if defined
+ $self->{_min} = defined $args{min_value} ? $args{min_value} : 10_000;
+
+ return $self;
+}
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Number') || return;
+ my $min = $self->{_min};
+
+ if ( abs _to_number($elem) >= $min && $elem =~ m{ \d{4,} }mx ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+sub _to_number {
+ my $elem = shift;
+ my $value = "$elem";
+ return eval $value; ## no critic
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators
+
+=head1 DESCRIPTION
+
+Long numbers are be hard to read. To improve legibility, Perl allows
+numbers to be split into groups of digits separated by underscores.
+This policy requires numbers sequences of more than three digits to be
+separated.
+
+ $long_int = 123456789; #not ok
+ $long_int = 123_456_789; #ok
+
+ $long_float = 12345678.001; #not ok
+ $long_float = 12_345_678.001; #ok
+
+=head1 CONSTRUCTOR
+
+This Policy accepts an additional key-value pair in the C<new> method.
+The key is 'min_value' and the value is the minimum absolute value of
+numbers that must be separated. The default is 10,000. Thus, all
+numbers >= 10,000 and <= -10,000 must be separated. Users of the
+Perl::Critic engine can configure this in their F<.perlcriticrc> like
+this:
+
+ [ValuesAndExpressions::RequireNumberSeparators]
+ min_value = 100000 #That's one-hundred-thousand!
+
+=head1 NOTES
+
+As it is currently written, this policy only works properly with
+decimal (base 10) numbers. And it is obviouly biased toward Western
+notation. I'll try and address those issues in the future.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $heredoc_rx = qr/ \A << ["|'] .* ['|"] \z /x;
+my $desc = q{Heredoc terminator must be quoted};
+my $expl = [62];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::HereDoc') || return;
+
+ if ( $elem !~ $heredoc_rx ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator
+
+=head1 DESCRIPTION
+
+Putting single or double-quotes around your HEREDOC terminator make it obvious
+to the reader whether the content is going to be interpolated or not.
+
+ print <<END_MESSAGE; #not ok
+ Hello World
+ END_MESSAGE
+
+ print <<'END_MESSAGE'; #ok
+ Hello World
+ END_MESSAGE
+
+ print <<"END_MESSAGE"; #ok
+ $greeting
+ END_MESSAGE
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $heredoc_rx = qr{ \A << ["|']? [A-Z_]+ ['|"]? \z }x;
+my $desc = q{Heredoc terminator must be in upper case};
+my $expl = [64];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::HereDoc') || return;
+
+ if ( $elem !~ $heredoc_rx ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator
+
+=head1 DESCRIPTION
+
+For legibility, HEREDOC terminators should be all UPPER CASE letters, without
+any whitespace. Conway also recommends using a standard prefix like "END_"
+but this policy doesn't enforce that.
+
+ print <<'the End'; #not ok
+ Hello World
+ the End
+
+ print <<'THE_END'; #ok
+ Hello World
+ THE_END
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::Variables::ProhibitLocalVars;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use List::MoreUtils qw(none);
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Variable declared as 'local'};
+my $expl = [ 77, 78, 79 ];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Statement::Variable') || return;
+ if ( $elem->type() eq 'local' && !_all_global_vars($elem) ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+sub _all_global_vars {
+
+ my $elem = shift;
+ for my $var ( $elem->variables() ) {
+ return if none { $var =~ m{ \A [\$@%] $_ }mx } @GLOBALS;
+ }
+ return 1;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::Variables::ProhibitLocalVars
+
+=head1 DESCRIPTION
+
+Since Perl 5, there are very few reasons to declare C<local>
+variables. The only reasonable exceptions are Perl's magical global
+variables. If you do need to modify one of those global variables,
+you should localize it first. You should also use the L<English>
+module to give those variables more meaningful names.
+
+ local $foo; #not ok
+ my $foo; #ok
+
+ use English qw(-no_match_vars);
+ local $INPUT_RECORD_SEPARATOR #ok
+ local $RS #ok
+ local $/; #not ok
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::Variables::ProhibitPunctuationVars>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+package Perl::Critic::Policy::Variables::ProhibitPackageVars;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use List::MoreUtils qw(all);
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Package variable declared or used};
+my $expl = [ 73, 75 ];
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+
+ if ( _is_package_var($elem)
+ || _is_our_var($elem)
+ || _is_vars_pragma($elem) )
+ {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+sub _is_package_var {
+ my $elem = shift;
+ $elem->isa('PPI::Token::Symbol') || return;
+ return $elem =~ m{ \A [@\$%] .* :: }mx && $elem !~ m{ :: [A-Z0-9_]+ \z }mx;
+}
+
+sub _is_our_var {
+ my $elem = shift;
+ $elem->isa('PPI::Statement::Variable') || return;
+ return $elem->type() eq 'our' && !_all_upcase( $elem->variables() );
+}
+
+sub _is_vars_pragma {
+ my $elem = shift;
+ $elem->isa('PPI::Statement::Include') || return;
+ return $elem->pragma() eq 'vars';
+}
+
+sub _all_upcase {
+ return all { $_ eq uc $_ } @_;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::Variables::ProhibitPackageVars
+
+=head1 DESCRIPTION
+
+Conway suggests avoiding package variables completely, because they
+expose your internals to other packages. Never use a package variable
+when a lexical variable will suffice. If your package needs to keep
+some dynamic state, consider using an object or closures to keep the
+state private.
+
+This policy assumes that you're using C<strict vars> so that naked
+variable declarations are not package variables by default. Thus, it
+complains you declare a variable with C<our> or C<use vars>, or if you
+make reference to variable with a fully-qualified package name.
+
+ $Some::Package::foo = 1; #not ok
+ our $foo = 1; #not ok
+ use vars '$foo'; #not ok
+ $foo = 1; #not allowed by 'strict'
+ local $foo = 1; #bad taste, but ok.
+ my $foo = 1; #ok
+
+In practice though, its not really practical prohibit all package
+variables. Common variables like C<$VERSION> and C<@EXPORT> need to
+be global, as do any variables that you want to Export. To work
+around this, the Policy overlooks any variables that are in ALL_CAPS.
+This forces you to put all your expored variables in ALL_CAPS too, which
+seems to be the usual practice anyway.
+
+=head1 BUGS
+
+The exemption for ALL_CAPS variables doesn't work with the C<use vars>
+pragma. I'll fix this at some point.
+
+=head1 SEE ALSO
+
+L<Perl::Critic::Policy::Variables::ProhibitPunctuationVars>
+
+L<Perl::Critic::Policy::Variables::ProhibitLocalVars>
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Policy::Variables::ProhibitPunctuationVars;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+my $desc = q{Magic punctuation variable used};
+my $expl = [79];
+
+## no critic
+my %exempt = ( '$_' => 1, '@_' => 1 ); #Can't live without these
+for ( 1 .. 9 ) { $exempt{"\$$_"} = 1 } #These are used with regex
+$exempt{'_'} = 1; #This is used with 'stat'
+## use critic
+
+#---------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, $doc ) = @_;
+ $elem->isa('PPI::Token::Magic') || return;
+
+ if ( !exists $exempt{$elem} ) {
+ return Perl::Critic::Violation->new( $desc, $expl, $elem->location() );
+ }
+ return; #ok!
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::Variables::ProhibitPunctuationVars
+
+=head1 DESCRIPTION
+
+Perl's vocabulary of punctuation variables such as C<$!>, C<$.>, and
+C<$^> are perhaps the leading cause of its repuation as inscrutable
+line noise. The simple alternative is to use the L<English> module to
+give them clear names.
+
+ $| = undef; #not ok
+
+ use English qw(-no_match_vars);
+ local $OUTPUT_AUTOFLUSH = undef; #ok
+
+=head1 NOTES
+
+The scratch variables C<$_> and C<@_> are very common and have no
+equivalent name in L<English>, so they are exempt from this policy.
+All the $n variables associated with regex captures are exempt too.
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Utils;
+
+use strict;
+use warnings;
+use base 'Exporter';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+#-------------------------------------------------------------------
+# Exported symbols here
+
+our @EXPORT =
+ qw(@BUILTINS @GLOBALS $TRUE
+ $COMMA $DQUOTE $FALSE
+ $COLON $PERIOD &find_keywords
+ $SCOLON $PIPE &is_hash_key
+ $QUOTE $EMPTY &is_method_call
+ $SPACE &parse_arg_list
+);
+
+#---------------------------------------------------------------------------
+
+our $COMMA = q{,};
+our $COLON = q{:};
+our $SCOLON = q{;};
+our $QUOTE = q{'};
+our $DQUOTE = q{"};
+our $PERIOD = q{.};
+our $PIPE = q{|};
+our $SPACE = q{ };
+our $EMPTY = q{};
+our $TRUE = 1;
+our $FALSE = 0;
+
+#---------------------------------------------------------------------------
+our @BUILTINS =
+ qw(abs exp int readdir socket wantarray
+ accept fcntl ioctl readline socketpair warn
+ alarm fileno join readlink sort write
+ atan2 flock keys readpipe splice
+ bind fork kill recv split
+ binmode format last redo sprintf
+ bless formline lc ref sqrt
+ caller getc lcfirst rename srand
+ chdir getgrent length require stat
+ chmod getgrgid link reset study
+ chomp getgrnam listen return sub
+ chop gethostbyaddr local reverse substr
+ chown gethostbyname localtime rewinddir symlink
+ chr gethostent log rindex syscall
+ chroot getlogin lstat rmdir sysopen
+ close getnetbyaddr map scalar sysread
+ closedir getnetbyname mkdir seek sysseek
+ connect getnetent msgctl seekdir system
+ continue getpeername msgget select syswrite
+ cos getpgrp msgrcv semctl tell
+ crypt getppid msgsnd semget telldir
+ dbmclose getpriority next semop tie
+ dbmopen getprotobyname no send tied
+ defined getprotobynumber oct setgrent time
+ delete getprotoent open sethostent times
+ die getpwent opendir setnetent truncate
+ do getpwnam ord setpgrp uc
+ dump getpwuid our setpriority ucfirst
+ each getservbyname pack setprotoent umask
+ endgrent getservbyport package setpwent undef
+ endhostent getservent pipe setservent unlink
+ endnetent getsockname pop setsockopt unpack
+ endprotoent getsockopt pos shift unshift
+ endpwent glob print shmctl untie
+ endservent gmtime printf shmget use
+ eof goto prototype shmread utime
+ eval grep push shmwrite values
+ exec hex quotemeta shutdown vec
+ exists import rand sin wait
+ exit index read sleep waitpid
+);
+
+#---------------------------------------------------------------------------
+
+our @GLOBALS =
+ qw(ACCUMULATOR INPLACE_EDIT
+ BASETIME INPUT_LINE_NUMBER NR
+ CHILD_ERROR INPUT_RECORD_SEPARATOR RS
+ COMPILING LAST_MATCH_END
+ DEBUGGING LAST_REGEXP_CODE_RESULT
+ EFFECTIVE_GROUP_ID EGID LIST_SEPARATOR
+ EFFECTIVE_USER_ID EUID OS_ERROR
+ ENV OSNAME
+ EVAL_ERROR OUTPUT_AUTOFLUSH
+ ERRNO OUTPUT_FIELD_SEPARATOR OFS
+ EXCEPTIONS_BEING_CAUGHT OUTPUT_RECORD_SEPARATOR ORS
+ EXECUTABLE_NAME PERL_VERSION
+ EXTENDED_OS_ERROR PROGRAM_NAME
+ FORMAT_FORMFEED REAL_GROUP_ID GID
+ FORMAT_LINE_BREAK_CHARACTERS REAL_USER_ID UID
+ FORMAT_LINES_LEFT SIG
+ FORMAT_LINES_PER_PAGE SUBSCRIPT_SEPARATOR SUBSEP
+ FORMAT_NAME SYSTEM_FD_MAX
+ FORMAT_PAGE_NUMBER WARNING
+ FORMAT_TOP_NAME PERLDB
+ INC ARGV
+);
+
+#-------------------------------------------------------------------------
+
+sub find_keywords {
+ my ( $doc, $keyword ) = @_;
+ my $nodes_ref = $doc->find('PPI::Token::Word') || return;
+ my @matches = grep { $_ eq $keyword } @{$nodes_ref};
+ return @matches ? \@matches : undef;
+}
+
+sub is_hash_key {
+ my $elem = shift;
+
+ #Check curly-brace style: $hash{foo} = bar;
+ my $parent = $elem->parent() || return;
+ my $grandparent = $parent->parent() || return;
+ return 1 if $grandparent->isa('PPI::Structure::Subscript');
+
+
+ #Check declarative style: %hash = (foo => bar);
+ my $sib = $elem->snext_sibling() || return;
+ return 1 if $sib->isa('PPI::Token::Operator') && $sib eq '=>';
+
+ return 0;
+}
+
+sub is_method_call {
+ my $elem = shift;
+ my $sib = $elem->sprevious_sibling() || return;
+ return $sib->isa('PPI::Token::Operator') && $sib eq q{->};
+}
+
+sub parse_arg_list {
+ my $elem = shift;
+ my $sib = $elem->snext_sibling() || return;
+
+ if ( $sib->isa('PPI::Structure::List') ) {
+
+ #Pull siblings from list
+ my $expr = $sib->schild(0) || return;
+ return _split_nodes_on_comma( $expr->schildren() );
+ }
+ else {
+
+ #Gather up remaining nodes in the statement
+ my $iter = $elem;
+ my @arg_list = ();
+
+ while ($iter = $iter->snext_sibling() ) {
+ last if $iter->isa('PPI::Token::Structure') and $iter eq $SCOLON;
+ push @arg_list, $iter;
+ }
+ return _split_nodes_on_comma( @arg_list );
+ }
+}
+
+sub _split_nodes_on_comma {
+ my @nodes = ();
+ my $i = 0;
+ for my $node (@_) {
+ if ( $node->isa('PPI::Token::Operator') && $node eq $COMMA ) {
+ $i++; #Move forward to next 'node stack'
+ next;
+ }
+
+ #Push onto current 'node stack', or create a new 'stack'
+ if ( defined $nodes[$i] ) {
+ push @{ $nodes[$i] }, $node;
+ }
+ else {
+ $nodes[$i] = [$node];
+ }
+ }
+ return @nodes;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Utils - Utility subs and vars for Perl::Critic
+
+=head1 DESCRIPTION
+
+This module has exports several static subs and variables that are
+useful for developing L<Perl::Critic::Policy> subclasses. Unless you
+are writing Policy modules, you probably don't care about this
+package.
+
+=head1 EXPORTED SUBS
+
+=over 8
+
+=item find_keywords( $doc, $keyword );
+
+B<This function is deprecated!> Since version 0.11, every Policy is
+evaluated at each element of the document. So you shouldn't need to
+go looking for a particular keyword. I've left this function in place
+just in case you come across a particular need for it.
+
+Given L<PPI::Document> as C<$doc>, returns a reference to an array
+containing all the L<PPI::Token::Word> elements that match
+C<$keyword>. This can be used to find any built-in function, method
+call, bareword, or reserved keyword. It will not match variables,
+subroutine names, literal strings, numbers, or symbols. If the
+document doesn't contain any matches, returns undef.
+
+=item is_hash_key( $element )
+
+Given a L<PPI::Element>, returns true if the element is a hash key.
+PPI doesn't distinguish between regular barewords (like keywords or
+subroutine calls) and barewords in hash subscripts (which are
+considered literal). So this subroutine is useful if your Policy is
+searching for L<PPI::Token::Word> elements and you want to filter out
+the hash subscript variety. In both of the following examples, 'foo'
+is considered a hash key:
+
+ $hash1{foo} = 1;
+ %hash2 = (foo => 1);
+
+=item is_method_call( $element )
+
+Given a L<PPI::Element> that is presumed to be a function call (which
+is usually a L<PPI::Token::Word>, returns true if the function is a
+method being called on some reference. Baically, it just looks to see
+if the preceding operator is "->". This is usefull for distinguishing
+static from object methods.
+
+=item parse_arg_list( $element )
+
+Given a L<PPI::Element> that is presumed to be a function call (which
+is usually a L<PPI::Token::Word>), splits the argument expressions
+into arrays of tokens. Returns a list containing references to each
+of those arrays. This is useful because parens are optional when
+calling a function, and PPI parses them very differently. So this
+method is a poor-man's parse tree of PPI nodes. It's not bullet-proof
+because it doesn't respect precedence. In general, I don't like the
+way this function works, so don't count on it to be stable (or even
+present).
+
+=back
+
+=head1 EXPORTED VARIABLES
+
+=over 8
+
+=item @BUILTINS
+
+This is a list of all the built-in functions provided by Perl 5.8. I
+imagine this is useful for distinguishing native and non-native
+function calls. In the future, I'm thinking of adding a hash that
+maps each built-in function to the maximal number of arguments that it
+accepts. I think this will help facilitate the lexing the children of
+L<PPI::Expression> objects.
+
+=item @GLOBALS
+
+This is a list of all the magic global variables provided by the
+L<English> module. Also includes commonly-used global like C<%SIG>,
+C<%ENV>, and C<@ARGV>. The list contains only the variable name,
+without the sigil.
+
+=item $COMMA
+
+=item $COLON
+
+=item $SCOLON
+
+=item $QUOTE
+
+=item $DQUOTE
+
+=item $PERIOD
+
+=item $PIPE
+
+=item $EMPTY
+
+These give clear names to commonly-used strings that can be hard to
+read when surrounded by quotes.
+
+=item $TRUE
+
+=item $FALSE
+
+These are simple booleans. 1 and 0 respectively. Be mindful of using these
+with string equality. $FALSE ne $EMPTY.
+
+=back
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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.
--- /dev/null
+package Perl::Critic::Violation;
+
+use strict;
+use warnings;
+use Carp;
+use IO::String;
+use Pod::PlainText;
+use Perl::Critic::Utils;
+use String::Format qw(stringf);
+use English qw(-no_match_vars);
+use overload q{""} => 'to_string';
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## no critic
+
+#Class variables...
+our $FORMAT = "%m at line %l, column %c. %e.\n"; #Default stringy format
+our %DIAGNOSTICS = (); #Cache of diagnositc messages
+
+#----------------------------------------------------------------------------
+
+sub import {
+
+ my $caller = caller;
+ return if exists $DIAGNOSTICS{$caller};
+
+ if ( my $file = _mod2file($caller) ) {
+ if ( my $diags = _get_diagnostics($file) ) {
+ $DIAGNOSTICS{$caller} = $diags;
+ return; #ok!
+ }
+ }
+
+ #If we get here, then we couldn't get diagnostics
+ my $no_diags = " No diagnostics available\n";
+ $DIAGNOSTICS{$caller} = $no_diags;
+
+ return; #ok!
+}
+
+
+sub new {
+
+ #Check arguments to help out developers who might
+ #be creating new Perl::Critic::Policy modules.
+
+ if ( @_ != 4 ) {
+ my $msg = 'Wrong number of args to Violation->new()';
+ croak $msg;
+ }
+
+ if ( ref $_[3] ne 'ARRAY' ) {
+ my $msg = '3rd arg to Violation->new() must be ARRAY ref';
+ croak $msg;
+ }
+
+ #Create object
+ my ( $class, $desc, $expl, $loc ) = @_;
+ my $self = bless {}, $class;
+ $self->{_description} = $desc;
+ $self->{_explanation} = $expl;
+ $self->{_location} = $loc;
+ $self->{_policy} = caller;
+
+ return $self;
+}
+
+#---------------------------
+
+sub location {
+ my $self = shift;
+ return $self->{_location};
+}
+
+#---------------------------
+
+sub diagnostics {
+ my $self = shift;
+ my $pol = $self->policy();
+ return $DIAGNOSTICS{$pol};
+}
+
+#---------------------------
+
+sub description {
+ my $self = shift;
+ return $self->{_description};
+}
+
+#---------------------------
+
+sub explanation {
+ my $self = shift;
+ my $expl = $self->{_explanation};
+ if( ref $expl eq 'ARRAY' ) {
+ my $page = @{$expl} > 1 ? 'pages' : 'page';
+ $page .= $SPACE . join $COMMA, @{$expl};
+ $expl = "See $page of PBP";
+ }
+ return $expl;
+}
+
+#---------------------------
+
+sub policy {
+ my $self = shift;
+ return $self->{_policy};
+}
+
+#---------------------------
+
+sub to_string {
+ my $self = shift;
+ my %fspec = ( l => $self->location->[0], c => $self->location->[1],
+ m => $self->description(), e => $self->explanation(),
+ p => $self->policy(), d => $self->diagnostics(),
+ );
+ return stringf($FORMAT, %fspec);
+}
+
+#---------------------------
+
+sub _mod2file {
+ my $module = shift;
+ $module =~ s{::}{/}mxg;
+ $module .= '.pm';
+ return $INC{$module} || $EMPTY;
+}
+
+#---------------------------
+
+sub _get_diagnostics {
+
+ my $file = shift;
+
+ # Extract POD out to a filehandle
+ my $handle = IO::String->new();
+ my $parser = Pod::PlainText->new();
+ $parser->select('DESCRIPTION');
+ $parser->parse_from_file($file, $handle);
+
+ # Slurp POD back in
+ $handle->pos(0); #Rewind to the beginning.
+ <$handle>; #Throw away header
+ return do { local $RS = undef; <$handle> }; #Slurp in the rest
+}
+
+1;
+
+#----------------------------------------------------------------------------
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Violation - Represents policy violations
+
+=head1 SYNOPSIS
+
+ use PPI;
+ use Perl::Critic::Violation;
+
+ my $loc = $node->location(); #$node is a PPI::Node object
+ my $desc = 'Offending code'; #Describe the violation
+ my $expl = [1,45,67]; #Page numbers from PBB
+ my $vio = Perl::Critic::Violation->new($desc, $expl, $loc);
+
+=head1 DESCRIPTION
+
+Perl::Critic::Violation is the generic represntation of an individual
+Policy violation. Its primary purpose is to provide an abstraction
+layer so that clients of L<Perl::Critic> don't have to know anything
+about L<PPI>. The C<violations> method of all L<Perl::Critic::Policy>
+subclasses must return a list of these Perl::Critic::Violation
+objects.
+
+=head1 CONSTRUCTOR
+
+=over 8
+
+=item new( $description, $explanation, $location )
+
+Retruns 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
+PBB (as an ARRAY ref), and the location of the violation (as an ARRAY
+ref). The C<$location> must have two elements, representing the line
+and column number, in that order.
+
+=back
+
+=head1 METHODS
+
+=over 8
+
+=item description ( void )
+
+Returns a brief description of the policy that has been volated as a string.
+
+=item explanation( void )
+
+Returns the explanation for this policy as a string or as reference to
+an array of page numbers in PBB.
+
+=item location( void )
+
+Returns a two-element list containing the line and column number where the
+violation occurred.
+
+=item diagnostics( void )
+
+This feature is experimental. Returns a formatted string containing a
+full discussion of the motivation, and details of the Policy module
+that created this Violation. This information is automatically
+extracted from the DESCRIPTION section of the Policy module's POD.
+
+=item policy( void )
+
+Returns the name of the Perl::Critic::Policy module that created this Violation.
+
+=item to_string( void )
+
+Returns a string repesentation of this violation. The content of the
+string depends on the current value of the C<$FORMAT> package
+variable. See C<"OVERLOADS"> for the details.
+
+=back
+
+=head1 FIELDS
+
+=over 8
+
+=item $Perl::Critic::Violation::FORMAT
+
+Sets the format for all Violation objects when they are evaluated in
+string context. The default is C<'%d at line %l, column %c. %e'>.
+See L<"OVERLOADS"> for formatting options. If you want to change
+C<$FORMAT>, you should localize it first.
+
+=back
+
+=head1 OVERLOADS
+
+Perl::Critic::Violation overloads the "" operator to produce neat
+little messages when evaluated in string context. The format
+depends on the current value of the C<$FORMAT> package variable.
+
+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>. Valid escape characters are:
+
+ Escape Meaning
+ ------- -------------------------------------------------------
+ %m Brief description of the violation
+ %l Line number where the violation occured
+ %c Column number where the violation occured
+ %e Explanation of violation or page numbers in PBP
+ %d Full diagnostic discussion of the violation
+ %p Name of the Policy module that created the violation
+
+Here are some examples:
+
+ $Perl::Critic::Violation::FORMAT = "%m at line %l, column %c.\n";
+ #looks like "Mixed case variable name at line 6, column 23."
+
+ $Perl::Critic::Violation::FORMAT = "%l:%c:%p\n";
+ #looks like "6:23:NamingConventions::ProhibitMixedCaseVars"
+
+ $Perl::Critic::Violation::FORMAT = "%m at line %l. %e. \n%d\n";
+ #looks like "Mixed case variable name at line 6. See page 44 of PBP.
+ Conway's recommended naming convention is to use lower-case words
+ separated by underscores. Well-recognized acronyms can be in ALL
+ CAPS, but must be separated by underscores from other parts of the
+ name."
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Jeffrey Ryan Thalhammer. 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
--- /dev/null
+use blib;
+use strict;
+use warnings;
+use Test::More tests => 254;
+use English qw(-no_match_vars);
+
+our $VERSION = '0.13';
+$VERSION = eval $VERSION; ## pc:skip
+
+my $obj = undef;
+
+#---------------------------------------------------------------
+
+use_ok('Perl::Critic');
+can_ok('Perl::Critic', 'new');
+can_ok('Perl::Critic', 'add_policy');
+can_ok('Perl::Critic', 'critique');
+
+#Set -profile to avoid messing with .perlcriticrc
+$obj = Perl::Critic->new( -profile => 'NONE' );
+isa_ok($obj, 'Perl::Critic');
+is($obj->VERSION(), $VERSION);
+
+#---------------------------------------------------------------
+
+use_ok('Perl::Critic::Config');
+can_ok('Perl::Critic::Config', 'new');
+can_ok('Perl::Critic::Config', 'find_profile_path');
+can_ok('Perl::Critic::Config', 'default_policies');
+can_ok('Perl::Critic::Config', 'optional_policies');
+can_ok('Perl::Critic::Config', 'all_policies');
+can_ok('Perl::Critic::Config', 'pbp_policies');
+
+#Set -profile to avoid messing with .perlcriticrc
+$obj = Perl::Critic::Config->new( -profile => 'NONE');
+isa_ok($obj, 'Perl::Critic::Config');
+is($obj->VERSION(), $VERSION);
+
+#---------------------------------------------------------------
+
+use_ok('Perl::Critic::Policy');
+can_ok('Perl::Critic::Policy', 'new');
+can_ok('Perl::Critic::Policy', 'violates');
+
+$obj = Perl::Critic::Policy->new();
+isa_ok($obj, 'Perl::Critic::Policy');
+is($obj->VERSION(), $VERSION);
+
+#---------------------------------------------------------------
+
+use_ok('Perl::Critic::Violation');
+can_ok('Perl::Critic::Violation', 'new');
+can_ok('Perl::Critic::Violation', 'explanation');
+can_ok('Perl::Critic::Violation', 'description');
+can_ok('Perl::Critic::Violation', 'location');
+can_ok('Perl::Critic::Violation', 'policy');
+can_ok('Perl::Critic::Violation', 'to_string');
+
+$obj = Perl::Critic::Violation->new(undef, undef, []);
+isa_ok($obj, 'Perl::Critic::Violation');
+is($obj->VERSION(), $VERSION);
+
+#---------------------------------------------------------------
+
+for my $mod ( Perl::Critic::Config::default_policies() ) {
+
+ $mod = "Perl::Critic::Policy::$mod";
+
+ use_ok($mod);
+ can_ok($mod, 'new');
+ can_ok($mod, 'violates');
+
+ $obj = $mod->new();
+ isa_ok($obj, 'Perl::Critic::Policy');
+ is($obj->VERSION(), $VERSION, "Version of $mod");
+}
+
--- /dev/null
+use blib;
+use strict;
+use warnings;
+use Test::More tests => 18;
+use List::MoreUtils qw(all none);
+use Perl::Critic;
+
+my $c = undef;
+my $samples_dir = "t/samples";
+my $config_none = "$samples_dir/perlcriticrc.none";
+my $config_all = "$samples_dir/perlcriticrc.all";
+my $config_levels = "$samples_dir/perlcriticrc.levels";
+my @default_policies = Perl::Critic::Config::default_policies();
+my $total_policies = scalar @default_policies;
+
+#--------------------------------------------------------------
+# Test all-off config
+$c = Perl::Critic->new( -profile => $config_none);
+is(scalar @{$c->policies}, 0);
+
+#--------------------------------------------------------------
+# Test all-off config w/ priorities
+$c = Perl::Critic->new( -profile => $config_none, -priority => 2);
+is(scalar @{$c->policies}, 0);
+
+#--------------------------------------------------------------
+# Test all-on config
+$c = Perl::Critic->new( -profile => $config_all);
+is(scalar @{$c->policies}, $total_policies);
+
+#--------------------------------------------------------------
+# Test all-on config w/ priorities
+$c = Perl::Critic->new( -profile => $config_all, -priority => 2);
+is(scalar @{$c->policies}, $total_policies);
+
+#--------------------------------------------------------------
+# Test config w/ multiple priority levels
+$c = Perl::Critic->new( -profile => $config_levels, -priority => 1);
+is(scalar @{$c->policies}, 3);
+
+$c = Perl::Critic->new( -profile => $config_levels, -priority => 2);
+is(scalar @{$c->policies}, 4);
+
+$c = Perl::Critic->new( -profile => $config_levels, -priority => 3);
+is(scalar @{$c->policies}, 6);
+
+$c = Perl::Critic->new( -profile => $config_levels, -priority => 4);
+is(scalar @{$c->policies}, 7);
+
+$c = Perl::Critic->new( -profile => $config_levels, -priority => 5);
+is(scalar @{$c->policies}, 11);
+
+$c = Perl::Critic->new( -profile => $config_levels, -priority => 99);
+is(scalar @{$c->policies}, $total_policies);
+
+#--------------------------------------------------------------
+# Test config as hash
+my %config_hash = (
+ '-NamingConventions::ProhibitMixedCaseVars' => {},
+ '-NamingConventions::ProhibitMixedCaseSubs' => {},
+ 'Miscellanea::RequireRcsKeywords' => {keywords => 'Revision'},
+);
+
+$c = Perl::Critic->new( -profile => \%config_hash );
+is(scalar @{$c->policies}, $total_policies - 1);
+
+#--------------------------------------------------------------
+# Test config as hash
+my @config_array = (
+ q{ [-NamingConventions::ProhibitMixedCaseVars] },
+ q{ [-NamingConventions::ProhibitMixedCaseSubs] },
+ q{ [Miscellanea::RequireRcsKeywords] },
+ q{ keywords = Revision },
+);
+
+$c = Perl::Critic->new( -profile => \@config_array );
+is(scalar @{$c->policies}, $total_policies - 1);
+
+#--------------------------------------------------------------
+# Test config as string
+my $config_string = <<'END_CONFIG';
+
+[-NamingConventions::ProhibitMixedCaseVars]
+[-NamingConventions::ProhibitMixedCaseSubs]
+[Miscellanea::RequireRcsKeywords]
+keywords = Revision
+
+END_CONFIG
+
+$c = Perl::Critic->new( -profile => \$config_string );
+is(scalar @{$c->policies}, $total_policies - 1);
+
+#--------------------------------------------------------------
+# Test default config. If the user already has an existing
+# perlcriticrc file, it will get in the way of this test.
+# This little tweak to Perl::Critic::Config ensures that we
+# don't find the perlcriticrc file.
+
+{
+ no warnings 'redefine';
+ *Perl::Critic::Config::find_profile_path = sub { return };
+}
+
+$c = Perl::Critic->new();
+is(scalar @{$c->policies}, $total_policies);
+
+$c = Perl::Critic->new( -priority => 2);
+is(scalar @{$c->policies}, $total_policies);
+
+#--------------------------------------------------------------
+#Test pattern matching
+
+my (@in, @ex) = ();
+my $pols = [];
+my $matches = 0;
+
+@in = qw(modules vars Regular); #Some assorted pattterns
+$pols = Perl::Critic->new( -include => \@in )->policies();
+$matches = grep { my $pol = ref $_; grep { $pol =~ /$_/imx} @in } @{ $pols };
+is(scalar @{$pols}, $matches);
+
+@ex = qw(quote mixed VALUES); #Some assorted pattterns
+$pols = Perl::Critic->new( -exclude => \@ex )->policies();
+$matches = grep { my $pol = ref $_; grep { $pol !~ /$_/imx} @ex } @{ $pols };
+is(scalar @{$pols}, $matches);
+
+@in = qw(builtin); #Include BuiltinFunctions::*
+@ex = qw(block); #Exclude RequireBlockGrep, RequireBlockMap
+$pols = Perl::Critic->new( -include => \@in, -exclude => \@ex )->policies();
+ok( none {ref $_ =~ /block/imx} @{$pols} && all {ref $_ =~ /builtin/imx} @{$pols} );
+
+
+
+
+
+
+
+
+
+
+
--- /dev/null
+#use blib;
+use strict;
+use warnings;
+use Test::More tests => 149;
+use Perl::Critic::Config;
+use Perl::Critic;
+
+my $code = undef;
+my $policy = undef;
+my %config = ();
+
+#---------------------------------------------------------------
+# If the user already has an existing perlcriticrc file, it will
+# get in the way of these test. This little tweak to ensures
+# that we don't find the perlcriticrc file.
+
+{
+ no warnings 'redefine';
+ *Perl::Critic::Config::find_profile_path = sub { return };
+}
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+substr( $foo, 2, 1 ) = 'XYZ';
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitLvalueSubstr';
+is( critique($policy, \$code), 1, 'lvalue' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+substr $foo, 2, 1, 'XYZ';
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitLvalueSubstr';
+isnt( critique($policy, \$code), 1, '4 arg substr' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$bar = substr( $foo, 2, 1 );
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitLvalueSubstr';
+isnt( critique($policy, \$code), 1, 'rvalue' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+%bar = (
+ 'foobar' => substr( $foo, 2, 1 ),
+ );
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitLvalueSubstr';
+isnt( critique($policy, \$code), 1, 'hash rvalue' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select( undef, undef, undef, 0.25 );
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitSleepViaSelect';
+is( critique($policy, \$code), 1, 'sleep, as list' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select( undef, undef, undef, $time );
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitSleepViaSelect';
+is( critique($policy, \$code), 1, 'sleep, as list w/var' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select undef, undef, undef, 0.25;
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitSleepViaSelect';
+is( critique($policy, \$code), 1, 'sleep, as built-in' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select $vec, undef, undef, 0.25;
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitSleepViaSelect';
+isnt( critique($policy, \$code), 1, 'select on read' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select undef, $vec, undef, 0.25;
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitSleepViaSelect';
+isnt( critique($policy, \$code), 1, 'select on write' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select undef, undef, $vec, 0.25;
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitSleepViaSelect';
+isnt( critique($policy, \$code), 1, 'select on error' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+eval "$some_code";
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitStringyEval';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+eval { some_code() };
+eval( {some_code() } );
+eval();
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitStringyEval';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$hash1{eval} = 1;
+%hash2 = (eval => 1);
+END_PERL
+
+$policy = 'BuiltinFunctions::ProhibitStringyEval';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+grep $_ eq 'foo', @list;
+@matches = grep $_ eq 'foo', @list;
+END_PERL
+
+$policy = 'BuiltinFunctions::RequireBlockGrep';
+is( critique($policy, \$code), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+grep {$_ eq 'foo'} @list;
+@matches = grep {$_ eq 'foo'} @list;
+grep( {$_ eq 'foo'} @list );
+@matches = grep( {$_ eq 'foo'} @list )
+grep();
+@matches = grep();
+END_PERL
+
+$policy = 'BuiltinFunctions::RequireBlockGrep';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$hash1{grep} = 1;
+%hash2 = (grep => 1);
+END_PERL
+
+$policy = 'BuiltinFunctions::RequireBlockGrep';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+map $_++, @list;
+@foo = map $_++, @list;
+END_PERL
+
+$policy = 'BuiltinFunctions::RequireBlockMap';
+is( critique($policy, \$code), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+map {$_++} @list;
+@foo = map {$_++} @list;
+map( {$_++} @list );
+@foo = map( {$_++} @list );
+map();
+@foo = map();
+END_PERL
+
+$policy = 'BuiltinFunctions::RequireBlockMap';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$hash1{map} = 1;
+%hash2 = (map => 1);
+END_PERL
+
+$policy = 'BuiltinFunctions::RequireBlockMap';
+is( critique($policy, \$code), 0, $policy);
+
+#-----------------------------------------------------------------------------
+
+$code = <<'END_PERL';
+@files = <*.pl>;
+END_PERL
+
+$policy = 'BuiltinFunctions::RequireGlobFunction';
+is( critique($policy, \$code), 1, 'glob via <...>' );
+
+#-----------------------------------------------------------------------------
+
+$code = <<'END_PERL';
+foreach my $file (<*.pl>) {
+ print $file;
+}
+END_PERL
+
+$policy = 'BuiltinFunctions::RequireGlobFunction';
+is( critique($policy, \$code), 1, 'glob via <...> in foreach' );
+
+#-----------------------------------------------------------------------------
+
+$code = <<'END_PERL';
+@files = (<*.pl>, <*.pm>);
+END_PERL
+
+$policy = 'BuiltinFunctions::RequireGlobFunction';
+is( critique($policy, \$code), 1, 'multiple globs via <...>' );
+
+#-----------------------------------------------------------------------------
+
+$code = <<'END_PERL';
+while (<$fh>) {
+ print $_;
+}
+END_PERL
+
+$policy = 'BuiltinFunctions::RequireGlobFunction';
+isnt( critique($policy, \$code), 1, 'I/O' );
+
+#-----------------------------------------------------------------------------
+
+$code = <<'END_PERL';
+my $self = bless {};
+my $self = bless [];
+
+#Critic doesn't catch these,
+#cuz they parse funny
+#my $self = bless( {} );
+#my $self = bless( [] );
+
+END_PERL
+
+$policy = 'ClassHierarchies::ProhibitOneArgBless';
+is( critique($policy, \$code), 2, $policy );
+
+#-----------------------------------------------------------------------------
+
+$code = <<'END_PERL';
+my $self = bless {}, 'foo';
+my $self = bless( {}, 'foo' );
+my $self = bless [], 'foo';
+my $self = bless( [], 'foo' );
+END_PERL
+
+$policy = 'ClassHierarchies::ProhibitOneArgBless';
+is( critique($policy, \$code), 0, $policy );
+
+#-----------------------------------------------------------------------------
+
+$code = <<"END_PERL";
+#This will be interpolated!
+
+sub my_sub {
+\tfor(1){
+\t\tdo_something();
+\t}
+}
+
+\t\t\t;
+
+END_PERL
+
+$policy = 'CodeLayout::ProhibitHardTabs';
+is( critique($policy, \$code), 0, $policy );
+
+#-----------------------------------------------------------------------------
+
+$code = <<"END_PERL";
+#This will be interpolated!
+print "\t \t foobar \t";
+END_PERL
+
+$policy = 'CodeLayout::ProhibitHardTabs';
+is( critique($policy, \$code), 1, $policy );
+
+#-----------------------------------------------------------------------------
+
+$code = <<"END_PERL";
+##This will be interpolated!
+
+sub my_sub {
+\tfor(1){
+\t\tdo_something();
+\t}
+}
+
+END_PERL
+
+%config = (allow_leading_tabs => 0);
+$policy = 'CodeLayout::ProhibitHardTabs';
+is( critique($policy, \$code, \%config), 3, $policy );
+
+#-----------------------------------------------------------------------------
+
+$code = <<"END_PERL";
+##This will be interpolated!
+
+sub my_sub {
+;\tfor(1){
+\t\tdo_something();
+;\t}
+}
+
+END_PERL
+
+%config = (allow_leading_tabs => 0);
+$policy = 'CodeLayout::ProhibitHardTabs';
+is( critique($policy, \$code, \%config), 3, $policy );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+open ($foo, $bar);
+open($foo, $bar);
+uc();
+lc();
+END_PERL
+
+$policy = 'CodeLayout::ProhibitParensWithBuiltins';
+is( critique($policy, \$code), 4, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+open $foo, $bar;
+uc $foo;
+lc $foo;
+my $foo;
+my ($foo, $bar);
+our ($foo, $bar);
+local ($foo $bar);
+return ($foo, $bar);
+return ();
+my_subroutine($foo $bar);
+END_PERL
+
+$policy = 'CodeLayout::ProhibitParensWithBuiltins';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my $obj = SomeClass->new();
+$obj->open();
+$obj->close();
+$obj->prototype();
+$obj->delete();
+END_PERL
+
+$policy = 'CodeLayout::ProhibitParensWithBuiltins';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+@list = ($foo, $bar, $baz);
+@list = some_function($foo, $bar, $baz);
+@list = ($baz);
+@list = ();
+
+@list = ($baz
+);
+
+@list = ($baz
+ );
+
+END_PERL
+
+$policy = 'CodeLayout::RequireTrailingCommas';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+@list = ($foo,
+ $bar,
+ $baz);
+
+@list = ($foo,
+ $bar,
+ $baz
+ );
+
+@list = ($foo,
+ $bar,
+ $baz
+);
+
+
+END_PERL
+
+$policy = 'CodeLayout::RequireTrailingCommas';
+is( critique($policy, \$code), 3, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+@list = ($foo,
+ $bar,
+ $baz,);
+
+@list = ($foo,
+ $bar,
+ $baz,
+);
+
+@list = ($foo,
+ $bar,
+ $baz,
+ );
+
+END_PERL
+
+$policy = 'CodeLayout::RequireTrailingCommas';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+for($i=0; $i<=$max; $i++){
+ do_something();
+}
+END_PERL
+
+$policy = 'ControlStructures::ProhibitCStyleForLoops';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+for(@list){
+ do_something();
+}
+
+for my $element (@list){
+ do_something();
+}
+
+foreach my $element (@list){
+ do_something();
+}
+
+do_something() for @list;
+END_PERL
+
+$policy = 'ControlStructures::ProhibitCStyleForLoops';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+do_something() if $condition;
+do_something() while $condition;
+do_something() until $condition;
+do_something() unless $condition;
+do_something() for @list;
+END_PERL
+
+$policy = 'ControlStructures::ProhibitPostfixControls';
+is( critique($policy, \$code), 5, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+do_something() if $condition;
+do_something() while $condition;
+do_something() until $condition;
+do_something() unless $condition;
+do_something() for @list;
+END_PERL
+
+$policy = 'ControlStructures::ProhibitPostfixControls';
+%config = (allow => 'if while until unless for');
+is( critique($policy, \$code, \%config), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+if($condition){ do_something() }
+while($condition){ do_something() }
+until($condition){ do_something() }
+unless($condition){ do_something() }
+END_PERL
+
+$policy = 'ControlStructures::ProhibitPostfixControls';
+%config = (allow => 'if while until unless for');
+is( critique($policy, \$code, \%config), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+#PPI versions < 1.03 had problems with this
+for my $element (@list){ do_something() }
+for (@list){ do_something_else() }
+
+END_PERL
+
+$policy = 'ControlStructures::ProhibitPostfixControls';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+use Carp;
+
+while ($condition) {
+ next if $condition;
+ last if $condition;
+ redo if $condition;
+ return if $condition;
+ goto HELL if $condition;
+}
+
+die 'message' if $condition;
+die if $condition;
+
+warn 'message' if $condition;
+warn if $condition;
+
+carp 'message' if $condition;
+carp if $condition;
+
+croak 'message' if $condition;
+croak if $condition;
+
+cluck 'message' if $condition;
+cluck if $condition;
+
+confess 'message' if $condition;
+confess if $condition;
+
+END_PERL
+
+$policy = 'ControlStructures::ProhibitPostfixControls';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my %hash;
+$hash{if} = 1;
+$hash{unless} = 1;
+$hash{until} = 1;
+$hash{while} = 1;
+$hash{for} = 1;
+END_PERL
+
+$policy = 'ControlStructures::ProhibitPostfixControls';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my %hash = (if => 1, unless => 1, until => 1, while => 1, for => 1);
+END_PERL
+
+$policy = 'ControlStructures::ProhibitPostfixControls';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+if ($condition1){
+ $foo;
+}
+elsif ($condition2){
+ $bar;
+}
+elsif ($condition3){
+ $baz;
+}
+elsif ($condition4){
+ $barf;
+}
+else {
+ $nuts;
+}
+END_PERL
+
+$policy = 'ControlStructures::ProhibitCascadingIfElse';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+if ($condition1){
+ $foo;
+}
+elsif ($condition2){
+ $bar;
+}
+elsif ($condition3){
+ $bar;
+}
+else {
+ $nuts;
+}
+
+if ($condition1){
+ $foo;
+}
+else {
+ $nuts;
+}
+
+if ($condition1){
+ $foo;
+}
+END_PERL
+
+$policy = 'ControlStructures::ProhibitCascadingIfElse';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+if ($condition1){
+ $foo;
+}
+elsif ($condition2){
+ $bar;
+}
+elsif ($condition3){
+ $baz;
+}
+else {
+ $nuts;
+}
+END_PERL
+
+%config = (max_elsif => 1);
+$policy = 'ControlStructures::ProhibitCascadingIfElse';
+is( critique($policy, \$code, \%config), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+until($condition){
+ do_something();
+}
+END_PERL
+
+$policy = 'ControlStructures::ProhibitUntilBlocks';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+while(! $condition){
+ do_something();
+}
+
+do_something() until $condition
+END_PERL
+
+$policy = 'ControlStructures::ProhibitUntilBlocks';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+unless($condition){
+ do_something();
+}
+END_PERL
+
+$policy = 'ControlStructures::ProhibitUnlessBlocks';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+if(! $condition){
+ do_something();
+}
+
+do_something() unless $condition
+END_PERL
+
+$policy = 'ControlStructures::ProhibitUnlessBlocks';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+#just a comment
+$foo = "bar";
+$baz = qq{nuts};
+END_PERL
+
+$policy = 'Miscellanea::RequireRcsKeywords';
+is( critique($policy, \$code), 3, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+# $Revision$
+# $Source$
+# $Date$
+END_PERL
+
+$policy = 'Miscellanea::RequireRcsKeywords';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+'$Revision: 1.01 $'
+'$Source: foo/bar $'
+'$Date: 10/23/2006 $'
+END_PERL
+
+$policy = 'Miscellanea::RequireRcsKeywords';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+q{$Revision: 1.01 $}
+q{$Source: foo/bar $}
+q{$Date: 10/23/2006 $}
+END_PERL
+
+$policy = 'Miscellanea::RequireRcsKeywords';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+q{$Revision: 1.01 $}
+q{$Author: Jesus Christ $}
+q{$Id: whatever $}
+END_PERL
+
+%config = (keywords => 'Revision Author Id');
+$policy = 'Miscellanea::RequireRcsKeywords';
+is( critique($policy, \$code, \%config), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+#nothing here!
+END_PERL
+
+%config = (keywords => 'Author Id');
+$policy = 'Miscellanea::RequireRcsKeywords';
+is( critique($policy, \$code, \%config), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package foo;
+package bar;
+package nuts;
+$some_code = undef;
+END_PERL
+
+$policy = 'Modules::ProhibitMultiplePackages';
+is( critique($policy, \$code), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package foo;
+$some_code = undef;
+END_PERL
+
+$policy = 'Modules::ProhibitMultiplePackages';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+require 'Exporter';
+require 'My/Module.pl';
+use 'SomeModule';
+use "OtherModule.pm";
+no "Module";
+no "Module.pm";
+END_PERL
+
+$policy = 'Modules::RequireBarewordIncludes';
+is( critique($policy, \$code), 6, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+require MyModule;
+use MyModule;
+no MyModule;
+use strict;
+END_PERL
+
+$policy = 'Modules::RequireBarewordIncludes';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$foo = $bar;
+package foo;
+END_PERL
+
+$policy = 'Modules::RequireExplicitPackage';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+use Some::Module;
+package foo;
+END_PERL
+
+$policy = 'Modules::RequireExplicitPackage';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+use Some::Module;
+print 'whatever';
+END_PERL
+
+$policy = 'Modules::RequireExplicitPackage';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package foo;
+use strict;
+$foo = $bar;
+END_PERL
+
+$policy = 'Modules::RequireExplicitPackage';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+#!/usr/bin/perl
+$foo = $bar;
+package foo;
+END_PERL
+
+%config = (exempt_scripts => 1);
+$policy = 'Modules::RequireExplicitPackage';
+is( critique($policy, \$code, \%config), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+#!/usr/bin/perl
+use strict;
+use warnings;
+my $foo = 42;
+
+END_PERL
+
+%config = (exempt_scripts => 1);
+$policy = 'Modules::RequireExplicitPackage';
+is( critique($policy, \$code, \%config), 0, $policy);
+
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+#!/usr/bin/perl
+package foo;
+$foo = $bar;
+END_PERL
+
+%config = (exempt_scripts => 1);
+$policy = 'Modules::RequireExplicitPackage';
+is( critique($policy, \$code, \%config), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+use Evil::Module qw(bad stuff);
+use Super::Evil::Module;
+END_PERL
+
+$policy = 'Modules::ProhibitSpecificModules';
+%config = (modules => 'Evil::Module Super::Evil::Module');
+is( critique($policy, \$code, \%config), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+use Good::Module;
+END_PERL
+
+$policy = 'Modules::ProhibitSpecificModules';
+%config = (modules => 'Evil::Module Super::Evil::Module');
+is( critique($policy, \$code, \%config), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+#Nothing!
+END_PERL
+
+$policy = 'Modules::RequireVersionVar';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+our $VERSION = 1.0;
+END_PERL
+
+$policy = 'Modules::RequireVersionVar';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+our ($VERSION) = 1.0;
+END_PERL
+
+$policy = 'Modules::RequireVersionVar';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$Package::VERSION = 1.0;
+END_PERL
+
+$policy = 'Modules::RequireVersionVar';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+use vars '$VERSION';
+END_PERL
+
+$policy = 'Modules::RequireVersionVar';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+use vars qw($VERSION);
+END_PERL
+
+$policy = 'Modules::RequireVersionVar';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my $VERSION;
+END_PERL
+
+$policy = 'Modules::RequireVersionVar';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+our $Version;
+END_PERL
+
+$policy = 'Modules::RequireVersionVar';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my $string =~ m{pattern}x;
+my $string =~ m{pattern}gimx;
+my $string =~ m{pattern}gixs;
+my $string =~ m{pattern}xgms;
+
+my $string =~ m/pattern/x;
+my $string =~ m/pattern/gimx;
+my $string =~ m/pattern/gixs;
+my $string =~ m/pattern/xgms;
+
+my $string =~ /pattern/x;
+my $string =~ /pattern/gimx;
+my $string =~ /pattern/gixs;
+my $string =~ /pattern/xgms;
+
+my $string =~ s/pattern/foo/x;
+my $string =~ s/pattern/foo/gimx;
+my $string =~ s/pattern/foo/gixs;
+my $string =~ s/pattern/foo/xgms;
+END_PERL
+
+$policy = 'RegularExpressions::RequireExtendedFormatting';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my $string =~ m{pattern};
+my $string =~ m{pattern}gim;
+my $string =~ m{pattern}gis;
+my $string =~ m{pattern}gms;
+
+my $string =~ m/pattern/;
+my $string =~ m/pattern/gim;
+my $string =~ m/pattern/gis;
+my $string =~ m/pattern/gms;
+
+my $string =~ /pattern/;
+my $string =~ /pattern/gim;
+my $string =~ /pattern/gis;
+my $string =~ /pattern/gms;
+
+my $string =~ s/pattern/foo/;
+my $string =~ s/pattern/foo/gim;
+my $string =~ s/pattern/foo/gis;
+my $string =~ s/pattern/foo/gms;
+
+END_PERL
+
+$policy = 'RegularExpressions::RequireExtendedFormatting';
+is( critique($policy, \$code), 16, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+@out = `some_command`;
+@out = qx{some_command};
+END_PERL
+
+$policy = 'InputOutput::ProhibitBacktickOperators';
+is( critique($policy, \$code), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+open FH, '>', $some_file;
+open FH, '>', $some_file or die;
+open(FH, '>', $some_file);
+open(FH, '>', $some_file) or die;
+
+END_PERL
+
+$policy = 'InputOutput::ProhibitBarewordFileHandles';
+is( critique($policy, \$code), 4, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+open $fh, '>', $some_file;
+open $fh, '>', $some_file or die;
+open($fh, '>', $some_file);
+open($fh, '>', $some_file) or die;
+
+open my $fh, '>', $some_file;
+open my $fh, '>', $some_file or die;
+open(my $fh, '>', $some_file);
+open(my $fh, '>', $some_file) or die;
+
+END_PERL
+
+$policy = 'InputOutput::ProhibitBarewordFileHandles';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select( $fh );
+END_PERL
+
+$policy = 'InputOutput::ProhibitOneArgSelect';
+is( critique($policy, \$code), 1, '1 arg; variable, w/parens' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select $fh;
+END_PERL
+
+$policy = 'InputOutput::ProhibitOneArgSelect';
+is( critique($policy, \$code), 1, '1 arg; variable, as built-in' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select( STDERR );
+END_PERL
+
+$policy = 'InputOutput::ProhibitOneArgSelect';
+is( critique($policy, \$code), 1, '1 arg; fh, w/parens' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select STDERR;
+END_PERL
+
+$policy = 'InputOutput::ProhibitOneArgSelect';
+is( critique($policy, \$code), 1, '1 arg; fh, as built-in' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+select( undef, undef, undef, 0.25 );
+END_PERL
+
+$policy = 'InputOutput::ProhibitOneArgSelect';
+isnt( critique($policy, \$code), 1, '4 args' );
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+
+open $fh, ">$output";
+open($fh, ">$output");
+open($fh, ">$output") or die;
+
+open my $fh, ">$output";
+open(my $fh, ">$output");
+open(my $fh, ">$output") or die;
+
+open FH, ">$output";
+open(FH, ">$output");
+open(FH, ">$output") or die;
+
+#This are tricky because the Critic can't
+#tell where the expression really ends
+open FH, ">$output" or die;
+open $fh, ">$output" or die;
+open my $fh, ">$output" or die;
+
+END_PERL
+
+$policy = 'InputOutput::ProhibitTwoArgOpen';
+is( critique($policy, \$code), 12, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+open $fh, '>', $output";
+open($fh, '>', $output");
+open($fh, '>', $output") or die;
+
+open my $fh, '>', $output";
+open(my $fh, '>', $output");
+open(my $fh, '>', $output") or die;
+
+open FH, '>', $output";
+open(FH, '>', $output");
+open(FH, '>', $output") or die;
+
+#This are tricky because the Critic can't
+#tell where the expression really ends
+open $fh, '>', $output" or die;
+open my $fh, '>', $output" or die;
+open FH, '>', $output" or die;
+
+END_PERL
+
+$policy = 'InputOutput::ProhibitTwoArgOpen';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+print "this is literal";
+print qq{this is literal};
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitInterpolationOfLiterals';
+is( critique($policy, \$code), 2, $policy);
+
+#----------------------------------------------------------------
+$code = <<'END_PERL';
+print 'this is literal';
+print q{this is literal};
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitInterpolationOfLiterals';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$sql = qq(select foo from bar);
+$sql = qq{select foo from bar};
+$sql = qq[select foo from bar];
+$sql = qq/select foo from bar/;
+END_PERL
+
+%config = (allow => 'qq( qq{ qq[ qq/');
+$policy = 'ValuesAndExpressions::ProhibitInterpolationOfLiterals';
+is( critique($policy, \$code, \%config), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$sql = qq(select foo from bar);
+$sql = qq{select foo from bar};
+$sql = qq[select foo from bar];
+$sql = qq/select foo from bar/;
+END_PERL
+
+%config = (allow => 'qq( qq{');
+$policy = 'ValuesAndExpressions::ProhibitInterpolationOfLiterals';
+is( critique($policy, \$code, \%config), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$sql = qq(select foo from bar);
+$sql = qq{select foo from bar};
+$sql = qq[select foo from bar];
+$sql = qq/select foo from bar/;
+END_PERL
+
+%config = (allow => '() {}'); #Testing odd config
+$policy = 'ValuesAndExpressions::ProhibitInterpolationOfLiterals';
+is( critique($policy, \$code, \%config), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$sql = qq(select foo from bar);
+$sql = qq{select foo from bar};
+$sql = qq[select foo from bar];
+$sql = qq/select foo from bar/;
+END_PERL
+
+%config = (allow => 'qq() qq{}'); #Testing odd config
+$policy = 'ValuesAndExpressions::ProhibitInterpolationOfLiterals';
+is( critique($policy, \$code, \%config), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+print 'this is not $literal';
+print q{this is not $literal};
+print 'this is not literal\n';
+print q{this is not literal\n};
+END_PERL
+
+$policy = 'ValuesAndExpressions::RequireInterpolationOfMetachars';
+is( critique($policy, \$code), 4, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+print "this is not $literal";
+print qq{this is not $literal};
+print "this is not literal\n";
+print qq{this is not literal\n};
+END_PERL
+
+$policy = 'ValuesAndExpressions::RequireInterpolationOfMetachars';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = 01;
+$var = 010;
+$var = 001;
+$var = 0010;
+$var = 0.12;
+$var = 00.001;
+$var = -01;
+$var = -010;
+$var = -001;
+$var = -0010;
+$var = -0.12;
+$var = -00.001;
+$var = +01;
+$var = +010;
+$var = +001;
+$var = +0010;
+$var = +0.12;
+$var = +00.001;
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitLeadingZeros';
+is( critique($policy, \$code), 18, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = 0;
+$var = 0.;
+$var = 10;
+$var = 0.0;
+$var = 10.0;
+$var = -0;
+$var = -0.;
+$var = -10;
+$var = -0.0;
+$var = -10.0;
+$var = +0;
+$var = +0.;
+$var = +10;
+$var = +0.0;
+$var = +10.0;
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitLeadingZeros';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = 1234_567;
+$var = 1234_567.;
+$var = 1234_567.890;
+$var = -1234_567.8901;
+$var = -1234_567;
+$var = -1234_567.;
+$var = -1234_567.890;
+$var = -1234_567.8901;
+$var = +1234_567;
+$var = +1234_567.;
+$var = +1234_567.890;
+$var = +1234_567.8901;
+
+END_PERL
+
+$policy = 'ValuesAndExpressions::RequireNumberSeparators';
+is( critique($policy, \$code), 12, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = 12;
+$var = 1234;
+$var = 1_234;
+$var = 1_234.01;
+$var = 1_234_567;
+$var = 1_234_567.;
+$var = 1_234_567.890_123;
+$var = -1_234;
+$var = -1_234.01;
+$var = -1_234_567;
+$var = -1_234_567.;
+$var = -1_234_567.890_123;
+$var = +1_234;
+$var = +1_234.01;
+$var = +1_234_567;
+$var = +1_234_567.;
+$var = +1_234_567.890_123;
+END_PERL
+
+$policy = 'ValuesAndExpressions::RequireNumberSeparators';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = 1000001;
+$var = 1000000.01;
+$var = 1000_000.01;
+$var = 10000_000.01;
+$var = -1000001;
+$var = -1234567;
+$var = -1000000.01;
+$var = -1000_000.01;
+$var = -10000_000.01;
+END_PERL
+
+%config = (min_value => 1_000_000);
+$policy = 'ValuesAndExpressions::RequireNumberSeparators';
+is( critique($policy, \$code, \%config), 9, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = 999999;
+$var = 123456;
+$var = 100000.01;
+$var = 10_000.01;
+$var = 100_000.01;
+$var = -999999;
+$var = -123456;
+$var = -100000.01;
+$var = -10_000.01;
+$var = -100_000.01;
+END_PERL
+
+%config = (min_value => 1_000_000);
+$policy = 'ValuesAndExpressions::RequireNumberSeparators';
+is( critique($policy, \$code, \%config), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+@list = ('foo', 'bar', 'baz');
+
+@list = ('foo',
+ 'bar',
+ 'baz');
+
+END_PERL
+
+$policy = 'CodeLayout::ProhibitQuotedWordLists';
+is( critique($policy, \$code), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+@list = ('foo', 'bar', 'bee baz');
+@list = ('foo, 'bar');
+@list = ($foo, 'bar', 'baz');
+%hash = ('foo' => 'bar', 'fo' => 'fum');
+my_function('foo', 'bar', 'fudge');
+foreach ('foo', 'bar', 'nuts'){ do_something($_) }
+END_PERL
+
+$policy = 'CodeLayout::ProhibitQuotedWordLists';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+@list = ('foo', 'bar, 'baz');
+END_PERL
+
+%config = (min_elements => 4);
+$policy = 'CodeLayout::ProhibitQuotedWordLists';
+is( critique($policy, \$code, \%config), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+@list = ('foo', 'bar', 'baz', 'nuts');
+END_PERL
+
+%config = (min_elements => 4);
+$policy = 'CodeLayout::ProhibitQuotedWordLists';
+is( critique($policy, \$code, \%config), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my $fooBAR;
+my ($fooBAR) = 'nuts';
+local $FooBar;
+our ($FooBAR);
+END_PERL
+
+$policy = 'NamingConventions::ProhibitMixedCaseVars';
+is( critique($policy, \$code), 4, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my ($foobar, $fooBAR);
+my (%foobar, @fooBAR, $foo);
+local ($foobar, $fooBAR);
+local (%foobar, @fooBAR, $foo);
+our ($foobar, $fooBAR);
+our (%foobar, @fooBAR, $foo);
+END_PERL
+
+$policy = 'NamingConventions::ProhibitMixedCaseVars';
+is( critique($policy, \$code), 6, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my $foo_BAR;
+my $FOO_BAR;
+my $foo_bar;
+END_PERL
+
+$policy = 'NamingConventions::ProhibitMixedCaseVars';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my ($foo_BAR, $BAR_FOO);
+my ($foo_BAR, $BAR_FOO) = q(this, that);
+our (%FOO_BAR, @BAR_FOO);
+local ($FOO_BAR, %BAR_foo) = @_;
+my ($foo_bar, $foo);
+END_PERL
+
+$policy = 'NamingConventions::ProhibitMixedCaseVars';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+sub fooBAR {}
+sub FooBar {}
+sub Foo_Bar {}
+sub FOObar {}
+END_PERL
+
+$policy = 'NamingConventions::ProhibitMixedCaseSubs';
+is( critique($policy, \$code), 4, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+sub foo_BAR {}
+sub foo_bar {}
+sub FOO_bar {}
+END_PERL
+
+$policy = 'NamingConventions::ProhibitMixedCaseSubs';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+sub test_sub1 {
+ $foo = shift;
+ return undef;
+}
+
+sub test_sub2 {
+ shift || return undef;
+}
+
+sub test_sub3 {
+ return undef if $bar;
+}
+
+END_PERL
+
+$policy = 'Subroutines::ProhibitExplicitReturnUndef';
+is( critique($policy, \$code), 3, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+sub test_sub1 {
+ $foo = shift;
+ return;
+}
+
+sub test_sub2 {
+ shift || return;
+}
+
+sub test_sub3 {
+ return if $bar;
+}
+
+END_PERL
+
+$policy = 'Subroutines::ProhibitExplicitReturnUndef';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+sub my_sub1 ($@) {}
+sub my_sub2 (@@) {}
+END_PERL
+
+$policy = 'Subroutines::ProhibitSubroutinePrototypes';
+is( critique($policy, \$code), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+sub my_sub1 {}
+sub my_sub1 {}
+END_PERL
+
+$policy = 'Subroutines::ProhibitSubroutinePrototypes';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+sub open {}
+sub map {}
+sub eval {}
+END_PERL
+
+$policy = 'Subroutines::ProhibitBuiltinHomonyms';
+is( critique($policy, \$code), 3, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+sub my_open {}
+sub my_map {}
+sub eval2 {}
+END_PERL
+
+$policy = 'Subroutines::ProhibitBuiltinHomonyms';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+sub import {}
+END_PERL
+
+$policy = 'Subroutines::ProhibitBuiltinHomonyms';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$foo = $bar;
+use warnings;
+END_PERL
+
+$policy = 'TestingAndDebugging::RequirePackageWarnings';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$foo = $bar;
+END_PERL
+
+$policy = 'TestingAndDebugging::RequirePackageWarnings';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+use warnings;
+$foo = $bar;
+END_PERL
+
+$policy = 'TestingAndDebugging::RequirePackageWarnings';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$foo = $bar;
+use strict;
+END_PERL
+
+$policy = 'TestingAndDebugging::RequirePackageStricture';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$foo = $bar;
+END_PERL
+
+$policy = 'TestingAndDebugging::RequirePackageStricture';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+use Module;
+use strict;
+$foo = $bar;
+END_PERL
+
+$policy = 'TestingAndDebugging::RequirePackageStricture';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+use constant FOO => 42;
+use constant BAR => 24;
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitConstantPragma';
+is( critique($policy, \$code), 2, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my $FOO = 42;
+local BAR = 24;
+our $NUTS = 16;
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitConstantPragma';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = "";
+$var = ''
+$var = ' ';
+$var = " ";
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitEmptyQuotes';
+is( critique($policy, \$code), 4, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = qq{};
+$var = q{}
+$var = qq{ };
+$var = q{ };
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitEmptyQuotes';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = qq{this};
+$var = q{that}
+$var = qq{the};
+$var = q{other};
+$var = "this";
+$var = 'that';
+$var = 'the';
+$var = "other";
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitEmptyQuotes';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = "!";
+$var = '!';
+$var = '!!';
+$var = "||";
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitNoisyQuotes';
+is( critique($policy, \$code), 4, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = q{'};
+$var = q{"};
+$var = q{!!};
+$var = q{||};
+$var = "!!!";
+$var = '!!!';
+$var = 'a';
+$var = "a";
+$var = '1';
+$var = "1";
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitNoisyQuotes';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$var = '(';
+$var = ')';
+$var = '{';
+$var = '}';
+$var = '[';
+$var = ']';
+
+$var = '{(';
+$var = ')}';
+$var = '[{';
+$var = '[}';
+$var = '[(';
+$var = '])';
+
+$var = "(";
+$var = ")";
+$var = "{";
+$var = "}";
+$var = "[";
+$var = "]";
+
+$var = "{(";
+$var = ")]";
+$var = "({";
+$var = "}]";
+$var = "{[";
+$var = "]}";
+END_PERL
+
+$policy = 'ValuesAndExpressions::ProhibitNoisyQuotes';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+print <<END_QUOTE;
+Four score and seven years ago...
+END_QUOTE
+END_PERL
+
+$policy = 'ValuesAndExpressions::RequireQuotedHeredocTerminator';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+print <<'END_QUOTE';
+Four score and seven years ago...
+END_QUOTE
+END_PERL
+
+$policy = 'ValuesAndExpressions::RequireQuotedHeredocTerminator';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+print <<"END_QUOTE";
+Four score and seven years ago...
+END_QUOTE
+END_PERL
+
+$policy = 'ValuesAndExpressions::RequireQuotedHeredocTerminator';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+print <<"endquote";
+Four score and seven years ago...
+endquote
+END_PERL
+
+$policy = 'ValuesAndExpressions::RequireUpperCaseHeredocTerminator';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+print <<endquote;
+Four score and seven years ago...
+endquote
+END_PERL
+
+$policy = 'ValuesAndExpressions::RequireUpperCaseHeredocTerminator';
+is( critique($policy, \$code), 1, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+print <<"QUOTE";
+Four score and seven years ago...
+QUOTE
+END_PERL
+
+$policy = 'ValuesAndExpressions::RequireUpperCaseHeredocTerminator';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+local $foo = $bar;
+local $/ = undef;
+local $| = 1;
+local ($foo, $bar) = ();
+local ($/) = undef;
+local ($RS, $>) = ();
+local ($foo, %SIG);
+END_PERL
+
+$policy = 'Variables::ProhibitLocalVars';
+is( critique($policy, \$code), 7, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+local ($RS);
+local $INPUT_RECORD_SEPARATOR;
+local $PROGRAM_NAME;
+local ($EVAL_ERROR, $OS_ERROR);
+my $var1 = 'foo';
+our $var2 = 'bar';
+local $SIG{HUP} \&handler;
+local $INC{$module} = $path;
+END_PERL
+
+$policy = 'Variables::ProhibitLocalVars';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+our $var1 = 'foo';
+our (%var2, %var3) = 'foo';
+our (%VAR4, $var5) = ();
+$Package::foo;
+@Package::list = ('nuts');
+%Package::hash = ('nuts');
+$::foo = $bar;
+@::foo = ($bar);
+%::foo = ();
+use vars qw($FOO $BAR);
+END_PERL
+
+$policy = 'Variables::ProhibitPackageVars';
+is( critique($policy, \$code), 10, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+our $VAR1 = 'foo';
+our (%VAR2, %VAR3) = ();
+our $VERSION = '1.0';
+our @EXPORT = qw(some symbols);
+$Package::VERSION = '1.2';
+%Package::VAR = ('nuts');
+@Package::EXPORT = ();
+$::VERSION = '1.2';
+%::VAR = ('nuts');
+@::EXPORT = ();
+&Package::my_sub();
+&::my_sub();
+END_PERL
+
+$policy = 'Variables::ProhibitPackageVars';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+my $var1 = 'foo';
+my %var2 = 'foo';
+my ($foo, $bar) = ();
+END_PERL
+
+$policy = 'Variables::ProhibitPackageVars';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$/ = undef;
+$| = 1;
+$> = 3;
+END_PERL
+
+$policy = 'Variables::ProhibitPunctuationVars';
+is( critique($policy, \$code), 3, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$RS = undef;
+$INPUT_RECORD_SEPARATOR = "\n";
+$OUTPUT_AUTOFLUSH = 1;
+print $foo, $baz;
+END_PERL
+
+$policy = 'Variables::ProhibitPunctuationVars';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+$string =~ /((foo)bar)/;
+$foobar = $1;
+$foo = $2;
+$3;
+$stat = stat(_);
+@list = @_;
+my $line = $_;
+END_PERL
+
+$policy = 'Variables::ProhibitPunctuationVars';
+is( critique($policy, \$code), 0, $policy);
+
+#----------------------------------------------------------------
+sub critique {
+ my($policy, $code_ref, $config_ref) = @_;
+ my $c = Perl::Critic->new( -profile => 'NONE' );
+ $c->add_policy(-policy => $policy, -config => $config_ref);
+ my @v = $c->critique($code_ref);
+ return scalar @v;
+}
--- /dev/null
+use blib;
+use strict;
+use warnings;
+use Test::More tests => 11;
+use Perl::Critic;
+
+my $code = undef;
+my %config = ();
+
+#---------------------------------------------------------------
+# If the user already has an existing perlcriticrc file, it will
+# get in the way of these test. This little tweak to ensures
+# that we don't find the perlcriticrc file.
+
+{
+ no warnings 'redefine';
+ *Perl::Critic::Config::find_profile_path = sub { return };
+}
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+require 'some_library.pl'; ## no critic
+print $crap if $condition; ## no critic
+END_PERL
+
+is( critique(\$code), 0);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+$foo = $bar;
+
+## no critic
+
+require 'some_library.pl';
+print $crap if $condition;
+
+## use critic
+
+$baz = $nuts;
+
+END_PERL
+
+is( critique(\$code), 0);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+for my $foo (@list) {
+ ## no critic
+ $long_int = 12345678;
+ $oct_num = 033;
+}
+
+my $noisy = '!';
+END_PERL
+
+is( critique(\$code), 1);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+## no critic
+for my $foo (@list) {
+ $long_int = 12345678;
+ $oct_num = 033;
+}
+
+## use critic
+my $noisy = '!';
+
+END_PERL
+
+is( critique(\$code), 1);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+for my $foo (@list) {
+ ## no critic
+ $long_int = 12345678;
+ $oct_num = 033;
+ ## use critic
+}
+
+my $noisy = '!';
+my $empty = '';
+
+END_PERL
+
+is( critique(\$code), 2);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+## no critic
+for my $foo (@list) {
+ $long_int = 12345678;
+ $oct_num = 033;
+}
+
+my $noisy = '!';
+my $empty = '';
+END_PERL
+
+is( critique(\$code), 0);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+$long_int = 12345678; ## no critic
+$oct_num = 033; ## no critic
+my $noisy = '!'; ## no critic
+my $empty = ''; ## no critic
+my $empty = ''; ## use critic
+END_PERL
+
+is( critique(\$code), 1);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+$long_int = 12345678; ## no critic
+$oct_num = 033; ## no critic
+my $noisy = '!'; ## no critic
+my $empty = ''; ## no critic
+
+$long_int = 12345678;
+$oct_num = 033;
+my $noisy = '!';
+my $empty = '';
+END_PERL
+
+is( critique(\$code), 4);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+$long_int = 12345678; ## no critic
+$oct_num = 033; ## no critic
+my $noisy = '!'; ## no critic
+my $empty = ''; ## no critic
+
+## use critic
+$long_int = 12345678;
+$oct_num = 033;
+my $noisy = '!';
+my $empty = '';
+END_PERL
+
+%config = (-force => 1);
+is( critique(\$code, \%config), 8);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+for my $foo (@list) {
+ $long_int = 12345678;
+ $oct_num = 033;
+}
+
+my $noisy = '!';
+my $empty = '';
+END_PERL
+
+%config = (-force => 1);
+is( critique(\$code, \%config), 4);
+
+#----------------------------------------------------------------
+
+$code = <<'END_PERL';
+package FOO;
+use strict;
+use warnings;
+our $VERSION = 1.0;
+
+for my $foo (@list) {
+ ## use critic
+ $long_int = 12345678;
+ $oct_num = 033;
+}
+
+## use critic
+my $noisy = '!';
+my $empty = '';
+END_PERL
+
+%config = (-force => 1);
+is( critique(\$code, \%config), 4);
+
+#----------------------------------------------------------------
+sub critique {
+ my ($code_ref, $config_ref) = @_;
+ my $c = Perl::Critic->new( %{$config_ref} );
+ my @v = $c->critique($code_ref);
+ return scalar @v;
+}
--- /dev/null
+use blib;
+use strict;
+use warnings;
+use Test::More;
+
+eval 'use Test::Perl::Critic';
+plan skip_all => 'Test::Perl::Critic required to criticise code' if $@;
+all_critic_ok('lib', 'bin');
\ No newline at end of file
--- /dev/null
+#use blib;
+use strict;
+use warnings;
+use Test::More;
+
+eval 'use Test::Pod 1.00';
+plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@;
+all_pod_files_ok();
\ No newline at end of file
--- /dev/null
+#use blib;
+use strict;
+use warnings;
+use Test::More;
+
+eval 'use Test::Pod::Coverage 1.00';
+plan skip_all => 'Test::Pod::Coverage 1.00 requried to test POD' if $@;
+my $trustme = { trustme => [ qr{ \A (?: new | violates ) \z }x ] };
+all_pod_coverage_ok($trustme);
\ No newline at end of file
--- /dev/null
+##########################################################################
+# This sample file demonstrates how to load all the Perl::Critic policy
+# modules. This is essentially what you get with no config file at all.
+# The priority level for each Policy defaults to 1, so with this config
+# file, Perl::Critic will always report every violation for every policy.
+# See the 'perlcrticrc.levels' for an example with different priority levels
+##########################################################################
+
+[BuiltinFunctions::ProhibitLvalueSubstr]
+[BuiltinFunctions::ProhibitSleepViaSelect]
+[BuiltinFunctions::ProhibitStringyEval]
+[BuiltinFunctions::RequireBlockGrep]
+[BuiltinFunctions::RequireBlockMap]
+[BuiltinFunctions::RequireGlobFunction]
+[ClassHierarchies::ProhibitOneArgBless]
+[CodeLayout::ProhibitHardTabs]
+[CodeLayout::ProhibitParensWithBuiltins]
+[CodeLayout::ProhibitQuotedWordLists]
+[CodeLayout::RequireTrailingCommas]
+[ControlStructures::ProhibitCStyleForLoops]
+[ControlStructures::ProhibitCascadingIfElse]
+[ControlStructures::ProhibitPostfixControls]
+[ControlStructures::ProhibitUnlessBlocks]
+[ControlStructures::ProhibitUntilBlocks]
+[InputOutput::ProhibitBacktickOperators]
+[InputOutput::ProhibitBarewordFileHandles]
+[InputOutput::ProhibitOneArgSelect]
+[Modules::ProhibitMultiplePackages]
+[Modules::ProhibitSpecificModules]
+[Modules::RequireExplicitPackage]
+[Modules::RequireBarewordIncludes]
+[Modules::RequireVersionVar]
+[NamingConventions::ProhibitMixedCaseSubs]
+[NamingConventions::ProhibitMixedCaseVars]
+[RegularExpressions::RequireExtendedFormatting]
+[RegularExpressions::RequireLineBoundaryMatching]
+[Subroutines::ProhibitBuiltinHomonyms]
+[Subroutines::ProhibitExplicitReturnUndef]
+[Subroutines::ProhibitSubroutinePrototypes]
+[TestingAndDebugging::RequirePackageStricture]
+[TestingAndDebugging::RequirePackageWarnings]
+[ValuesAndExpressions::ProhibitConstantPragma]
+[ValuesAndExpressions::ProhibitEmptyQuotes]
+[ValuesAndExpressions::ProhibitInterpolationOfLiterals]
+[ValuesAndExpressions::ProhibitLeadingZeros]
+[ValuesAndExpressions::ProhibitNoisyQuotes]
+[ValuesAndExpressions::RequireInterpolationOfMetachars]
+[ValuesAndExpressions::RequireNumberSeparators]
+[ValuesAndExpressions::RequireQuotedHeredocTerminator]
+[ValuesAndExpressions::RequireUpperCaseHeredocTerminator]
+[Variables::ProhibitLocalVars]
+[Variables::ProhibitPackageVars]
+[Variables::ProhibitPunctuationVars]
--- /dev/null
+##########################################################################
+# This sample file demonstrates how to assign a custom priority level
+# for any or all Perl::Critic policies. The default priority for each
+# policy is 1. Setting the priority to a higher value here causes
+# Perl::Critic to overlook the Policy unless you explicitly ask it
+# to load Policies with a priority value less than or equal to a
+# particular number. You can have an arbitrary number of priority
+# levels, but two or three should probably suffice. The priority
+# values here are arbitrary and just useful for testing.
+##########################################################################
+
+[BuiltinFunctions::ProhibitStringyEval]
+priority = 1
+
+[BuiltinFunctions::RequireBlockGrep]
+priority = 1
+
+[BuiltinFunctions::RequireBlockMap]
+priority = 1
+
+[CodeLayout::ProhibitParensWithBuiltins]
+priority = 2
+
+[ControlStructures::ProhibitCascadingIfElse]
+max_elsif = 2
+priority = 3
+
+[ControlStructures::ProhibitPostfixControls]
+allow = for if until while unless
+priority = 3
+
+[InputOutput::ProhibitBacktickOperators]
+priority = 4
+
+[Modules::ProhibitMultiplePackages]
+priority = 5
+
+[Modules::RequireBarewordIncludes]
+priority = 5
+
+[Modules::ProhibitSpecificModules]
+modules = Evil::Module SuperEvil::Module
+priority = 5
+
+[Modules::RequireExplicitPackage]
+exempt_scripts = 1
+priority = 5
+
+[NamingConventions::ProhibitMixedCaseSubs]
+priority = 6
+
+[NamingConventions::ProhibitMixedCaseVars]
+priority = 6
+
+[Subroutines::ProhibitBuiltinHomonyms]
+priority = 7
+
+[Subroutines::ProhibitExplicitReturnUndef]
+priority = 7
+
+[Subroutines::ProhibitSubroutinePrototypes]
+priority = 7
+
+[TestingAndDebugging::RequirePackageStricture]
+priority = 8
+
+[TestingAndDebugging::RequirePackageWarnings]
+priority = 8
+
+[ValuesAndExpressions::ProhibitConstantPragma]
+priority = 9
+
+[ValuesAndExpressions::ProhibitEmptyQuotes]
+priority = 9
+
+[ValuesAndExpressions::ProhibitInterpolationOfLiterals]
+priority = 9
+
+[ValuesAndExpressions::ProhibitLeadingZeros]
+priority = 9
+
+[ValuesAndExpressions::ProhibitNoisyQuotes]
+priority = 9
+
+[ValuesAndExpressions::RequireInterpolationOfMetachars]
+priority = 9
+
+[ValuesAndExpressions::RequireNumberSeparators]
+priority = 9
+
+[ValuesAndExpressions::RequireQuotedHeredocTerminator]
+priority = 9
+
+[ValuesAndExpressions::RequireUpperCaseHeredocTerminator]
+priority = 9
+
+#------------------------------------------------------------------------
+
+[Variables::ProhibitLocalVars]
+priority = 10
+
+[Variables::ProhibitPackageVars]
+priority = 10
+
+[Variables::ProhibitPunctuationVars]
+priority = 10
+
+[BuiltinFunctions::RequireGlobFunction]
+priority = 10
+
+[CodeLayout::ProhibitHardTabs]
+priority = 10
+
+[ControlStructures::ProhibitCStyleForLoops]
+priority = 10
+
+[ControlStructures::ProhibitUnlessBlocks]
+priority = 10
+
+[ControlStructures::ProhibitUntilBlocks]
+priority = 10
+
+[CodeLayout::RequireTrailingCommas]
+priority = 10
+
+[Modules::RequireVersionVar]
+priority = 10
+
+[CodeLayout::ProhibitQuotedWordLists]
+priority = 10
+
+[RegularExpressions::RequireExtendedFormatting]
+priority = 10
+
+[RegularExpressions::RequireLineBoundaryMatching]
+priority = 10
+
+[BuiltinFunctions::ProhibitLvalueSubstr]
+priority = 10
+
+[BuiltinFunctions::ProhibitSleepViaSelect]
+priority = 10
+
+[InputOutput::ProhibitOneArgSelect]
+priority = 10
+
+[ClassHierarchies::ProhibitOneArgBless]
+priority = 10
+
+[InputOutput::ProhibitBarewordFileHandles]
+priority = 10
\ No newline at end of file
--- /dev/null
+##########################################################################
+# This sample file demonstrates how to disable a Perl::Critic policy. Here,
+# all the policies are disabled, so with this configuration, Perl::Critic
+# will never report any violations. Typically, you'll only want to disable
+# those policies that you absolutely object to. For those that you agree
+# with, but don't want to strictly adhere to, you should assign them
+# a priority level rather than disabling them completely. See the
+# perlcriticrc.levels file for an example with differnt priority levels.
+##########################################################################
+
+[-BuiltinFunctions::ProhibitLvalueSubstr]
+[-BuiltinFunctions::ProhibitSleepViaSelect]
+[-BuiltinFunctions::ProhibitStringyEval]
+[-BuiltinFunctions::RequireBlockGrep]
+[-BuiltinFunctions::RequireBlockMap]
+[-BuiltinFunctions::RequireGlobFunction]
+[-ClassHierarchies::ProhibitOneArgBless]
+[-CodeLayout::ProhibitHardTabs]
+[-CodeLayout::ProhibitParensWithBuiltins]
+[-CodeLayout::ProhibitQuotedWordLists]
+[-CodeLayout::RequireTrailingCommas]
+[-ControlStructures::ProhibitCascadingIfElse]
+[-ControlStructures::ProhibitCStyleForLoops]
+[-ControlStructures::ProhibitPostfixControls]
+[-ControlStructures::ProhibitUnlessBlocks]
+[-ControlStructures::ProhibitUntilBlocks]
+[-InputOutput::ProhibitBacktickOperators]
+[-InputOutput::ProhibitBarewordFileHandles]
+[-InputOutput::ProhibitOneArgSelect]
+[-Modules::ProhibitMultiplePackages]
+[-Modules::ProhibitSpecificModules]
+[-Modules::RequireExplicitPackage]
+[-Modules::RequireBarewordIncludes]
+[-Modules::RequireVersionVar]
+[-NamingConventions::ProhibitMixedCaseSubs]
+[-NamingConventions::ProhibitMixedCaseVars]
+[-RegularExpressions::RequireExtendedFormatting]
+[-RegularExpressions::RequireLineBoundaryMatching]
+[-Subroutines::ProhibitBuiltinHomonyms]
+[-Subroutines::ProhibitExplicitReturnUndef]
+[-Subroutines::ProhibitSubroutinePrototypes]
+[-TestingAndDebugging::RequirePackageStricture]
+[-TestingAndDebugging::RequirePackageWarnings]
+[-ValuesAndExpressions::ProhibitConstantPragma]
+[-ValuesAndExpressions::ProhibitEmptyQuotes]
+[-ValuesAndExpressions::ProhibitInterpolationOfLiterals]
+[-ValuesAndExpressions::ProhibitLeadingZeros]
+[-ValuesAndExpressions::ProhibitNoisyQuotes]
+[-ValuesAndExpressions::RequireInterpolationOfMetachars]
+[-ValuesAndExpressions::RequireNumberSeparators]
+[-ValuesAndExpressions::RequireQuotedHeredocTerminator]
+[-ValuesAndExpressions::RequireUpperCaseHeredocTerminator]
+[-Variables::ProhibitLocalVars]
+[-Variables::ProhibitPackageVars]
+[-Variables::ProhibitPunctuationVars]
\ No newline at end of file
