t/strict.t

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