xt/dist/authors.t

   1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
   2
   3 use warnings;
   4 use strict;
   5
   6 use Test::More;
   7 use Config;
   8 use File::Spec;
   9
  10 my @known_authors = do {
  11   # according to #p5p this is how one safely reads random unicode
  12   # this set of boilerplate is insane... wasn't perl unicode-king...?
  13   no warnings 'once';
  14   require Encode;
  15   require PerlIO::encoding;
  16   local $PerlIO::encoding::fallback = Encode::FB_CROAK();
  17
  18   open (my $fh, '<:encoding(UTF-8)', 'AUTHORS') or die "Unable to open AUTHORS - can't happen: $!\n";
  19   map { chomp; ( ( ! $_ or $_ =~ /^\s*\#/ ) ? () : $_ ) } <$fh>;
  20
  21 } or die "Known AUTHORS file seems empty... can't happen...";
  22
  23 is_deeply (
  24   [ grep { /^\s/ or /\s\s/ } @known_authors ],
  25   [],
  26   "No entries with leading or doubled space",
  27 );
  28
  29 is_deeply (
  30   [ grep { / \:[^\s\/] /x or /^ [^:]*? \s+ \: /x } @known_authors ],
  31   [],
  32   "No entries with malformed nicks",
  33 );
  34
  35 is_deeply (
  36   \@known_authors,
  37   [ sort { lc $a cmp lc $b } @known_authors ],
  38   'Author list is case-insensitively sorted'
  39 );
  40
  41 my $email_re = qr/( \< [^\<\>]+ \> ) $/x;
  42
  43 my %known_authors;
  44 for (@known_authors) {
  45   my ($name_email) = m/ ^ (?: [^\:]+ \: \s )? (.+) /x;
  46   my ($email) = $name_email =~ $email_re;
  47
  48   fail "Duplicate found: $name_email" if (
  49     $known_authors{$name_email}++
  50       or
  51     ( $email and $known_authors{$email}++ )
  52   );
  53 }
  54
  55 # augh taint mode
  56 if (length $ENV{PATH}) {
  57   ( $ENV{PATH} ) = join ( $Config{path_sep},
  58     map { length($_) ? File::Spec->rel2abs($_) : () }
  59       split /\Q$Config{path_sep}/, $ENV{PATH}
  60   ) =~ /\A(.+)\z/;
  61 }
  62
  63 # no git-check when smoking a PR
  64 if (
  65   (
  66     ! $ENV{TRAVIS_PULL_REQUEST}
  67       or
  68     $ENV{TRAVIS_PULL_REQUEST} eq "false"
  69   )
  70     and
  71   -d '.git'
  72 ) {
  73
  74   binmode (Test::More->builder->$_, ':utf8') for qw/output failure_output todo_output/;
  75
  76   # this may fail - not every system has git
  77   for (
  78     map
  79       { my ($gitname) = m/^ \s* \d+ \s* (.+?) \s* $/mx; utf8::decode($gitname); $gitname }
  80       qx( git shortlog HEAD --remotes=historic/ghpr/applied/ --remotes=historic/ghpr/closed/ -e -s )
  81   ) {
  82     my ($eml) = $_ =~ $email_re;
  83
  84     ok $known_authors{$eml},
  85       "Commit author '$_' (from .mailmap-aware `git shortlog -e -s`) reflected in ./AUTHORS";
  86   }
  87 }
  88
  89 done_testing;