#!/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.12';
$VERSION = eval $VERSION;    ## no critic

#---------------------------------------------------------------
# Begin script

my %opts   = get_options();               #Side-affects @ARGV
my $source = get_input( shift @ARGV );    #Only one arg allowed

my $critic = Perl::Critic->new(
    -priority => $opts{priority},
    -profile  => $opts{profile},
    -force    => $opts{force},
) or exit 1;

my @violations = $critic->critique($source);
print_report($source, $opts{verbose}, @violations);
my $status = scalar @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);
    GetOptions( \%opts, @opt_specs ) || pod2usage(1);       #Exits
    if ( $opts{help} )    { pod2usage( -verbose => 1 )  }   #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
    }

    if ( @ARGV > 1 ) {
        my $msg = 'Only one file at a time please';
        pod2usage( -exitstatus => 1, -message => $msg );    #Exits
    }

    #Override profile, if -noprofile
    if ( $opts{noprofile} ) { $opts{profile} = $EMPTY }

    #All good!
    return %opts;
}

sub get_input {

    if ( my $file = shift ) {

        #Reading code from a file...
        -f $file || die "$file is not a file";
        return $file;
    }
    else {

        #Reading code from STDIN
        my $code_string = do { local $RS; <STDIN> };    #Slurping
        $code_string =~ m{ \S+ }x || die 'Nothing to critique';
        return \$code_string;    #Convert to SCALAR ref for PPI
    }
}

sub print_report {
    my ($file, $verbosity, @violations) = @_;;
    $file = -f $file ? $file : 'stdin';
    $verbosity ||= 2;
    
    my %FORMAT_OF = ( 
       1 => '%f:%l:%c:%m', 
       2 => '%m at line %l, column %c. %e.',
       3 => '[%p] %m at line %l, column %c. %e',
       4 => "[%p] %m at line %l, column %c. %e.\n%d",
    );

    my $fmt = $verbosity =~ m/^[+-]?\d+$/ ? 
	($FORMAT_OF{$verbosity} || $FORMAT_OF{2}) : $verbosity;
    $fmt =~ s/\%f/$file/g; #HACK! Vilation objects don't know the file name

    local $Perl::Critic::Violation::FORMAT = $fmt;  ## no critic
    for (@violations) { print "$_\n" }
    return 1;
}

__END__

=pod

=head1 NAME

perlcritic - Command-line interface to critique Perl souce

=head1 SYNOPSIS

 perlcritic [options] FILE  #Read from FILE
 perlcritic [options]       #Read from STDIN

=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 enforce the
coding standards outlined in 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,
L<Test::Perl::Critic> provides a nice interface that is suitable for
test scripts.

=head1 ARGUMENTS

The only argument is the path to the file you wish to analyze.  No
more than one file can be specified at a time.  If the file is not
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>).

=over 8

=item -priority N

Sets the the maximum priority value of Policies that should be
loaded.  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 -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 -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, perlcritic reports violations using one of the pre-defined
formats outlined below.  If given a string, it is interpreted to be
an actual format specification.  

  Verbosity     Format Specification
  -----------   ----------------------------------------------------
  1             "%f:%l:%c:%m."
  2 (default)   "%m at line %l, column %c. %e."
  3             "[%p] %m at line %1, column %c. %e."
  4             "[%p] %m at line %1, column %c. %e. %d"

Formats are a combination of literal and escape characters similar to
the way C<sprintf> works.  Do not put any metacharacters (like "\n")
in your format.  Valid escape characters are:

  Escape    Meaning
  -------   -------------------------------------------------------
  %m        Brief description of the violation
  %f        Name of the file where the violation ocurred.
  %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

The purpose of these formats is to provide some compatibility with
editors that have an qinterface for parsing certain kinds of input. See
L<"EDITOR INGEGRATION"> 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

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 ommit 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::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::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::RequireTidyCode>

Must run code through L<perltidy>

=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::Modules::ProhibitMultiplePackages>

Put packages (especially subclasses) in separate files

=head2 L<Perl::Critic::Policy::Modules::ProhibitRequireStatements>

Write C<use 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::ProhibitUnpackagedCode>

Always make the C<package> explicit

=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>

=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 knowlingly 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.

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
