1#!/usr/bin/perl 2use strict; 3BEGIN { 4 if ( not $ENV{TEST_AUTHOR} ) { 5 my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; 6 print "1..0 7 # $msg"; 8 exit 0; 9 } 10 require Test::More; 11 Test::More->import(); 12} 13use File::Find; 14use IO::File; 15 16if ( not $ENV{TEST_AUTHOR} ) { 17 my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; 18 plan( skip_all => $msg ); 19} 20 21my @skip = ( 22 qr(\.svn) 23); 24 25my $dir = 'blib/lib'; 26if (-d '../t') { 27 $dir = '../lib'; 28} 29 30my @filelist = (); 31find( \&filelist, $dir); 32 33sub filelist { 34 my $name = $_; 35 return if (-d $name); 36 return if $File::Find::name =~m{\.svn}x; 37 push @filelist, $File::Find::name; 38} 39 40plan( tests => scalar @filelist); 41 42for my $file (sort @filelist) { 43 check_file($file); 44} 45 46sub check_file { 47 my $file = shift; 48 my $fh = IO::File->new($file, O_RDONLY) or die "Cannot open $file"; 49 my $line_nr = 0; 50 my $error_count = 0; 51 52 while (my $line = $fh->getline() ) { 53 # check for trailing whitespace 54 # allow single whitespace on line to allow 55 # pod source blocks with empty lines 56 # 57 $line_nr++; 58 if ($line =~m{ (:?[^\s]+|\s)\s\r?\n$ }x) { 59 $error_count++; 60 print "# trailing whitespace in $file line $line_nr at end of line\n" 61 } 62 63 # check for tabs and report their position 64 my @tab_pos_from = (); 65 my $pos = -1; 66 while (1) { 67 $pos = index($line, "\t", $pos + 1); 68 last if $pos <0; 69 push @tab_pos_from, $pos + 1; 70 } 71 if (@tab_pos_from) { 72 print "# tab found in $file line $line_nr cols ${ \join(', ', @tab_pos_from) }\n"; 73 $error_count += scalar(@tab_pos_from); 74 } 75 76 if ($line=~m{\r}) { 77 print "# CR (\\r) found in $file line $line_nr. Convert to LF only.\n"; 78 $error_count++; 79 } 80 } 81 is $error_count, 0 , "$file characters"; 82}