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