#!/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.10';
$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);
my $viol_count = print_report(@violations);
my $status = $viol_count ? 2 : 0;
exit $status;

#----------------------------------------------------------------
# Begin subroutines

sub get_options {

    my %opts      = ();
    my @opt_specs = qw(priority=s profile=s noprofile
                       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 {
    for my $v (@_) { print "$v\n" }
    return scalar @_;
}

__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!

=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

Tells 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

By default, perlcritic looks in several directores for a configuration
file named F<.perlcriticrc>.  The C<-noprofile> option tells
perlcritic not to load any configuration file, thus defaulting to the
factory setup, which means that all the Policy modules that are
distributed with L<Perl::Critic> will be loaded.

=item -force

Directs Perl::Critic not to observe the magical C<"no critic">
pseudo-pragmas in the source code. See L<"BENDING THE RULES"> for more
information.

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

Display a brief summary of options and exits.

=item -man

Display 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 its factory setup, which means that all the
policies that are distributed with L<Perl::Critic> will be loaded.

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 on the appropriate 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.
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>

=head2 L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep>

=head2 L<Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap>

=head2 L<Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction>

=head2 L<Perl::Critic::Policy::CodeLayout::ProhibitHardTabs>

=head2 L<Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins>

=head2 L<Perl::Critic::Policy::CodeLayout::RequireTidyCode>

=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse>

=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops>

=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls>

=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks>

=head2 L<Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks>

=head2 L<Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators>

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

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

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

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

=head2 L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs>

=head2 L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars>

=head2 L<Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms>

=head2 L<Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef>

=head2 L<Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes>

=head2 L<Perl::Critic::Policy::TestingAndDebugging::RequirePackageStricture>

=head2 L<Perl::Critic::Policy::TestingAndDebugging::RequirePackageWarnings>

=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma>

=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes>

=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals>

=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros>

=head2 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes>

=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars>

=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators>

=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator>

=head2 L<Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator>

=head2 L<Perl::Critic::Policy::Variables::ProhibitLocalVars>

=head2 L<Perl::Critic::Policy::Variables::ProhibitPackageVars>

=head2 L<Perl::Critic::Policy::Variables::ProhibitPunctuationVars>

=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
editor.  C<emacs> users can put the following code in your F<.emacs>
configuration file:

  (defun perlcritic ()
    (interactive)
    (shell-command-on-region (point) (mark) "perlcritic"))

  (global-set-key "\C-xpc" 'perlcritic) 

Pressing "Control-x p c" will run C<perlcritic> on the current region
and the output will appear in a separate buffer.  My E-Lisp skills are
pretty weak, so I'd appreciate any tips for improvement on this.
Also, C<vi> fans are welcome to submit similar code and I'll publish
it here.

=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
