#######################################################################
#      $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/Test-Perl-Critic-1.01/lib/Test/Perl/Critic.pm $
#     $Date: 2007-01-24 22:22:10 -0800 (Wed, 24 Jan 2007) $
#   $Author: thaljef $
# $Revision: 1183 $
########################################################################

package Test::Perl::Critic;

use strict;
use warnings;
use Carp qw(croak);
use English qw(-no_match_vars);
use Test::Builder qw();
use Perl::Critic qw();
use Perl::Critic::Violation qw();
use Perl::Critic::Utils;


#---------------------------------------------------------------------------

our $VERSION = 1.01;

#---------------------------------------------------------------------------

my $TEST        = Test::Builder->new();
my %CRITIC_ARGS = ();

#---------------------------------------------------------------------------

sub import {

    my ( $self, %args ) = @_;
    my $caller = caller;

    no strict 'refs';  ## no critic
    *{ $caller . '::critic_ok' }     = \&critic_ok;
    *{ $caller . '::all_critic_ok' } = \&all_critic_ok;

    $TEST->exported_to($caller);

    # -format is supported for backward compatibility
    if( exists $args{-format} ){ $args{-verbose} = $args{-format}; }
    %CRITIC_ARGS = %args;

    return 1;
}

#---------------------------------------------------------------------------

sub critic_ok {

    my ( $file, $test_name ) = @_;
    croak q{no file specified} if not defined $file;
    croak qq{"$file" does not exist} if not -f $file;
    $test_name ||= qq{Test::Perl::Critic for "$file"};

    my $critic = undef;
    my @violations = ();
    my $ok = 0;

    # Run Perl::Critic
    eval {
        # TODO: Should $critic be a global singleton?
        $critic     = Perl::Critic->new( %CRITIC_ARGS );
        @violations = $critic->critique( $file );
        $ok         = not scalar @violations;
    };

    # Evaluate results
    $TEST->ok( $ok, $test_name );


    if ($EVAL_ERROR) {           # Trap exceptions from P::C
        $TEST->diag( "\n" );     # Just to get on a new line.
        $TEST->diag( qq{Perl::Critic had errors in "$file":} );
        $TEST->diag( qq{\t$EVAL_ERROR} );
    }
    elsif ( not $ok ) {          # Report Policy violations
        $TEST->diag( "\n" );     # Just to get on a new line.
        $TEST->diag( qq{Perl::Critic found these violations in "$file":} );

        my $verbose = $critic->config->verbose();
        Perl::Critic::Violation::set_format( $verbose );
        for my $viol (@violations) { $TEST->diag("$viol") }
    }

    return $ok;
}

#---------------------------------------------------------------------------

sub all_critic_ok {

    my @dirs = @_ ? @_ : _starting_points();
    my @files = all_code_files( @dirs );
    $TEST->plan( tests => scalar @files );

    my $okays = grep { critic_ok($_) } @files;
    return $okays == @files;
}

#---------------------------------------------------------------------------

sub all_code_files {
    my @dirs = @_ ? @_ : _starting_points();
    return Perl::Critic::Utils::all_perl_files(@dirs);
}

#---------------------------------------------------------------------------

sub _starting_points {
    return -e 'blib' ? 'blib' : 'lib';
}

#---------------------------------------------------------------------------

1;


__END__

=pod

=for stopwords API

=head1 NAME

Test::Perl::Critic - Use Perl::Critic in test programs

=head1 SYNOPSIS

Test one file:

  use Test::Perl::Critic;
  use Test::More tests => 1;
  critic_ok($file);

Or test all files in one or more directories:

  use Test::Perl::Critic;
  all_critic_ok($dir_1, $dir_2, $dir_N );

Or test all files in a distribution:

  use Test::Perl::Critic;
  all_critic_ok();

Recommended usage for CPAN distributions:

  use strict;
  use warnings;
  use File::Spec;
  use Test::More;
  use English qw(-no_match_vars);

  if ( not $ENV{TEST_AUTHOR} ) {
      my $msg = 'Author test.  Set $ENV{TEST_AUTHOR} to a true value to run.';
      plan( skip_all => $msg );
  }

  eval { require Test::Perl::Critic; };

  if ( $EVAL_ERROR ) {
     my $msg = 'Test::Perl::Critic required to criticise code';
     plan( skip_all => $msg );
  }

  my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' );
  Test::Perl::Critic->import( -profile => $rcfile );
  all_critic_ok();


