view release on metacpan or  search on metacpan

lib/Dist/Zilla/Plugin/Git/Contributors.pm  view on Meta::CPAN

};

sub metadata
{
    my $self = shift;

    my $contributors = $self->_contributors;
    return if not @$contributors;

    $self->_check_podweaver;
    +{ x_contributors => $contributors };
}

sub register_prereqs
{
    my $self = shift;

    return if none { /[^[:ascii:]]/ } @{ $self->_contributors };

    my $prereqs = $self->zilla->prereqs;
    my $all_prereqs = $prereqs->requirements_for(qw(runtime requires))
        ->clone
        ->add_requirements($prereqs->requirements_for(qw(configure requires)))
        ->add_requirements($prereqs->requirements_for(qw(build requires)))
        ->add_requirements($prereqs->requirements_for(qw(test requires)))
        ->as_string_hash;

    my $perl_prereq = $all_prereqs->{perl};

    $self->log_debug([ 'found non-ascii characters in contributor names; perl prereq so far is %s',
        defined $perl_prereq ? $perl_prereq : 'unknown' ]);
    $perl_prereq = 0 if not defined $perl_prereq;
    $perl_prereq = version->parse($perl_prereq)->numify;
    return if "$perl_prereq" >= '5.008006';

    # many Dist::Zilla-using distributions don't have an explicit minimum
    # perl, but we know that Dist::Zilla doesn't work until 5.8.7
    return if any { /^Dist::Zilla/ } keys %$all_prereqs;

    # if dynamic_config is set, the user gets another chance to read the file, via fallback code:
    # < haarg> eumm loads META, updates prereqs, and writes out MYMETA
    # < haarg> so in a working system, x_contributors will be included
    # < haarg> in a broken system, it will fail to load META, regenerate it from parameters including META_ADD/MERGE, then write it out
    # < haarg> so if there isn't any utf8 data in the parameters given to EUMM, it will produce a file that can be read by a "bad" JSON::PP
    return if $self->zilla->distmeta->{dynamic_config};

    # see https://github.com/makamaka/JSON-PP/pull/9 for for details
    $self->log('Warning: distribution has non-ascii characters in contributor names. META.json will be unparsable on perls <= 5.8.6 when JSON::PP is lower than 2.27300');

    $self->zilla->register_prereqs(
        {
            phase => 'configure',
            type  => 'suggests',
        },
        'JSON::PP' => '2.27300',
    );
}

# should not be called before the MetaProvider phase
has _contributors => (
    is => 'ro', isa => 'ArrayRef[Str]',
    lazy => 1,
    builder => '_build_contributors',
);

sub _build_contributors
{
    my $self = shift;

    # note that ->status does something different.
    return [] if not $self->_git(RUN => 'status');

    my @data = $self->_git(shortlog =>
        {
            email => 1,
            summary => 1,
            numbered => 1,
        },
        'HEAD', '--', $self->paths,
    );

    # [ count, email ]
    my @counts_and_contributors = map [ split ' ', $_, 2 ], @data;

    my $fc = "$]" >= '5.016001'
        ? \&CORE::fc
        : do {
            $self->log_debug('case-folding not available; falling back to lower-cased comparisons');
            sub { lc $_[0] }    # not callable via \&CORE::lc
        };

    my %seen_email;
    ++$seen_email{$fc->(($_->[1] =~ /<([^>]+)>/g)[-1])} foreach @counts_and_contributors;
    if (my @duplicate_emails = grep $seen_email{$_} > 1, keys %seen_email) {
      $self->log('multiple names with the same email found: you may want to use a .mailmap file (https://www.kernel.org/pub/software/scm/git/docs/git-shortlog.html#_mapping_authors):',
        join("\n", '', map '  '.$_, @duplicate_emails));
    }

    my %seen_name;
    ++$seen_name{$fc->(($_->[1] =~ /^([^<]+) </g)[-1])} foreach @counts_and_contributors;
    if (my @duplicate_names = grep $seen_name{$_} > 1, keys %seen_name) {
      $self->log('multiple emails with the same name found: you may want to use a .mailmap file (https://www.kernel.org/pub/software/scm/git/docs/git-shortlog.html#_mapping_authors):',
        join("\n", '', map '  '.$_, @duplicate_names));
    }

    # remove duplicates by email address, keeping the first associated name
    @counts_and_contributors = uniq_by { $fc->(($_->[1] =~ /<([^>]+)>/g)[-1]) } @counts_and_contributors;

    # sort by name (ascending) or count (descending) depending on choice
    my $Collator = Unicode::Collate->new(level => 1);

    my $sort_sub =
        $self->order_by eq 'name' ? sub { $Collator->cmp($a->[1], $b->[1]) }
      : $self->order_by eq 'commits' ? sub { $b->[0] <=> $a->[0] || $Collator->cmp($a->[1], $b->[1]) }
      : die 'unrecognized option order_by=', $self->order_by;

    my @contributors =
      map $_->[1],
      sort $sort_sub
      @counts_and_contributors;