git.maemo.org Git - pkg-perl/blob - deb-src/libtest-perl-critic-perl/libtest-perl-critic-perl-1.01/lib/Test/Perl/Critic.pm

   1 #######################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/Test-Perl-Critic-1.01/lib/Test/Perl/Critic.pm $
   3 #     $Date: 2007-01-24 22:22:10 -0800 (Wed, 24 Jan 2007) $
   4 #   $Author: thaljef $
   5 # $Revision: 1183 $
   6 ########################################################################
   7
   8 package Test::Perl::Critic;
   9
  10 use strict;
  11 use warnings;
  12 use Carp qw(croak);
  13 use English qw(-no_match_vars);
  14 use Test::Builder qw();
  15 use Perl::Critic qw();
  16 use Perl::Critic::Violation qw();
  17 use Perl::Critic::Utils;
  18
  19
  20 #---------------------------------------------------------------------------
  21
  22 our $VERSION = 1.01;
  23
  24 #---------------------------------------------------------------------------
  25
  26 my $TEST        = Test::Builder->new();
  27 my %CRITIC_ARGS = ();
  28
  29 #---------------------------------------------------------------------------
  30
  31 sub import {
  32
  33     my ( $self, %args ) = @_;
  34     my $caller = caller;
  35
  36     no strict 'refs';  ## no critic
  37     *{ $caller . '::critic_ok' }     = \&critic_ok;
  38     *{ $caller . '::all_critic_ok' } = \&all_critic_ok;
  39
  40     $TEST->exported_to($caller);
  41
  42     # -format is supported for backward compatibility
  43     if( exists $args{-format} ){ $args{-verbose} = $args{-format}; }
  44     %CRITIC_ARGS = %args;
  45
  46     return 1;
  47 }
  48
  49 #---------------------------------------------------------------------------
  50
  51 sub critic_ok {
  52
  53     my ( $file, $test_name ) = @_;
  54     croak q{no file specified} if not defined $file;
  55     croak qq{"$file" does not exist} if not -f $file;
  56     $test_name ||= qq{Test::Perl::Critic for "$file"};
  57
  58     my $critic = undef;
  59     my @violations = ();
  60     my $ok = 0;
  61
  62     # Run Perl::Critic
  63     eval {
  64         # TODO: Should $critic be a global singleton?
  65         $critic     = Perl::Critic->new( %CRITIC_ARGS );
  66         @violations = $critic->critique( $file );
  67         $ok         = not scalar @violations;
  68     };
  69
  70     # Evaluate results
  71     $TEST->ok( $ok, $test_name );
  72
  73
  74     if ($EVAL_ERROR) {           # Trap exceptions from P::C
  75         $TEST->diag( "\n" );     # Just to get on a new line.
  76         $TEST->diag( qq{Perl::Critic had errors in "$file":} );
  77         $TEST->diag( qq{\t$EVAL_ERROR} );
  78     }
  79     elsif ( not $ok ) {          # Report Policy violations
  80         $TEST->diag( "\n" );     # Just to get on a new line.
  81         $TEST->diag( qq{Perl::Critic found these violations in "$file":} );
  82
  83         my $verbose = $critic->config->verbose();
  84         Perl::Critic::Violation::set_format( $verbose );
  85         for my $viol (@violations) { $TEST->diag("$viol") }
  86     }
  87
  88     return $ok;
  89 }
  90
  91 #---------------------------------------------------------------------------
  92
  93 sub all_critic_ok {
  94
  95     my @dirs = @_ ? @_ : _starting_points();
  96     my @files = all_code_files( @dirs );
  97     $TEST->plan( tests => scalar @files );
  98
  99     my $okays = grep { critic_ok($_) } @files;
 100     return $okays == @files;
 101 }
 102
 103 #---------------------------------------------------------------------------
 104
 105 sub all_code_files {
 106     my @dirs = @_ ? @_ : _starting_points();
 107     return Perl::Critic::Utils::all_perl_files(@dirs);
 108 }
 109
 110 #---------------------------------------------------------------------------
 111
 112 sub _starting_points {
 113     return -e 'blib' ? 'blib' : 'lib';
 114 }
 115
 116 #---------------------------------------------------------------------------
 117
 118 1;
 119
 120
 121 __END__
 122
 123 =pod
 124
 125 =for stopwords API
 126
 127 =head1 NAME
 128
 129 Test::Perl::Critic - Use Perl::Critic in test programs
 130
 131 =head1 SYNOPSIS
 132
 133 Test one file:
 134
 135   use Test::Perl::Critic;
 136   use Test::More tests => 1;
 137   critic_ok($file);
 138
 139 Or test all files in one or more directories:
 140
 141   use Test::Perl::Critic;
 142   all_critic_ok($dir_1, $dir_2, $dir_N );
 143
 144 Or test all files in a distribution:
 145
 146   use Test::Perl::Critic;
 147   all_critic_ok();
 148
 149 Recommended usage for CPAN distributions:
 150
 151   use strict;
 152   use warnings;
 153   use File::Spec;
 154   use Test::More;
 155   use English qw(-no_match_vars);
 156
 157   if ( not $ENV{TEST_AUTHOR} ) {
 158       my $msg = 'Author test.  Set $ENV{TEST_AUTHOR} to a true value to run.';
 159       plan( skip_all => $msg );
 160   }
 161
 162   eval { require Test::Perl::Critic; };
 163
 164   if ( $EVAL_ERROR ) {
 165      my $msg = 'Test::Perl::Critic required to criticise code';
 166      plan( skip_all => $msg );
 167   }
 168
 169   my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' );
 170   Test::Perl::Critic->import( -profile => $rcfile );
 171   all_critic_ok();
 172
 173
 174 =head1 DESCRIPTION
 175
 176 Test::Perl::Critic wraps the L<Perl::Critic> engine in a convenient
 177 subroutine suitable for test programs written using the L<Test::More>
 178 framework.  This makes it easy to integrate coding-standards
 179 enforcement into the build process.  For ultimate convenience (at the
 180 expense of some flexibility), see the L<criticism> pragma.
 181
 182 If you'd like to try L<Perl::Critic> without installing anything,
 183 there is a web-service available at L<http://perlcritic.com>.  The
 184 web-service does not yet support all the configuration features that
 185 are available in the native Perl::Critic API, but it should give you a
 186 good idea of what it does.  You can also invoke the perlcritic
 187 web-service from the command line by doing an HTTP-post, such as one
 188 of these:
 189
 190   $> POST http://perlcritic.com/perl/critic.pl < MyModule.pm
 191   $> lwp-request -m POST http://perlcritic.com/perl/critic.pl < MyModule.pm
 192   $> wget -q -O - --post-file=MyModule.pm http://perlcritic.com/perl/critic.pl
 193
 194 Please note that the perlcritic web-service is still alpha code.  The
 195 URL and interface to the service are subject to change.
 196
 197
 198
 199 =head1 SUBROUTINES
 200
 201 =over 8
 202
 203 =item critic_ok( $FILE [, $TEST_NAME ] )
 204
 205 Okays the test if Perl::Critic does not find any violations in $FILE.
 206 If it does, the violations will be reported in the test diagnostics.
 207 The optional second argument is the name of test, which defaults to
 208 "Perl::Critic test for $FILE".
 209
 210 If you use this form, you should emit your own L<Test::More> plan first.
 211
 212 =item all_critic_ok( [ @DIRECTORIES ] )
 213
 214 Runs C<critic_ok()> for all Perl files beneath the given list of
 215 C<@DIRECTORIES>.  If C<@DIRECTORIES> is empty or not given, this
 216 function tries to find all Perl files in the F<blib/> directory.  If
 217 the F<blib/> directory does not exist, then it tries the F<lib/>
 218 directory.  Returns true if all files are okay, or false if any file
 219 fails.
 220
 221 This subroutine emits its own L<Test::More> plan, so you do not need
 222 to specify an expected number of tests yourself.
 223
 224 =item all_code_files ( [@DIRECTORIES] )
 225
 226 B<DEPRECATED:> Use the C<all_perl_files> subroutine that is exported
 227 by L<Perl::Critic::Utils> instead.
 228
 229 Returns a list of all the Perl files found beneath each DIRECTORY, If
 230 @DIRECTORIES is an empty list, defaults to F<blib/>.  If F<blib/> does
 231 not exist, it tries F<lib/>.  Skips any files in CVS or Subversion
 232 directories.
 233
 234 A Perl file is:
 235
 236 =over 4
 237
 238 =item * Any file that ends in F<.PL>, F<.pl>, F<.pm>, or F<.t>
 239
 240 =item * Any file that has a first line with a shebang containing 'perl'
 241
 242 =back
 243
 244 =back
 245
 246 =head1 CONFIGURATION
 247
 248 L<Perl::Critic> is highly configurable.  By default,
 249 Test::Perl::Critic invokes Perl::Critic with it's default
 250 configuration.  But if you have developed your code against a custom
 251 Perl::Critic configuration, you will want to configure
 252 Test::Perl::Critic to do the same.
 253
 254 Any arguments given to the C<use> pragma will be passed into the
 255 L<Perl::Critic> constructor.  So if you have developed your code using
 256 a custom F<~/.perlcriticrc> file, you can direct Test::Perl::Critic to
 257 use a custom file too.
 258
 259   use Test::Perl::Critic (-profile => 't/perlcriticrc');
 260   all_critic_ok();
 261
 262 Now place a copy of your own F<~/.perlcriticrc> file in the distribution
 263 as F<t/perlcriticrc>.  Then, C<critic_ok()> will be run on all Perl
 264 files in this distribution using this same Perl::Critic configuration.
 265 See the L<Perl::Critic> documentation for details on the
 266 F<.perlcriticrc> file format.
 267
 268 Any argument that is supported by the L<Perl::Critic> constructor can
 269 be passed through this interface.  For example, you can also set the
 270 minimum severity level, or include & exclude specific policies like
 271 this:
 272
 273   use Test::Perl::Critic (-severity => 2, -exclude => ['RequireRcsKeywords']);
 274   all_critic_ok();
 275
 276 See the L<Perl::Critic> documentation for complete details on it's
 277 options and arguments.
 278
 279 =head1 DIAGNOSTIC DETAILS
 280
 281 By default, Test::Perl::Critic displays basic information about each
 282 Policy violation in the diagnostic output of the test.  You can
 283 customize the format and content of this information by using the
 284 C<-verbose> option.  This behaves exactly like the C<-verbose> switch
 285 on the F<perlcritic> program.  For example:
 286
 287   use Test::Perl::Critic (-verbose => 6);
 288
 289   #or...
 290
 291   use Test::Perl::Critic (-verbose => '%f: %m at %l');
 292
 293 If given a number, Test::Perl::Critic reports violations using one of
 294 the predefined formats described below. If given a string, it is
 295 interpreted to be an actual format specification. If the C<-verbose>
 296 option is not specified, it defaults to 3.
 297
 298     Verbosity     Format Specification
 299     -----------   -------------------------------------------------------------
 300      1            "%f:%l:%c:%m\n",
 301      2            "%f: (%l:%c) %m\n",
 302      3            "%m at %f line %l\n",
 303      4            "%m at line %l, column %c.  %e.  (Severity: %s)\n",
 304      5            "%f: %m at line %l, column %c.  %e.  (Severity: %s)\n",
 305      6            "%m at line %l, near '%r'.  (Severity: %s)\n",
 306      7            "%f: %m at line %l near '%r'.  (Severity: %s)\n",
 307      8            "[%p] %m at line %l, column %c.  (Severity: %s)\n",
 308      9            "[%p] %m at line %l, near '%r'.  (Severity: %s)\n",
 309     10            "%m at line %l, column %c.\n  %p (Severity: %s)\n%d\n",
 310     11            "%m at line %l, near '%r'.\n  %p (Severity: %s)\n%d\n"
 311
 312 Formats are a combination of literal and escape characters similar to
 313 the way C<sprintf> works. See L<String::Format> for a full explanation
 314 of the formatting capabilities. Valid escape characters are:
 315
 316     Escape    Meaning
 317     -------   ----------------------------------------------------------------
 318     %c        Column number where the violation occurred
 319     %d        Full diagnostic discussion of the violation
 320     %e        Explanation of violation or page numbers in PBP
 321     %f        Name of the file where the violation occurred.
 322     %l        Line number where the violation occurred
 323     %m        Brief description of the violation
 324     %P        Name of the Policy module that created the violation
 325     %p        Name of the Policy without the Perl::Critic::Policy:: prefix
 326     %r        The string of source code that caused the violation
 327     %s        The severity level of the violation
 328
 329 =head1 CAVEATS
 330
 331 Despite the convenience of using a test script to enforce your coding
 332 standards, there are some inherent risks when distributing those tests
 333 to others.  Since you don't know which version of L<Perl::Critic> the
 334 end-user has and whether they have installed any additional Policy
 335 modules, you can't really be sure that your code will pass the
 336 Test::Perl::Critic tests on another machine.
 337
 338 B<For these reasons, we strongly advise you to make your perlcritic
 339 tests optional, or exclude them from the distribution entirely.>
 340
 341 The recommended usage in the L<"SYNOPSIS"> section illustrates one way
 342 to make your F<perlcritic.t> test optional.  Also, you should B<not>
 343 list Test::Perl::Critic as a requirement in your build script.  These
 344 tests are only relevant to the author and should not be a prerequisite
 345 for end-use.
 346
 347 See L<http://www.chrisdolan.net/talk/index.php/2005/11/14/private-regression-tests/>
 348 for an interesting discussion about Test::Perl::Critic and other types
 349 of author-only regression tests.
 350
 351 =head1 EXPORTS
 352
 353   critic_ok()
 354   all_critic_ok()
 355
 356 =head1 PERFORMANCE HACKS
 357
 358 If you want a small performance boost, you can tell PPI to cache
 359 results from previous parsing runs.  Most of the processing time is in
 360 Perl::Critic, not PPI, so the speedup is not huge (only about 20%).
 361 Nonetheless, if your distribution is large, it's worth the effort.
 362
 363 Add a block of code like the following to your test program, probably
 364 just before the call to C<all_critic_ok()>.  Be sure to adjust the
 365 path to the temp directory appropriately for your system.
 366
 367     use File::Spec;
 368     my $cache_path = File::Spec->catdir(File::Spec->tmpdir,
 369                                         "test-perl-critic-cache-$ENV{USER}");
 370     if (!-d $cache_path) {
 371        mkdir $cache_path, oct 700;
 372     }
 373     require PPI::Cache;
 374     PPI::Cache->import(path => $cache_path);
 375
 376 We recommend that you do NOT use this technique for tests that will go
 377 out to end-users.  They're probably going to only run the tests once,
 378 so they will not see the benefit of the caching but will still have
 379 files stored in their temp directory.
 380
 381 =head1 BUGS
 382
 383 If you find any bugs, please submit them to
 384 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Perl-Critic>.  Thanks.
 385
 386
 387 =head1 SEE ALSO
 388
 389 L<Module::Starter::PBP>
 390
 391 L<Perl::Critic>
 392
 393 L<Test::More>
 394
 395 =head1 CREDITS
 396
 397 Andy Lester, whose L<Test::Pod> module provided most of the code and
 398 documentation for Test::Perl::Critic.  Thanks, Andy.
 399
 400 =head1 AUTHOR
 401
 402 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 403
 404 =head1 COPYRIGHT
 405
 406 Copyright (c) 2005-2006 Jeffrey Ryan Thalhammer.  All rights reserved.
 407
 408 This program is free software; you can redistribute it and/or modify
 409 it under the same terms as Perl itself.  The full text of this license
 410 can be found in the LICENSE file included with this module.
 411
 412 =cut