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}