t-author/newlines.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5
   6         use Test::More;
   7         use File::Find;
   8 }
   9
  10
  11 =head1 NAME
  12
  13 t/newlines.t - test to make sure all text files are in unix linefeed format
  14
  15 =head1 DESCRIPTION
  16
  17 Descends through the distribution directory and verifies that all text files
  18 (files with an extention matching a pattern, such as *.txt) are in unix
  19 linefeed format.
  20
  21 =head1 TESTS
  22
  23 This module defines the following tests.
  24
  25 =head2 Descend Distribution
  26
  27 Starting at the Distribution root, look at all files in all subdirections and
  28 if the file matches a text type (according to a particular regex for it's
  29 extension) add it to a files of files to test.
  30
  31 =cut
  32
  33 my @files;
  34
  35         find({
  36                 wanted => \&process,
  37                 follow => 0
  38         }, '.');
  39
  40 sub process
  41 {
  42         my $file = $_;
  43
  44         return if $File::Find::dir =~m/\.svn/;
  45         return if $File::Find::dir =~m/archive/;
  46
  47         push @files, $File::Find::name
  48          if $file =~m/\.yml$|\.pm$|\.pod$|\.tt$|\.txt$|\.js$|\.css$|\.sql$|\.html$/;
  49 }
  50
  51
  52 =head2 test linefeedtype
  53
  54 Check if the generated files are correctly unix linefeeds
  55
  56 =cut
  57
  58 my $CR   = "\015";      # Apple II family, Mac OS thru version 9
  59 my $CRLF = "\015\012";  # CP/M, MP/M, DOS, Microsoft Windows
  60 my $FF   = "\014";      # printer form feed
  61 my $LF   = "\012";      # Unix, Linux, Xenix, Mac OS X, BeOS, Amiga
  62
  63 my $test_builder = Test::More->builder;
  64
  65 if( $#files )
  66 {
  67         $test_builder->plan(tests => ($#files+1)*2);
  68
  69         foreach my $file (@files)
  70         {
  71                 ## Get a good filehandle
  72                 open( my $fh, '<', $file)
  73                  or fail "Can't open $file, can't finish testing";
  74
  75                 ## Only need to test the first line.
  76                 my ($first, $second) = <$fh>;
  77
  78                 ## Don't need this anymore
  79                 close($fh);
  80
  81                 SKIP: {
  82
  83                         skip "$file is Empty!", 2 unless $first;
  84
  85                         ## Are we DOS or MACOS/APPLE?
  86                         ok $first!~m/$CRLF$|$CR$|$FF$/, "$file isn't in a forbidden format";
  87
  88                         ## If there is more than one line, we HAVE to be UNIX
  89
  90                         SKIP: {
  91
  92                                 skip "$file only has a single line", 1 unless $second;
  93                                 ok $first=~m/$LF$/, "$file Is unix linefeed";
  94                         }
  95                 }
  96         }
  97 }
  98 else
  99 {
 100         $test_builder->plan(skip_all => 'No Text Files Found! (This is probably BIG Trouble...');
 101 }
 102
 103 =head1 AUTHOR
 104
 105 John Napiorkowski, C<< <jjn1056 at yahoo.com> >>
 106
 107 =head1 COPYRIGHT & LICENSE
 108
 109 Copyright 2008 John Napiorkowski.
 110
 111 This program is free software; you can redistribute it and/or modify it
 112 under the same terms as Perl itself.
 113
 114 =cut
 115
 116
 117 1;