t/strict.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     use lib 't/lib';
   6     use Test::More;
   7     use File::Find;
   8     use File::Basename;
   9
  10     plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};
  11
  12     eval 'use Test::Strict';
  13     plan skip_all => 'Test::Strict not installed' if $@;
  14     plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006;
  15 };
  16
  17 ## I hope this can go away if Test::Strict or File::Find::Rule
  18 ## finally run under -T. Until then, I'm on my own here. ;-)
  19 my @files;
  20 my %trusted = (
  21     'NotReallyAClass.pm' => 1
  22 );
  23
  24 find({  wanted => \&wanted,
  25         untaint => 1,
  26         untaint_pattern => qr|^([-+@\w./]+)$|,
  27         untaint_skip => 1,
  28         no_chdir => 1
  29 }, qw(lib t));
  30
  31 sub wanted {
  32     my $name = $File::Find::name;
  33     my $file = fileparse($name);
  34
  35     return if $name =~ /TestApp/;
  36
  37     if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) {
  38         push @files, $name;
  39     };
  40 };
  41
  42 if (scalar @files) {
  43     plan tests => scalar @files;
  44 } else {
  45     plan tests => 1;
  46     fail 'No perl files found for Test::Strict checks!';
  47 };
  48
  49 foreach (@files) {
  50     strict_ok($_);
  51 };