=head1 DESCRIPTION

Test::Perl::Critic wraps the L<Perl::Critic> engine in a convenient
subroutine suitable for test programs written using the L<Test::More>
framework.  This makes it easy to integrate coding-standards
enforcement into the build process.  For ultimate convenience (at the
expense of some flexibility), see the L<criticism> pragma.

If you'd like to try L<Perl::Critic> without installing anything,
there is a web-service available at L<http://perlcritic.com>.  The
web-service does not yet support all the configuration features that
are available in the native Perl::Critic API, but it should give you a
good idea of what it does.  You can also invoke the perlcritic
web-service from the command line by doing an HTTP-post, such as one
of these:

  $> POST http://perlcritic.com/perl/critic.pl < MyModule.pm
  $> lwp-request -m POST http://perlcritic.com/perl/critic.pl < MyModule.pm
  $> wget -q -O - --post-file=MyModule.pm http://perlcritic.com/perl/critic.pl

Please note that the perlcritic web-service is still alpha code.  The
URL and interface to the service are subject to change.



=head1 SUBROUTINES

=over 8

=item critic_ok( $FILE [, $TEST_NAME ] )

Okays the test if Perl::Critic does not find any violations in $FILE.
If it does, the violations will be reported in the test diagnostics.
The optional second argument is the name of test, which defaults to
"Perl::Critic test for $FILE".

If you use this form, you should emit your own L<Test::More> plan first.

=item all_critic_ok( [ @DIRECTORIES ] )

Runs C<critic_ok()> for all Perl files beneath the given list of
C<@DIRECTORIES>.  If C<@DIRECTORIES> is empty or not given, this
function tries to find all Perl files in the F<blib/> directory.  If
the F<blib/> directory does not exist, then it tries the F<lib/>
directory.  Returns true if all files are okay, or false if any file
fails.

This subroutine emits its own L<Test::More> plan, so you do not need
to specify an expected number of tests yourself.

=item all_code_files ( [@DIRECTORIES] )

B<DEPRECATED:> Use the C<all_perl_files> subroutine that is exported
by L<Perl::Critic::Utils> instead.

Returns a list of all the Perl files found beneath each DIRECTORY, If
@DIRECTORIES is an empty list, defaults to F<blib/>.  If F<blib/> does
not exist, it tries F<lib/>.  Skips any files in CVS or Subversion
directories.

A Perl file is:

=over 4

=item * Any file that ends in F<.PL>, F<.pl>, F<.pm>, or F<.t>

=item * Any file that has a first line with a shebang containing 'perl'

=back

=back

=head1 CONFIGURATION

L<Perl::Critic> is highly configurable.  By default,
Test::Perl::Critic invokes Perl::Critic with it's default
configuration.  But if you have developed your code against a custom
Perl::Critic configuration, you will want to configure
Test::Perl::Critic to do the same.

Any arguments given to the C<use> pragma will be passed into the
L<Perl::Critic> constructor.  So if you have developed your code using
a custom F<~/.perlcriticrc> file, you can direct Test::Perl::Critic to
use a custom file too.

  use Test::Perl::Critic (-profile => 't/perlcriticrc');
  all_critic_ok();

Now place a copy of your own F<~/.perlcriticrc> file in the distribution
as F<t/perlcriticrc>.  Then, C<critic_ok()> will be run on all Perl
files in this distribution using this same Perl::Critic configuration.
See the L<Perl::Critic> documentation for details on the
F<.perlcriticrc> file format.

Any argument that is supported by the L<Perl::Critic> constructor can
be passed through this interface.  For example, you can also set the
minimum severity level, or include & exclude specific policies like
this:

  use Test::Perl::Critic (-severity => 2, -exclude => ['RequireRcsKeywords']);
  all_critic_ok();

See the L<Perl::Critic> documentation for complete details on it's
options and arguments.

=head1 DIAGNOSTIC DETAILS

