## no critic (Documentation::RequirePodAtEnd)
## no critic (Documentation::RequirePodSections)
## no critic (Subroutines::RequireArgUnpacking)
package Git::Mailmap;
use strict;
use 5.010000;
# ABSTRACT: Construct and read/write Git mailmap file.
our $VERSION = '0.005'; # VERSION: generated by DZP::OurPkgVersion
use Hash::Util 0.06 qw{lock_keys};
use Scalar::Util qw(blessed);
use Carp;
use Params::Validate qw(:all);
use Log::Any qw{$log};
# 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} ) {
assert_nonblank( $for_alias->{'commit-email'},
'Alias for \''
. ( $for_committer->{'proper-name'} // q{} ) . q{ }
. $for_committer->{'proper-email'}
. '\' is undef.' );
if ( $for_alias->{'commit-email'} eq ( $params{'email'} // q{} ) ) {
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; ## Put here if we find any?
foreach my $for_alias ( @{$aliases} ) {
if ( $for_alias->{'commit-email'} eq ( $params{'commit-email'} // q{} )
&& defined $for_alias->{'commit-name'}
&& defined $params{'commit-name'}
&& $for_alias->{'commit-name'} eq $params{'commit-name'} )
{
## If both name and email are same, this is a duplicate.
## We don't need duplicates!
$alias = $for_alias;
last;
}
elsif ($for_alias->{'commit-email'} eq ( $params{'commit-email'} // q{} )
&& $for_alias->{'commit-name'} ne $params{'commit-name'} )
{
## Different names. Needs a new entry!
last;
}
}
if ( !defined $alias && defined $params{'commit-email'} ) {
$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 ) {
## Create new entry.
$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, }, ## mutually exclusive with 'all'
'proper-name' => { type => SCALAR, optional => 1, },
'commit-email' => { type => SCALAR, optional => 1, },
'commit-name' => { type => SCALAR, optional => 1, },
'all' => { type => BOOLEAN, optional => 1, }, ## mutually exclusive with 'proper-email'
}
);
$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 when no other parameters are.'
);
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;
if ( !blessed $self ) {
# Assuming called as:
# Git::Mailmap->from_string(mailmap => file)
# if ( $self ne __PACKAGE__ ) { unshift @_, $self; }
# $self now contains the package name.
$self = $self->new();
}
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( 'from_string():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 $self;
}
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.005
=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 $plain_mailmap = Git::Mailmap->new(); # => isa 'Git::Mailmap'
$plain_mailmap->from_string('mailmap' => $mailmap_file_as_string);
# OR:
my $mailmap = Git::Mailmap->from_string('mailmap' => $mailmap_file_as_string); # => isa 'Git::Mailmap'
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>')
# Return map as string for writing to file.
my $map = $mailmap->to_string(); # => like qr/Some Dude/
=head1 DESCRIPTION
Git::Mailmap is a pure 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
=for stopwords API mailmap Readonly committer undef committers
=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
=item Log::Any
=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.
Note!
=over 8
=item * There can be only one proper name for each proper email. If more is found, the latter replaces the former.
=item * There can be several different commit names for each commit email.
=back
=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. If any committers already exist,
these will B<not> be removed; so it is possible to merge mailmap files.
If called as a class method (creator method
instead of method new()), will also create the object and return it.
=over 8
=item Parameters:
=over 8
=item I<mailmap>, mandatory. This is the mailmap file as a string.
=back
=item Return: the object.
=back
=head2 to_string
Return a mailmap file as string.
=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