| Commit | Line | Data |
|---|
| 650d6350 |
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; |
projects / gitmo/MooseX-Attribute-ENV.git / blame