#!/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
