Login
Importing Perl-Critic-0.13.
authorJeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Thu, 3 Nov 2005 05:44:51 +0000 (05:44 +0000)
committerJeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Thu, 3 Nov 2005 05:44:51 +0000 (05:44 +0000)
73 files changed:
Build.PL [new file with mode: 0755]
Changes [new file with mode: 0755]
INSTALL [new file with mode: 0755]
LICENSE [new file with mode: 0755]
MANIFEST [new file with mode: 0644]
META.yml [new file with mode: 0644]
Makefile.PL [new file with mode: 0755]
README [new file with mode: 0755]
TODO [new file with mode: 0755]
bin/perlcritic [new file with mode: 0755]
lib/Perl/Critic.pm [new file with mode: 0755]
lib/Perl/Critic/Config.pm [new file with mode: 0644]
lib/Perl/Critic/Policy.pm [new file with mode: 0644]
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitLvalueSubstr.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitSleepViaSelect.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringyEval.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrep.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockMap.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/BuiltinFunctions/RequireGlobFunction.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ClassHierarchies/ProhibitOneArgBless.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/CodeLayout/ProhibitHardTabs.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/CodeLayout/ProhibitParensWithBuiltins.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/CodeLayout/ProhibitQuotedWordLists.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/CodeLayout/RequireTidyCode.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/CodeLayout/RequireTrailingCommas.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ControlStructures/ProhibitCStyleForLoops.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ControlStructures/ProhibitCascadingIfElse.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ControlStructures/ProhibitPostfixControls.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ControlStructures/ProhibitUnlessBlocks.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ControlStructures/ProhibitUntilBlocks.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/InputOutput/ProhibitBacktickOperators.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/InputOutput/ProhibitBarewordFileHandles.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/InputOutput/ProhibitOneArgSelect.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/InputOutput/ProhibitTwoArgOpen.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Modules/ProhibitMultiplePackages.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Modules/ProhibitSpecificModules.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Modules/RequireBarewordIncludes.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Modules/RequireExplicitPackage.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Modules/RequireVersionVar.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseSubs.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/RegularExpressions/RequireExtendedFormatting.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/RegularExpressions/RequireLineBoundaryMatching.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Subroutines/ProhibitBuiltinHomonyms.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Subroutines/ProhibitExplicitReturnUndef.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Subroutines/ProhibitSubroutinePrototypes.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/TestingAndDebugging/RequirePackageStricture.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/TestingAndDebugging/RequirePackageWarnings.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitConstantPragma.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyQuotes.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitInterpolationOfLiterals.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLeadingZeros.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNoisyQuotes.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ValuesAndExpressions/RequireInterpolationOfMetachars.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ValuesAndExpressions/RequireNumberSeparators.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ValuesAndExpressions/RequireQuotedHeredocTerminator.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/ValuesAndExpressions/RequireUpperCaseHeredocTerminator.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Variables/ProhibitLocalVars.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Variables/ProhibitPackageVars.pm [new file with mode: 0755]
lib/Perl/Critic/Policy/Variables/ProhibitPunctuationVars.pm [new file with mode: 0755]
lib/Perl/Critic/Utils.pm [new file with mode: 0644]
lib/Perl/Critic/Violation.pm [new file with mode: 0644]
t/00_modules.t [new file with mode: 0755]
t/01_config.t [new file with mode: 0755]
t/02_policies.t [new file with mode: 0755]
t/03_pragmas.t [new file with mode: 0755]
t/04_criticize.t [new file with mode: 0755]
t/98_pod-syntax.t [new file with mode: 0755]
t/99_pod-coverage.t [new file with mode: 0755]
t/samples/perlcriticrc.all [new file with mode: 0755]
t/samples/perlcriticrc.levels [new file with mode: 0755]
t/samples/perlcriticrc.none [new file with mode: 0755]

