xt/dist/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;
  42 for (@known_authors) {
  43   my ($name_email) = m/ ^ (?: [^\:]+ \: \s )? (.+) /x;
  44   my ($email) = $name_email =~ $email_re;
  45
  46   fail "Duplicate found: $name_email" if (
  47     $known_authors{$name_email}++
  48       or
  49     ( $email and $known_authors{$email}++ )
  50   );
  51 }
  52
  53 # augh taint mode
  54 if (length $ENV{PATH}) {
  55   ( $ENV{PATH} ) = join ( $Config{path_sep},
  56     map { length($_) ? File::Spec->rel2abs($_) : () }
  57       split /\Q$Config{path_sep}/, $ENV{PATH}
  58   ) =~ /\A(.+)\z/;
  59 }
  60
  61 # no git-check when smoking a PR
  62 if (
  63   (
  64     ! $ENV{TRAVIS_PULL_REQUEST}
  65       or
  66     $ENV{TRAVIS_PULL_REQUEST} eq "false"
  67   )
  68     and
  69   -d '.git'
  70 ) {
  71
  72   binmode (Test::More->builder->$_, ':utf8') for qw/output failure_output todo_output/;
  73
  74   # this may fail - not every system has git
  75   for (
  76     map
  77       { my ($gitname) = m/^ \s* \d+ \s* (.+?) \s* $/mx; utf8::decode($gitname); $gitname }
  78       qx( git shortlog -e -s )
  79   ) {
  80     my ($eml) = $_ =~ $email_re;
  81
  82     ok $known_authors{$eml},
  83       "Commit author '$_' (from .mailmap-aware `git shortlog -e -s`) reflected in ./AUTHORS";
  84   }
  85 }
  86
  87 done_testing;