File Coverage

blib/lib/Git/MoreHooks/CheckCommitAuthorFromMailmap.pm

Criterion	Covered	Total	%
statement	24	123	19.5
branch	0	38	0.0
condition	0	9	0.0
subroutine	8	18	44.4
pod	4	5	80.0
total	36	193	18.6

## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
## no critic (ControlStructures::ProhibitPostfixControls)

package Git::MoreHooks::CheckCommitAuthorFromMailmap;

use strict;
use warnings;
use utf8;

# ABSTRACT: Check Git commit author by using the mailmap file.

our $VERSION = '0.018'; # VERSION: generated by DZP::OurPkgVersion

use Git::Hooks 3.000000;
use Path::Tiny;
use Try::Tiny;
use Log::Any qw{$log};
use Module::Load qw{ load };

my $PKG = __PACKAGE__;
my ($CFG) = __PACKAGE__ =~ /::([^:]+)$/msx;
$CFG = 'githooks.' . $CFG;

#############
# Grok hook configuration, check it and set defaults.

sub _setup_config {
    my ($git) = @_;
    $log->debugf( __PACKAGE__ . '::_setup_config(%s):', '$git' );

    my $config = $git->get_config();
    $log->tracef( __PACKAGE__ . '::_setup_config(): Current Git config:\n%s.', $config );

    $config->{ lc $CFG } //= {};

    my $default = $config->{ lc $CFG };
    $default->{'match-mailmap-name'}    //= ['1'];
    $default->{'allow-mailmap-aliases'} //= ['1'];

    return;
}

##########

sub check_commit_at_client {
    my ($git) = @_;

    my $current_branch = $git->get_current_branch();
    return 1 unless $git->is_reference_enabled($current_branch);

    my $author_name  = $ENV{'GIT_AUTHOR_NAME'};
    my $author_email = '<' . $ENV{'GIT_AUTHOR_EMAIL'} . '>';

    my $commit = ':0';
    return _check_author( $git, $commit, $author_name, $author_email );
}

sub check_commit_at_server {
    my ( $git, $commit ) = @_;

    my $author_name  = $commit->{'author_name'};
    my $author_email = '<' . $commit->{'author_email'} . '>';

    return _check_author( $git, $commit, $author_name, $author_email );
}

sub _check_author {
    my ( $git, $commit, $author_name, $author_email ) = @_;

    _setup_config($git);

    return 1 if $git->im_admin();

    my $errors = 0;
    _check_mailmap( $git, $commit, $author_name, $author_email ) or ++$errors;

    return $errors == 0;
}