diff --git a/Build.PL b/Build.PL
new file mode 100755 (executable)
index 0000000..ba4359f
--- /dev/null
+++ b/Build.PL
@@ -0,0 +1,31 @@
+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();
diff --git a/Changes b/Changes
new file mode 100755 (executable)
index 0000000..dd6b467
--- /dev/null
+++ b/Changes
@@ -0,0 +1,287 @@
+[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.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/INSTALL b/INSTALL
new file mode 100755 (executable)
index 0000000..eecb036
--- /dev/null
+++ b/INSTALL
@@ -0,0 +1,36 @@
+######################################################################
+#                            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
diff --git a/LICENSE b/LICENSE
new file mode 100755 (executable)
index 0000000..691d481
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,377 @@
+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
+
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644 (file)
index 0000000..15e5960
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,73 @@
+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
diff --git a/META.yml b/META.yml
new file mode 100644 (file)
index 0000000..688e2fe
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,20 @@
+# 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
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100755 (executable)
index 0000000..fe22df0
--- /dev/null
@@ -0,0 +1,24 @@
+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,
+                             },
+
+);
diff --git a/README b/README
new file mode 100755 (executable)
index 0000000..b9f4af2
--- /dev/null
+++ b/README
@@ -0,0 +1,478 @@
+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.
+
diff --git a/TODO b/TODO
new file mode 100755 (executable)
index 0000000..a1aee6f
--- /dev/null
+++ b/TODO
@@ -0,0 +1,24 @@
+######################################################################
+#                            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.
diff --git a/bin/perlcritic b/bin/perlcritic
new file mode 100755 (executable)
index 0000000..e0e083c
--- /dev/null
@@ -0,0 +1,679 @@
+#!/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
diff --git a/lib/Perl/Critic.pm b/lib/Perl/Critic.pm
new file mode 100755 (executable)
index 0000000..b569429
--- /dev/null
@@ -0,0 +1,718 @@
+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
diff --git a/lib/Perl/Critic/Config.pm b/lib/Perl/Critic/Config.pm
new file mode 100644 (file)
index 0000000..2eb8b09
--- /dev/null
@@ -0,0 +1,493 @@
+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
diff --git a/lib/Perl/Critic/Policy.pm b/lib/Perl/Critic/Policy.pm
new file mode 100644 (file)
index 0000000..efa56ab
--- /dev/null
@@ -0,0 +1,105 @@
+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
diff --git a/lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitLvalueSubstr.pm b/lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitLvalueSubstr.pm
new file mode 100755 (executable)
index 0000000..280693e
--- /dev/null
@@ -0,0 +1,60 @@
+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
diff --git a/lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitSleepViaSelect.pm b/lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitSleepViaSelect.pm
new file mode 100755 (executable)
index 0000000..319051b
--- /dev/null
@@ -0,0 +1,67 @@
+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
diff --git a/lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringyEval.pm b/lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringyEval.pm
new file mode 100755 (executable)
index 0000000..a4bf02b
--- /dev/null
@@ -0,0 +1,62 @@
+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.
diff --git a/lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrep.pm b/lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrep.pm
new file mode 100755 (executable)
index 0000000..63ebfd0
--- /dev/null
@@ -0,0 +1,66 @@
+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.
diff --git a/lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockMap.pm b/lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockMap.pm
new file mode 100755 (executable)
index 0000000..180b666
--- /dev/null
@@ -0,0 +1,66 @@
+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.
diff --git a/lib/Perl/Critic/Policy/BuiltinFunctions/RequireGlobFunction.pm b/lib/Perl/Critic/Policy/BuiltinFunctions/RequireGlobFunction.pm
new file mode 100755 (executable)
index 0000000..53ed42e
--- /dev/null
@@ -0,0 +1,52 @@
+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.
diff --git a/lib/Perl/Critic/Policy/ClassHierarchies/ProhibitOneArgBless.pm b/lib/Perl/Critic/Policy/ClassHierarchies/ProhibitOneArgBless.pm
new file mode 100755 (executable)
index 0000000..2f0bed1
--- /dev/null
@@ -0,0 +1,62 @@
+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
diff --git a/lib/Perl/Critic/Policy/CodeLayout/ProhibitHardTabs.pm b/lib/Perl/Critic/Policy/CodeLayout/ProhibitHardTabs.pm
new file mode 100755 (executable)
index 0000000..fc3c498
--- /dev/null
@@ -0,0 +1,78 @@
+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
diff --git a/lib/Perl/Critic/Policy/CodeLayout/ProhibitParensWithBuiltins.pm b/lib/Perl/Critic/Policy/CodeLayout/ProhibitParensWithBuiltins.pm
new file mode 100755 (executable)
index 0000000..4f19f8e
--- /dev/null
@@ -0,0 +1,75 @@
+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.
diff --git a/lib/Perl/Critic/Policy/CodeLayout/ProhibitQuotedWordLists.pm b/lib/Perl/Critic/Policy/CodeLayout/ProhibitQuotedWordLists.pm
new file mode 100755 (executable)
index 0000000..4e61131
--- /dev/null
@@ -0,0 +1,120 @@
+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
diff --git a/lib/Perl/Critic/Policy/CodeLayout/RequireTidyCode.pm b/lib/Perl/Critic/Policy/CodeLayout/RequireTidyCode.pm
new file mode 100755 (executable)
index 0000000..3c682ac
--- /dev/null
@@ -0,0 +1,100 @@
+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
diff --git a/lib/Perl/Critic/Policy/CodeLayout/RequireTrailingCommas.pm b/lib/Perl/Critic/Policy/CodeLayout/RequireTrailingCommas.pm
new file mode 100755 (executable)
index 0000000..fb898c0
--- /dev/null
@@ -0,0 +1,85 @@
+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
diff --git a/lib/Perl/Critic/Policy/ControlStructures/ProhibitCStyleForLoops.pm b/lib/Perl/Critic/Policy/ControlStructures/ProhibitCStyleForLoops.pm
new file mode 100755 (executable)
index 0000000..9f9ab8e
--- /dev/null
@@ -0,0 +1,69 @@
+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
diff --git a/lib/Perl/Critic/Policy/ControlStructures/ProhibitCascadingIfElse.pm b/lib/Perl/Critic/Policy/ControlStructures/ProhibitCascadingIfElse.pm
new file mode 100755 (executable)
index 0000000..a693a7a
--- /dev/null
@@ -0,0 +1,93 @@
+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.
+
+
diff --git a/lib/Perl/Critic/Policy/ControlStructures/ProhibitPostfixControls.pm b/lib/Perl/Critic/Policy/ControlStructures/ProhibitPostfixControls.pm
new file mode 100755 (executable)
index 0000000..5f32d18
--- /dev/null
@@ -0,0 +1,147 @@
+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
diff --git a/lib/Perl/Critic/Policy/ControlStructures/ProhibitUnlessBlocks.pm b/lib/Perl/Critic/Policy/ControlStructures/ProhibitUnlessBlocks.pm
new file mode 100755 (executable)
index 0000000..2362afd
--- /dev/null
@@ -0,0 +1,64 @@
+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
diff --git a/lib/Perl/Critic/Policy/ControlStructures/ProhibitUntilBlocks.pm b/lib/Perl/Critic/Policy/ControlStructures/ProhibitUntilBlocks.pm
new file mode 100755 (executable)
index 0000000..385eb89
--- /dev/null
@@ -0,0 +1,64 @@
+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
diff --git a/lib/Perl/Critic/Policy/InputOutput/ProhibitBacktickOperators.pm b/lib/Perl/Critic/Policy/InputOutput/ProhibitBacktickOperators.pm
new file mode 100755 (executable)
index 0000000..29f1964
--- /dev/null
@@ -0,0 +1,65 @@
+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.
diff --git a/lib/Perl/Critic/Policy/InputOutput/ProhibitBarewordFileHandles.pm b/lib/Perl/Critic/Policy/InputOutput/ProhibitBarewordFileHandles.pm
new file mode 100755 (executable)
index 0000000..7f0d3d9
--- /dev/null
@@ -0,0 +1,61 @@
+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
diff --git a/lib/Perl/Critic/Policy/InputOutput/ProhibitOneArgSelect.pm b/lib/Perl/Critic/Policy/InputOutput/ProhibitOneArgSelect.pm
new file mode 100755 (executable)
index 0000000..3216848
--- /dev/null
@@ -0,0 +1,69 @@
+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
diff --git a/lib/Perl/Critic/Policy/InputOutput/ProhibitTwoArgOpen.pm b/lib/Perl/Critic/Policy/InputOutput/ProhibitTwoArgOpen.pm
new file mode 100755 (executable)
index 0000000..be9fd17
--- /dev/null
@@ -0,0 +1,75 @@
+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
diff --git a/lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.pm b/lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.pm
new file mode 100755 (executable)
index 0000000..561e873
--- /dev/null
@@ -0,0 +1,118 @@
+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
diff --git a/lib/Perl/Critic/Policy/Modules/ProhibitMultiplePackages.pm b/lib/Perl/Critic/Policy/Modules/ProhibitMultiplePackages.pm
new file mode 100755 (executable)
index 0000000..a046fed
--- /dev/null
@@ -0,0 +1,54 @@
+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.
diff --git a/lib/Perl/Critic/Policy/Modules/ProhibitSpecificModules.pm b/lib/Perl/Critic/Policy/Modules/ProhibitSpecificModules.pm
new file mode 100755 (executable)
index 0000000..ae63a7c
--- /dev/null
@@ -0,0 +1,86 @@
+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
diff --git a/lib/Perl/Critic/Policy/Modules/RequireBarewordIncludes.pm b/lib/Perl/Critic/Policy/Modules/RequireBarewordIncludes.pm
new file mode 100755 (executable)
index 0000000..8a34bbb
--- /dev/null
@@ -0,0 +1,88 @@
+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
diff --git a/lib/Perl/Critic/Policy/Modules/RequireExplicitPackage.pm b/lib/Perl/Critic/Policy/Modules/RequireExplicitPackage.pm
new file mode 100755 (executable)
index 0000000..d943410
--- /dev/null
@@ -0,0 +1,104 @@
+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
diff --git a/lib/Perl/Critic/Policy/Modules/RequireVersionVar.pm b/lib/Perl/Critic/Policy/Modules/RequireVersionVar.pm
new file mode 100755 (executable)
index 0000000..3c23606
--- /dev/null
@@ -0,0 +1,104 @@
+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
diff --git a/lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseSubs.pm b/lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseSubs.pm
new file mode 100755 (executable)
index 0000000..a55b147
--- /dev/null
@@ -0,0 +1,63 @@
+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.
diff --git a/lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.pm b/lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.pm
new file mode 100755 (executable)
index 0000000..69be0a3
--- /dev/null
@@ -0,0 +1,71 @@
+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.
diff --git a/lib/Perl/Critic/Policy/RegularExpressions/RequireExtendedFormatting.pm b/lib/Perl/Critic/Policy/RegularExpressions/RequireExtendedFormatting.pm
new file mode 100755 (executable)
index 0000000..afad8ff
--- /dev/null
@@ -0,0 +1,82 @@
+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
diff --git a/lib/Perl/Critic/Policy/RegularExpressions/RequireLineBoundaryMatching.pm b/lib/Perl/Critic/Policy/RegularExpressions/RequireLineBoundaryMatching.pm
new file mode 100755 (executable)
index 0000000..d6ff22c
--- /dev/null
@@ -0,0 +1,72 @@
+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
diff --git a/lib/Perl/Critic/Policy/Subroutines/ProhibitBuiltinHomonyms.pm b/lib/Perl/Critic/Policy/Subroutines/ProhibitBuiltinHomonyms.pm
new file mode 100755 (executable)
index 0000000..7cc4351
--- /dev/null
@@ -0,0 +1,57 @@
+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.
diff --git a/lib/Perl/Critic/Policy/Subroutines/ProhibitExplicitReturnUndef.pm b/lib/Perl/Critic/Policy/Subroutines/ProhibitExplicitReturnUndef.pm
new file mode 100755 (executable)
index 0000000..a48376f
--- /dev/null
@@ -0,0 +1,101 @@
+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.
diff --git a/lib/Perl/Critic/Policy/Subroutines/ProhibitSubroutinePrototypes.pm b/lib/Perl/Critic/Policy/Subroutines/ProhibitSubroutinePrototypes.pm
new file mode 100755 (executable)
index 0000000..f1eb67e
--- /dev/null
@@ -0,0 +1,47 @@
+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.
diff --git a/lib/Perl/Critic/Policy/TestingAndDebugging/RequirePackageStricture.pm b/lib/Perl/Critic/Policy/TestingAndDebugging/RequirePackageStricture.pm
new file mode 100755 (executable)
index 0000000..eea58b6
--- /dev/null
@@ -0,0 +1,89 @@
+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
diff --git a/lib/Perl/Critic/Policy/TestingAndDebugging/RequirePackageWarnings.pm b/lib/Perl/Critic/Policy/TestingAndDebugging/RequirePackageWarnings.pm
new file mode 100755 (executable)
index 0000000..0370a62
--- /dev/null
@@ -0,0 +1,92 @@
+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
diff --git a/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitConstantPragma.pm b/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitConstantPragma.pm
new file mode 100755 (executable)
index 0000000..8bc0de6
--- /dev/null
@@ -0,0 +1,53 @@
+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.
diff --git a/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyQuotes.pm b/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyQuotes.pm
new file mode 100755 (executable)
index 0000000..e30507e
--- /dev/null
@@ -0,0 +1,68 @@
+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.
diff --git a/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitInterpolationOfLiterals.pm b/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitInterpolationOfLiterals.pm
new file mode 100755 (executable)
index 0000000..4d94efb
--- /dev/null
@@ -0,0 +1,121 @@
+
+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
diff --git a/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLeadingZeros.pm b/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLeadingZeros.pm
new file mode 100755 (executable)
index 0000000..47cd309
--- /dev/null
@@ -0,0 +1,51 @@
+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.
diff --git a/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNoisyQuotes.pm b/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNoisyQuotes.pm
new file mode 100755 (executable)
index 0000000..726702a
--- /dev/null
@@ -0,0 +1,74 @@
+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
diff --git a/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireInterpolationOfMetachars.pm b/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireInterpolationOfMetachars.pm
new file mode 100755 (executable)
index 0000000..9628e5f
--- /dev/null
@@ -0,0 +1,68 @@
+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.
diff --git a/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireNumberSeparators.pm b/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireNumberSeparators.pm
new file mode 100755 (executable)
index 0000000..5be50a7
--- /dev/null
@@ -0,0 +1,97 @@
+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
diff --git a/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireQuotedHeredocTerminator.pm b/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireQuotedHeredocTerminator.pm
new file mode 100755 (executable)
index 0000000..325bd50
--- /dev/null
@@ -0,0 +1,65 @@
+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.
diff --git a/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireUpperCaseHeredocTerminator.pm b/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireUpperCaseHeredocTerminator.pm
new file mode 100755 (executable)
index 0000000..d05c44c
--- /dev/null
@@ -0,0 +1,62 @@
+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.
diff --git a/lib/Perl/Critic/Policy/Variables/ProhibitLocalVars.pm b/lib/Perl/Critic/Policy/Variables/ProhibitLocalVars.pm
new file mode 100755 (executable)
index 0000000..27d101e
--- /dev/null
@@ -0,0 +1,78 @@
+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
diff --git a/lib/Perl/Critic/Policy/Variables/ProhibitPackageVars.pm b/lib/Perl/Critic/Policy/Variables/ProhibitPackageVars.pm
new file mode 100755 (executable)
index 0000000..f9878ad
--- /dev/null
@@ -0,0 +1,106 @@
+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.
diff --git a/lib/Perl/Critic/Policy/Variables/ProhibitPunctuationVars.pm b/lib/Perl/Critic/Policy/Variables/ProhibitPunctuationVars.pm
new file mode 100755 (executable)
index 0000000..32d4a2b
--- /dev/null
@@ -0,0 +1,67 @@
+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.
diff --git a/lib/Perl/Critic/Utils.pm b/lib/Perl/Critic/Utils.pm
new file mode 100644 (file)
index 0000000..eb5b5e7
--- /dev/null
@@ -0,0 +1,307 @@
+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.
diff --git a/lib/Perl/Critic/Violation.pm b/lib/Perl/Critic/Violation.pm
new file mode 100644 (file)
index 0000000..14818b4
--- /dev/null
@@ -0,0 +1,288 @@
+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
diff --git a/t/00_modules.t b/t/00_modules.t
new file mode 100755 (executable)
index 0000000..90da38c
--- /dev/null
@@ -0,0 +1,77 @@
+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");
+}
+
diff --git a/t/01_config.t b/t/01_config.t
new file mode 100755 (executable)
index 0000000..32e92f1
--- /dev/null
@@ -0,0 +1,141 @@
+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} );
+
+
+
+
+
+
+
+
+
+
+
diff --git a/t/02_policies.t b/t/02_policies.t
new file mode 100755 (executable)
index 0000000..1e5c2f9
--- /dev/null
@@ -0,0 +1,2013 @@
+#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;
+}
diff --git a/t/03_pragmas.t b/t/03_pragmas.t
new file mode 100755 (executable)
index 0000000..f1572b6
--- /dev/null
@@ -0,0 +1,248 @@
+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;
+}
diff --git a/t/04_criticize.t b/t/04_criticize.t
new file mode 100755 (executable)
index 0000000..3383f51
--- /dev/null
@@ -0,0 +1,8 @@
+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
diff --git a/t/98_pod-syntax.t b/t/98_pod-syntax.t
new file mode 100755 (executable)
index 0000000..510b4ad
--- /dev/null
@@ -0,0 +1,8 @@
+#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
diff --git a/t/99_pod-coverage.t b/t/99_pod-coverage.t
new file mode 100755 (executable)
index 0000000..1498dfb
--- /dev/null
@@ -0,0 +1,9 @@
+#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
diff --git a/t/samples/perlcriticrc.all b/t/samples/perlcriticrc.all
new file mode 100755 (executable)
index 0000000..a6002e9
--- /dev/null
@@ -0,0 +1,53 @@
+##########################################################################
+# 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]
diff --git a/t/samples/perlcriticrc.levels b/t/samples/perlcriticrc.levels
new file mode 100755 (executable)
index 0000000..2049317
--- /dev/null
@@ -0,0 +1,151 @@
+##########################################################################
+# 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
diff --git a/t/samples/perlcriticrc.none b/t/samples/perlcriticrc.none
new file mode 100755 (executable)
index 0000000..ca4deb1
--- /dev/null
@@ -0,0 +1,55 @@
+##########################################################################
+# 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