(travis) Feeble attempt at reverting f207111d
[dbsrgits/DBIx-Class-Historic.git] / xt / authors.t
1 use warnings;
2 use strict;
3
4 use Test::More;
5 use Config;
6 use File::Spec;
7
8 my @known_authors = do {
9   # according to #p5p this is how one safely reads random unicode
10   # this set of boilerplate is insane... wasn't perl unicode-king...?
11   no warnings 'once';
12   require Encode;
13   require PerlIO::encoding;
14   local $PerlIO::encoding::fallback = Encode::FB_CROAK();
15
16   open (my $fh, '<:encoding(UTF-8)', 'AUTHORS') or die "Unable to open AUTHORS - can't happen: $!\n";
17   map { chomp; ( ( ! $_ or $_ =~ /^\s*\#/ ) ? () : $_ ) } <$fh>;
18
19 } or die "Known AUTHORS file seems empty... can't happen...";
20
21 is_deeply (
22   [ grep { /^\s/ or /\s\s/ } @known_authors ],
23   [],
24   "No entries with leading or doubled space",
25 );
26
27 is_deeply (
28   [ grep { / \:[^\s\/] /x or /^ [^:]*? \s+ \: /x } @known_authors ],
29   [],
30   "No entries with malformed nicks",
31 );
32
33 is_deeply (
34   \@known_authors,
35   [ sort { lc $a cmp lc $b } @known_authors ],
36   'Author list is case-insensitively sorted'
37 );
38
39 my $email_re = qr/( \< [^\<\>]+ \> ) $/x;
40
41 my (%known_authors, $count);
42 for (@known_authors) {
43   my ($name_email) = m/ ^ (?: [^\:]+ \: \s )? (.+) /x;
44   my ($email) = $name_email =~ $email_re;
45
46   if (
47     $known_authors{$name_email}++
48       or
49     ( $email and $known_authors{$email}++ )
50   ) {
51     fail "Duplicate found: $name_email";
52   }
53   else {
54     $count++;
55   }
56 }
57
58 # do not announce anything under travis - we are watching for STDERR silence
59 diag "\n\n$count contributors made this library what it is today\n\n"
60   unless ($ENV{TRAVIS}||'') eq 'true';
61
62 # augh taint mode
63 if (length $ENV{PATH}) {
64   ( $ENV{PATH} ) = join ( $Config{path_sep},
65     map { length($_) ? File::Spec->rel2abs($_) : () }
66       split /\Q$Config{path_sep}/, $ENV{PATH}
67   ) =~ /\A(.+)\z/;
68 }
69
70 # this may fail - not every system has git
71 if (my @git_authors = map
72   { my ($gitname) = m/^ \s* \d+ \s* (.+?) \s* $/mx; utf8::decode($gitname); $gitname }
73   qx( git shortlog -e -s )
74 ) {
75   for (@git_authors) {
76     my ($eml) = $_ =~ $email_re;
77
78     fail "Commit author '$_' (from git) not reflected in AUTHORS, perhaps a missing .mailmap entry?"
79       unless $known_authors{$eml};
80   }
81 }
82
83 done_testing;