sub _check_mailmap {
    my ( $git, $commit, $author_name, $author_email ) = @_;

    my $errors = 0;
    eval {
        load 'Git::Mailmap';
        1;    # To cover the fact that operation correctly returns a false value.
    } or do {
        $log->errorf( __PACKAGE__ . q{::} . '_set_critic():Cannot load Git::Mailmap' );
        $git->fault( 'Cannot load Git::Mailmap', { prefix => $PKG, commit => $commit } );
        ++$errors;
        return $errors;
    };

    # TODO Move config checking to _setup_config() or elsewhere so it can break early on.
    my $author  = $author_name . q{ } . $author_email;
    my $mailmap = Git::Mailmap->new();
    my $mailmap_as_string;
    try {
        $mailmap_as_string = $git->run( 'cat-file', '-p', 'HEAD:.mailmap' );
    };
    if ( defined $mailmap_as_string ) {
        $mailmap->from_string( 'mailmap' => $mailmap_as_string );
        $log->debugf( __PACKAGE__ . q{::} . '_check_mailmap(): HEAD:.mailmap read in.' . ' Content from Git::Mailmap:\n%s',
            $mailmap->to_string() );
    }

    # 2) Config variable mailmap.file
    my $mapfile_location = $git->get_config( 'mailmap' => 'file' );
    if ( defined $mapfile_location ) {
        if ( -e $mapfile_location ) {
            my $file_as_str = path($mapfile_location)->slurp_utf8;
            $mailmap->from_string( 'mailmap' => $file_as_str );
            $log->debugf( __PACKAGE__ . q{::} . '_check_mailmap(): mailmap.file (%s) read in.' . ' Content from Git::Mailmap:\n%s',
                $mapfile_location, $mailmap->to_string() );
        }
        else {
            $git->fault( ( sprintf 'Config variable \'mailmap.file\' (value: %s) does not point to a file.', $mapfile_location ),
                { prefix => $PKG, commit => $commit } );
            ++$errors;
        }
    }

    # 3) Config variable mailmap.blob
    my $mapfile_blob = $git->get_config( 'mailmap' => 'blob' );
    if ( defined $mapfile_blob ) {
        my $blob_as_str;
        try {
            $blob_as_str = $git->run( 'cat-file', '-p', $mapfile_blob );
        };
        if ( defined $blob_as_str ) {
            $mailmap->from_string( 'mailmap' => $blob_as_str );
            $log->debugf( __PACKAGE__ . q{::} . '_check_mailmap(): mailmap.blob (%s) read in.' . ' Content from Git::Mailmap:\n%s',
                $mapfile_blob, $mailmap->to_string() );
        }
        else {
            $git->fault( ( sprintf 'Config variable \'mailmap.blob\' (value: %s) does not point to a file.', $mapfile_blob ),
                { prefix => $PKG, commit => $commit } );
            ++$errors;
        }
    }

    my $verified = 0;

    # Always search (first) among proper emails (and names if wanted).
    my %search_params = ( 'proper-email' => $author_email );
    if ( $git->get_config( $CFG => 'match-mailmap-name' ) eq '1' ) {
        $search_params{'proper-name'} = $author_name;
    }
    $log->debugf( __PACKAGE__ . q{::} . '_check_mailmap(): search_params=%s.', \%search_params );
    $verified = $mailmap->verify(%search_params);
    $log->debugf( __PACKAGE__ . q{::} . '_check_mailmap(): verified=%s.', $verified );

    # If was not found among proper-*, and user wants, search aliases.
    if ( !$verified && $git->get_config( $CFG => 'allow-mailmap-aliases' ) eq '1' ) {
        my %c_search_params = ( 'commit-email' => $author_email );
        if ( $git->get_config( $CFG => 'match-mailmap-name' ) eq '1' ) {
            $c_search_params{'commit-name'} = $author_name;
        }
        $log->debugf( __PACKAGE__ . q{::} . '_check_mailmap(): c_search_params=%s.', \%c_search_params );
        $verified = $mailmap->verify(%c_search_params);
    }
    if ( $verified == 0 ) {
        $git->fault( "Commit author '$author' has no match in mailmap file.", { prefix => $PKG, commit => $commit } );
        ++$errors;
    }

    return $errors == 0;
}

sub check_ref {
    my ( $git, $ref ) = @_;

    return 1 unless $git->is_reference_enabled($ref);

    my $errors = 0;
    foreach my $commit ( $git->get_affected_ref_commits($ref) ) {
        check_commit_at_server( $git, $commit )
          or ++$errors;
    }

    return $errors == 0;
}

# This routine can act both as an update or a pre-receive hook.
sub check_affected_refs {
    my ($git) = @_;

    _setup_config($git);

    return 1 if $git->im_admin($git);

    my $errors = 0;

    foreach my $ref ( $git->get_affected_refs() ) {
        check_ref( $git, $ref )
          or ++$errors;
    }

    return $errors == 0;
}

sub check_patchset {
    my ( $git, $opts ) = @_;

    _setup_config($git);

    my $sha1   = $opts->{'--commit'};
    my $commit = $git->get_commit($sha1);

    my $branch = $opts->{'--branch'};
    $branch = "refs/heads/$branch"
      unless $branch =~ m{^refs/}msx;
    return 1 unless $git->is_reference_enabled($branch);

    return check_commit_at_server( $git, $commit );
}

# Install hooks
my $options = { config => \&_setup_config };

GITHOOKS_CHECK_PRE_COMMIT( \&check_commit_at_client, $options );
GITHOOKS_CHECK_AFFECTED_REFS( \&check_affected_refs, $options );
GITHOOKS_CHECK_PATCHSET( \&check_patchset, $options );

1;

__END__