1#!/usr/bin/perl 2 3use Test::More; 4 5use strict; 6use warnings; 7no warnings 'syntax'; 8 9unless ($ENV {AUTHOR_TESTING}) { 10 plan skip_all => "AUTHOR tests"; 11 exit; 12} 13 14sub version; 15 16# 17# For a minute or two, I considered using File::Find. 18# 19# Henry Spencer was right: 20# 21# "Those who don't understand Unix are condemned to reinvent it, poorly." 22# 23 24undef $ENV {PATH}; 25my $FIND = "/usr/bin/find"; 26 27my $top = -d "blib" ? "blib/lib" : "lib"; 28my @files = `$FIND $top -name [a-zA-Z_]*.pm`; 29chomp @files; 30 31my $main_version = version "$top/Test/Regexp.pm"; 32unless ($main_version) { 33 fail "Cannot find a version in main file"; 34 done_testing; 35 exit; 36} 37 38pass "Got a VERSION declaration in main file"; 39 40foreach my $file (@files, "README") { 41 my $base = $file; 42 $base =~ s!^.*/!!; 43 # 44 # Grab version 45 # 46 my $version = version $file; 47 48 unless ($version) { 49 fail "Did not find a version in $base; skipping tests"; 50 next; 51 } 52 53 pass "Found version $version in $base"; 54 55 if ($file eq 'README') { 56 is $version, $main_version, "Version in README matches package version" 57 } 58 else { 59 ok $version le $main_version, 60 " It does not exceed package version"; 61 } 62} 63 64my %monthmap = qw [Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06 65 Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12]; 66 67if (open my $fh, "<", "Changes") { 68 my $first = <$fh>; 69 if ($first =~ 70 /^Version ([0-9]{10}) \S+ (\S+) +([0-9]{0,2}) \S+ \S+ ([0-9]{4})/) { 71 my ($version, $month, $date, $year) = ($1, $2, $3, $4); 72 pass "Version line in Changes file formatted ok"; 73 my $target = sprintf "%04d%02d%02d" => $year, $monthmap {$month}, $date; 74 is substr ($version, 0, 8), $target => " Version and date match"; 75 is $version, $main_version => " Version matches package version"; 76 } 77 else { 78 SKIP: { 79 fail "First line of Changes files correctly formatted: $first"; 80 skip "Cannot extract a correctly formatted version", 2; 81 }} 82} 83else { 84 SKIP: { 85 fail "Failed to open Changes file: $!"; 86 skip "Cannot open Changes file", 2; 87}} 88 89done_testing; 90 91sub version { 92 my $file = shift; 93 open my $fh, "<", $file or return; 94 while (<$fh>) { 95 return $1 if /^our \$VERSION = '([0-9]{10})';$/; 96 return $1 if /This is version ([0-9]{10}) /; # README 97 return if / \$VERSION \s* =/x; 98 } 99 return; 100} 101 102 103__END__ 104