By default, Test::Perl::Critic displays basic information about each
Policy violation in the diagnostic output of the test.  You can
customize the format and content of this information by using the
C<-verbose> option.  This behaves exactly like the C<-verbose> switch
on the F<perlcritic> program.  For example:

  use Test::Perl::Critic (-verbose => 6);

  #or...

  use Test::Perl::Critic (-verbose => '%f: %m at %l');

If given a number, Test::Perl::Critic reports violations using one of
the predefined formats described below. If given a string, it is
interpreted to be an actual format specification. If the C<-verbose>
option is not specified, it defaults to 3.

    Verbosity     Format Specification
    -----------   -------------------------------------------------------------
     1            "%f:%l:%c:%m\n",
     2            "%f: (%l:%c) %m\n",
     3            "%m at %f line %l\n",
     4            "%m at line %l, column %c.  %e.  (Severity: %s)\n",
     5            "%f: %m at line %l, column %c.  %e.  (Severity: %s)\n",
     6            "%m at line %l, near '%r'.  (Severity: %s)\n",
     7            "%f: %m at line %l near '%r'.  (Severity: %s)\n",
     8            "[%p] %m at line %l, column %c.  (Severity: %s)\n",
     9            "[%p] %m at line %l, near '%r'.  (Severity: %s)\n",
    10            "%m at line %l, column %c.\n  %p (Severity: %s)\n%d\n",
    11            "%m at line %l, near '%r'.\n  %p (Severity: %s)\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
    -------   ----------------------------------------------------------------
    %c        Column number where the violation occurred
    %d        Full diagnostic discussion of the violation
    %e        Explanation of violation or page numbers in PBP
    %f        Name of the file where the violation occurred.
    %l        Line number where the violation occurred
    %m        Brief description of the violation
    %P        Name of the Policy module that created the violation
    %p        Name of the Policy without the Perl::Critic::Policy:: prefix
    %r        The string of source code that caused the violation
    %s        The severity level of the violation

=head1 CAVEATS

Despite the convenience of using a test script to enforce your coding
standards, there are some inherent risks when distributing those tests
to others.  Since you don't know which version of L<Perl::Critic> the
end-user has and whether they have installed any additional Policy
modules, you can't really be sure that your code will pass the
Test::Perl::Critic tests on another machine.

B<For these reasons, we strongly advise you to make your perlcritic
tests optional, or exclude them from the distribution entirely.>

The recommended usage in the L<"SYNOPSIS"> section illustrates one way
to make your F<perlcritic.t> test optional.  Also, you should B<not>
list Test::Perl::Critic as a requirement in your build script.  These
tests are only relevant to the author and should not be a prerequisite
for end-use.

See L<http://www.chrisdolan.net/talk/index.php/2005/11/14/private-regression-tests/>
for an interesting discussion about Test::Perl::Critic and other types
of author-only regression tests.

=head1 EXPORTS

  critic_ok()
  all_critic_ok()

=head1 PERFORMANCE HACKS

If you want a small performance boost, you can tell PPI to cache
results from previous parsing runs.  Most of the processing time is in
Perl::Critic, not PPI, so the speedup is not huge (only about 20%).
Nonetheless, if your distribution is large, it's worth the effort.

Add a block of code like the following to your test program, probably
just before the call to C<all_critic_ok()>.  Be sure to adjust the
path to the temp directory appropriately for your system.

    use File::Spec;
    my $cache_path = File::Spec->catdir(File::Spec->tmpdir,
                                        "test-perl-critic-cache-$ENV{USER}");
    if (!-d $cache_path) {
       mkdir $cache_path, oct 700;
    }
    require PPI::Cache;
    PPI::Cache->import(path => $cache_path);

We recommend that you do NOT use this technique for tests that will go
out to end-users.  They're probably going to only run the tests once,
so they will not see the benefit of the caching but will still have
files stored in their temp directory.

=head1 BUGS

If you find any bugs, please submit them to
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Perl-Critic>.  Thanks.


=head1 SEE ALSO

L<Module::Starter::PBP>

L<Perl::Critic>

L<Test::More>

=head1 CREDITS

Andy Lester, whose L<Test::Pod> module provided most of the code and
documentation for Test::Perl::Critic.  Thanks, Andy.

=head1 AUTHOR

Jeffrey Ryan Thalhammer <thaljef@cpan.org>

=head1 COPYRIGHT

Copyright (c) 2005-2006 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
