## no critic (Modules::RequireVersionVar)
## no critic (Documentation::RequirePodAtEnd)
## no critic (Documentation::RequirePodSections)
## no critic (Subroutines::RequireArgUnpacking)

package Git::Mailmap;

use strict;
use warnings;
use 5.010_000;
use Data::Dumper;

# Global creator
BEGIN {
    use parent qw( Exporter );
    our ( @EXPORT_OK, %EXPORT_TAGS );
    %EXPORT_TAGS = ();
    @EXPORT_OK   = qw();
}
our @EXPORT_OK;

# Global destructor
END {
}

# ABSTRACT: Construct and read/write Git mailmap file.

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

use Log::Any qw{$log};
use Hash::Util 0.06 qw{lock_keys lock_keys_plus unlock_keys};
use Carp;
use Carp::Assert;
use Carp::Assert::More;

use Params::Validate qw(:all);
use Readonly;

# CONSTANTS
Readonly::Scalar my $EMPTY_STRING => q{};
Readonly::Scalar my $LF           => qq{\n};
Readonly::Scalar my $EMAIL_ADDRESS_REGEXP =>
  q{<[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+.>};    ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
Readonly::Hash my %VALIDATE_PARAM_EMAIL    => ( 'regex' => qr/$EMAIL_ADDRESS_REGEXP/msx );
Readonly::Hash my %VALIDATE_PARAM_NONBLANK => ( 'regex' => qr/\S+/msx );
Readonly::Scalar my $PROPER_NAME           => q{proper-name};
Readonly::Scalar my $PROPER_EMAIL          => q{proper-email};
Readonly::Scalar my $COMMIT_NAME           => q{commit-name};
Readonly::Scalar my $COMMIT_EMAIL          => q{commit-email};

sub new {
    my $class  = shift;
    my %params = validate(
        @_, {},                              # No parameters when creating object!
    );

    $log->tracef( 'Entering new(%s, %s)', $class, \%params );
    my $self      = {};
    my @self_keys = (
        'committers',                        # Object's data.
    );
    bless $self, $class;
    $self->{'committers'} = [];
    lock_keys( %{$self}, @self_keys );
    $log->tracef( 'Exiting new: %s', $self );
    return $self;
}

## no critic (Subroutines::ProhibitBuiltinHomonyms)
sub map {
    my $self   = shift;
    my %params = validate(
        @_,
        {
            'email' => { 'type' => SCALAR, %VALIDATE_PARAM_NONBLANK, },
            'name'  => { 'type' => SCALAR, 'optional' => 1, %VALIDATE_PARAM_NONBLANK, },
        }
    );
    $log->tracef( 'Entering map(%s)', \%params );
    my @mapped_to = ( undef, undef );
    my $committer;
    foreach my $for_committer ( @{ $self->{'committers'} } ) {
        if ( $for_committer->{'proper-email'} eq $params{'email'} ) {
            $committer = $for_committer;
            last;
        }
        else {
            assert_listref( $for_committer->{'aliases'}, 'Item \'aliases\' exists.' );
            my $aliases = $for_committer->{'aliases'};
            foreach my $for_alias ( @{$aliases} ) {
                if ( $for_alias->{'commit-email'} eq $params{'email'} ) {
                    if ( !defined $params{'name'} ) {
                        $committer = $for_committer;
                        last;
                    }
                    elsif ( defined $params{'name'}
                        && $params{'name'} eq $for_alias->{'commit-name'} )
                    {
                        $committer = $for_committer;
                        last;
                    }

                    # If name parameter is defined and not matches here,
                    # try the next alias!
                }
            }
            if ($committer) {
                last;
            }
        }
    }
    if ( defined $committer ) {
        @mapped_to = ( $committer->{'proper-name'}, $committer->{'proper-email'} );
    }
    $log->tracef( 'Exiting map: %s', \@mapped_to );
    return @mapped_to;
}

sub add {
    my $self   = shift;
    my %params = validate(
        @_,
        {
            'proper-email' => { type => SCALAR, %VALIDATE_PARAM_NONBLANK, },
            'proper-name'  => { type => SCALAR, optional => 1, %VALIDATE_PARAM_NONBLANK, depends => ['proper-email'], },
            'commit-email' => { type => SCALAR, optional => 1, %VALIDATE_PARAM_NONBLANK, },
            'commit-name'  => { type => SCALAR, optional => 1, %VALIDATE_PARAM_NONBLANK, depends => ['commit-email'], },
        },
    );
    $log->tracef( 'Entering add(%s)', \%params );
    my $committer;
    foreach my $for_committer ( @{ $self->{'committers'} } ) {
        if ( $for_committer->{'proper-email'} eq $params{'proper-email'} ) {
            if ( $params{'proper-name'} ) {
                $for_committer->{'proper-name'} = $params{'proper-name'};
            }
            assert_listref( $for_committer->{'aliases'}, 'Item \'aliases\' exists.' );
            my $aliases = $for_committer->{'aliases'};
            my $alias;
            foreach my $for_alias ( @{$aliases} ) {
                if ( $for_alias->{'commit-email'} eq $params{'commit-email'} ) {
                    $for_alias->{'commit-name'} = $params{'commit-name'};
                    $for_alias = $for_alias;
                    last;
                }
            }
            if ( !defined $alias ) {
                $alias = { 'commit-email' => $params{'commit-email'} };
                if ( $params{'commit-name'} ) {
                    $alias->{'commit-name'} = $params{'commit-name'};
                }
                push @{$aliases}, $alias;
            }
            $committer = $for_committer;
            last;
        }
    }
    if ( !defined $committer ) {
        $committer = { 'proper-email' => $params{'proper-email'} };
        if ( $params{'proper-name'} ) {
            $committer->{'proper-name'} = $params{'proper-name'};
        }
        $committer->{'aliases'} = [];
        my $alias;
        if ( $params{'commit-email'} ) {
            $alias = { 'commit-email' => $params{'commit-email'} };
            if ( $params{'commit-name'} ) {
                $alias->{'commit-name'} = $params{'commit-name'};
            }
            push @{ $committer->{'aliases'} }, $alias;
        }
        push @{ $self->{'committers'} }, $committer;
    }
    $log->tracef( 'Exiting add: %s', $self );
    return;
}

sub verify {    ## no critic (Subroutines/ProhibitExcessComplexity)
    my $self   = shift;
    my %params = validate(
        @_,
        {
            'proper-email' => { type => SCALAR, optional => 1, },
            'proper-name'  => { type => SCALAR, optional => 1, },
            'commit-email' => { type => SCALAR, optional => 1, },
            'commit-name'  => { type => SCALAR, optional => 1, },

            # 'match-when-no-name' => {
            #     type => BOOLEAN, optional => 1, default => 1, },
            # # If mailmap has no name, but caller has name, match if param is true.
        }
    );
    ## no critic (ControlStructures::ProhibitPostfixControls)
    $log->tracef( 'Entering verify(%s)', \%params );
    my $committers = $self->{'committers'};
    my %found      = (
        $PROPER_EMAIL => -1,
        $PROPER_NAME  => -1,
        $COMMIT_EMAIL => -1,
        $COMMIT_NAME  => -1,
    );
    foreach ( $PROPER_EMAIL, $PROPER_NAME, $COMMIT_EMAIL, $COMMIT_NAME ) {
        $found{$_} = 0 if ( defined $params{$_} );
    }
    foreach my $committer ( @{$committers} ) {
        foreach ( $PROPER_EMAIL, $PROPER_NAME, $COMMIT_EMAIL, $COMMIT_NAME ) {
            $found{$_} = 1 if ( defined $committer->{$_}
                && defined $params{$_}
                && $committer->{$_} eq $params{$_} );
        }
        my $aliases = $committer->{'aliases'};
        foreach my $alias ( @{$aliases} ) {
            foreach ( $PROPER_EMAIL, $PROPER_NAME, $COMMIT_EMAIL, $COMMIT_NAME ) {
                $found{$_} = 1 if ( defined $alias->{$_}
                    && defined $params{$_}
                    && $alias->{$_} eq $params{$_} );
            }
        }
    }
    my $match =
      ( $found{$PROPER_EMAIL} != 0 && $found{$PROPER_NAME} != 0 && $found{$COMMIT_EMAIL} != 0 && $found{$COMMIT_NAME} != 0 )
      ? 1
      : 0;
    $log->tracef( 'Exiting verify: %s', $match );
    return $match;
}

sub remove {    ## no critic (Subroutines/ProhibitExcessComplexity)
    my $self   = shift;
    my %params = validate(
        @_,
        {
            'proper-email' => { type => SCALAR,  optional => 1, },
            'proper-name'  => { type => SCALAR,  optional => 1, },
            'commit-email' => { type => SCALAR,  optional => 1, },
            'commit-name'  => { type => SCALAR,  optional => 1, },
            'all'          => { type => BOOLEAN, optional => 1, },
        }
    );
    $log->tracef( 'Entering remove(%s)', \%params );
    assert(
        (
                 defined $params{'all'}
              && !defined $params{'proper-email'}
              && !defined $params{'proper-name'}
              && !defined $params{'commit-email'}
              && !defined $params{'commit-name'}
        )
          || (
            !defined $params{'all'}
            && (   defined $params{'proper-email'}
                || defined $params{'proper-name'}
                || defined $params{'commit-email'}
                || defined $params{'commit-name'} )
          ),
        'Parameter \'all\' is only present without other parameters.'
    );
    if ( defined $params{'all'} && $params{'all'} eq '1' ) {
        @{ $self->{'committers'} } = [];
    }
    else {
        my $committers = $self->{'committers'};
        for ( my $i = 0 ; $i < scalar @{$committers} ; ) {    ## no critic (ControlStructures::ProhibitCStyleForLoops)
            my $for_committer = $committers->[$i];
            if ( $for_committer->{'proper-email'} eq $params{'proper-email'}
                || !defined $params{'commit-email'} )
            {
                if ( !defined $params{'commit-email'} ) {

                    # Cut away the whole list entry.
                    splice @{$committers}, $i, 1;
                }
                else {
                    # Don't cut away the whole entry, just the matching aliases.
                    assert_arrayref( $for_committer->{'aliases'}, 'Item \'aliases\' exists.' );
                    my $aliases = $for_committer->{'aliases'};
                    for ( my $j = 0 ; $j < scalar @{$aliases} ; ) {    ## no critic (ControlStructures::ProhibitCStyleForLoops)
                        my $for_alias = $aliases->[$j];
                        if ( $for_alias->{'commit-email'} eq $params{'commit-email'} )
                        {                                              ## no critic (ControlStructures::ProhibitDeepNests)
                            splice @{$aliases}, $j, 1;
                            last;
                        }
                        else {
                            $j++;
                        }
                    }
                }
            }
            else {
                $i++;
            }
        }
    }
    $log->tracef( 'Exiting remove: %s', $self );
    return;
}

sub from_string {
    my $self   = shift;
    my %params = validate(
        @_,
        {
            'mailmap' => { type => SCALAR, },
        }
    );
    $log->tracef( 'Entering from_string(%s)', \%params );
    assert_defined( $params{'mailmap'}, 'Parameter \'mailmap\' is a defined string.' );
    foreach my $row ( split qr/\n/msx, $params{'mailmap'} ) {
        $log->debug( 'from_string: reading row:\'%s\'.', $row );
        if ( $row !~ /^[[:space:]]*\#/msx ) {    # Skip comment rows.
                                                 # Comments can also be at the end of the row. Remove them:
            $row =~ s/(\#.*)$//msx;
            my ( $proper_name, $proper_email, $commit_name, $commit_email );

            # The special case of 'Proper Name <commit@email.xx>'
            if ( $row =~ m/^([^<>]*)($EMAIL_ADDRESS_REGEXP)[[:space:]]*$/msx ) {
                ( $proper_name, $proper_email ) = $row =~ /^(.*)($EMAIL_ADDRESS_REGEXP)[[:space:]]*$/msx;
                ( $commit_name, $commit_email ) = ( $EMPTY_STRING, $EMPTY_STRING );
            }
            elsif ( $row =~ /^(.*)($EMAIL_ADDRESS_REGEXP)(.+)($EMAIL_ADDRESS_REGEXP)[[:space:]]*$/msx ) {
                ( $proper_name, $proper_email, $commit_name, $commit_email ) =
                  $row =~ /^(.*)($EMAIL_ADDRESS_REGEXP)(.+)($EMAIL_ADDRESS_REGEXP)[[:space:]]*$/msx;
            }
            else {
                carp "Can not parse the following row: '$row'";
            }

            # Remove beginning and end whitespace.
            $proper_name =~ s/^\s+|\s+$//sxmg;
            $commit_name =~ s/^\s+|\s+$//sxmg;

            $log->debugf(
                'clean_mailmap_file(parsing):proper_name=\'%s\', proper_email=\'%s\', commit_name=\'%s\', commit_email=\'%s\'.',
                $proper_name, $proper_email, $commit_name, $commit_email );
            my %add_params = ( 'proper-email' => $proper_email );
            if ( length $proper_name > 0 ) {
                $add_params{'proper-name'} = $proper_name;
            }
            if ( length $commit_email > 0 ) {
                $add_params{'commit-email'} = $commit_email;
            }
            if ( length $commit_name > 0 ) {
                $add_params{'commit-name'} = $commit_name;
            }
            $self->add(%add_params);
        }
    }

    $log->tracef( 'Exiting from_string: %s', $self );
    return;
}

sub to_string {
    my $self   = shift;
    my %params = validate(
        @_, {},    # No parameters!
    );
    $log->tracef( 'Entering to_string(%s)', \%params );

    # proper_part + alias_part
    # if !alias_parts, proper_part + proper_part
    my $file       = $EMPTY_STRING;
    my $committers = $self->{'committers'};
    foreach my $committer ( @{$committers} ) {
        assert_nonblank( $committer->{'proper-email'}, 'Committer has nonblank item \'proper-email}\'.' );
        my $proper_part = $EMPTY_STRING;
        if ( defined $committer->{'proper-name'} ) {
            $proper_part .= $committer->{'proper-name'} . q{ };
        }
        $proper_part .= $committer->{'proper-email'};
        assert_listref( $committer->{'aliases'}, 'Item \'aliases\' exists.' );
        my $aliases = $committer->{'aliases'};
        if ( scalar @{$aliases} > 0 ) {
            foreach my $alias ( @{$aliases} ) {
                assert_nonblank( $alias->{'commit-email'}, 'Alias has nonblank item \'commit-email}\'.' );
                my $alias_part = $EMPTY_STRING;
                if ( defined $alias->{'commit-name'} ) {
                    $alias_part .= $alias->{'commit-name'} . q{ };
                }
                $alias_part .= $alias->{'commit-email'};
                $file .= $proper_part . q{ } . $alias_part . "\n";
            }
        }
        else {
            $file .= $proper_part . q{ } . $proper_part . "\n";
        }
    }
    $log->tracef( 'Exiting to_string: %s', $file );
    return $file;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Git::Mailmap - Construct and read/write Git mailmap file.

=head1 VERSION

version 0.001

=head1 SYNOPSIS

    require Git::Mailmap;

    my $mailmap_file_as_string = '<cto@company.xx> <cto@coompany.xx>
    Some Dude <some@dude.xx>         nick1 <bugs@company.xx>
    Other Author <other@author.xx>   nick2 <bugs@company.xx>
    ';

    my $mailmap = Git::Mailmap->new(); # => isa 'Git::Mailmap2'
    $mailmap->from_string($mailmap_file_as_string);
    my $correct = $mailmap->verify( 'proper-email' => '<cto@company.xx>'); # => 1
    my $fail = $mailmap->verify(
            'proper-email' => '<cto@company.xx>',
            'proper-name' => 'CTO'); # => 0
    # Fail: no email address with that name!
    my ($mapped_to_name, $mapped_to_email) = $mailmap->map(
            'email' => '<bugs@company.xx>',
            'name' => 'nick1');
    # mapped_to_name => 'Some Dudeeed'
    # mapped_to_email => '<some@dude.xx>'
    my @mapped_to = $mailmap->map('email' => '<cto@coompany.xx>');
    # mapped_to => is_deeply (undef, '<cto@company.xx>')

=head1 DESCRIPTION

Git::Mailmap is a Perl implementation of the mailmap functionality in Git.
It allows to create a mailmap by adding a mapped address at a time, or
removing unwanted ones. You can also read or write the mailmap file as
a string.

For mailmap, please see
L<http://git-scm.com/docs/git-shortlog#_mapping_authors|http://git-scm.com/docs/git-shortlog#_mapping_authors>

=head1 STATUS

Package Git::Mailmap is currently being developed so changes in the API and functionality are possible, though not likely.

=head1 REQUIREMENTS

The Git::Mailmap package requires the following packages (in addition to normal Perl core packages):

=over 8

=item Carp

=item Carp::Assert

=item Carp::Assert::More

=item Params::Validate

=item Readonly

=back

=head1 SUBROUTINES/METHODS

=head2 new

Creator function.

=head2 map

Map the committer name and email to proper name/email. The email can be
proper-email or committer-email (alias). Email is mandatory parameter.
If also name is given, then looks for both. If only email, then
the mapping is done to the first matching email address,
regardless of the name.

=over 8

=item Parameters:

=over 8

=item I<name>, not mandatory.

=item I<email>, mandatory.

=back

=item Return: LIST(proper-name, proper-email). If no name is mapped, then undef. If no email address is mapped, then both are undef.

=back

=head2 add

Add new committer. Add all other information.

=over 8

=item Parameters:

=over 8

=item I<proper-email>, mandatory

=item I<proper-name>, not mandatory

=item I<commit-email>, not mandatory

=item I<commit-name>, not mandatory

=back

=item Return: [NONE]

=back

=head2 verify

Search for a given name and/or email.

=over 8

=item Parameters:

=over 8

=item I<proper-email>, not mandatory.

=item I<proper-name>, not mandatory. If matching name is not important,
don't set the *-name parameters!

=item I<commit-email>, not mandatory.

=item I<commit-name>, not mandatory.

=back

=item Return: 1/0, 1 if verified to exist.

=back

=head2 remove

Remove committer information. Remove as much information as you can.

=over 8

=item Parameters:

=over 8

=item I<proper-email>, mandatory. If you specify only this, the whole entry (with proper-name and aliases) will be removed. Other combinations are not supported.

=item I<proper-name>, not mandatory. Not supported.

=item I<commit-email>, not mandatory. If you specify only this, every entry will be checked, and all aliases with this commit email will be removed. If you specify this together with proper-email, only the alias in the entry with that proper-email will be removed.

=item I<commit-name>, not mandatory. Not supported.

=item I<all>, not mandatory. Cannot be used together with other parameters. Removes all committers.

=back

=item Return: [NONE]

=back

=head2 from_string

Read the committers from a string.

=over 8

=item Parameters:

=over 8

=item I<mailmap>, mandatory. This is the mailmap file as a string.

=back

=item Return: [NONE].

=back

=head2 to_string

Return a string. If you give the parameter I<filename>,
the mailmap will be written directly to file. If you give no parameters,
this method will return a string consisting of the same text which otherwise
would have been written to a file.

=over 8

=item Parameters:

=over 8

=item [NONE]

=back

=item Return: string.

=back

=head1 AUTHOR

Mikko Koivunalho <mikko.koivunalho@iki.fi>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Mikko Koivunalho.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
