[PATCH 1/3] set author info on git commits

[PATCH 1/3] set author info on git commits

[Eric Wong]

This should make it easier to show authorship of messages by using
"git log".  This adds new dependencies on Email::MIME and
Email::Address, but they should be readily available on most
distributions and are also used by public-inbox.
---
 INSTALL          |  2 ++
 Makefile.PL      |  2 ++
 lib/Ssoma/MDA.pm | 42 +++++++++++++++++++++++++++---------------
 ssoma-mda        |  4 ++--
 t/all.t          |  8 ++++++++
 5 files changed, 41 insertions(+), 17 deletions(-)

diff --git a/INSTALL b/INSTALL
index 691b122..67e71ca 100644
--- a/INSTALL
+++ b/INSTALL
@@ -36,7 +36,9 @@ convenience.
 * any MUA capable of reading/importing IMAP, mbox(5) or Maildir
 * Perl and several modules:     (Debian package name (7.0))
   - Digest::SHA                 perl
+  - Email::Address              libemail-address-perl
   - Email::LocalDelivery        libemail-localdelivery-perl
+  - Email::MIME                 libemail-mime-perl
   - Email::Simple               libemail-simple-perl
   - File::Path::Expand          libfile-path-expand-perl
   - Net::IMAP::Simple           libnet-imap-simple-perl
diff --git a/Makefile.PL b/Makefile.PL
index 1055eb3..3b961ff 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -15,8 +15,10 @@ WriteMakefile(
 	PREREQ_PM => {
 		# Keep this sorted and synced to the INSTALL document
 		'Digest::SHA' => 0,
+		'Email::Address' => 0,
 		'Email::LocalDelivery' => 0,
 		'Email::Simple' => 0,
+		'Email::MIME' => 0,
 		'File::Path::Expand' => 0,
 		'Net::IMAP::Simple' => 0,
 	},
diff --git a/lib/Ssoma/MDA.pm b/lib/Ssoma/MDA.pm
index 02816a5..387b1a2 100644
--- a/lib/Ssoma/MDA.pm
+++ b/lib/Ssoma/MDA.pm
@@ -6,6 +6,7 @@ package Ssoma::MDA;
 use strict;
 use warnings;
 use Ssoma::GitIndexInfo;
+use Email::Address;
 
 sub new {
 	my ($class, $git) = @_;
@@ -29,9 +30,9 @@ sub blob_upgrade {
 	$gii->remove($path);
 
 	# implicitly create a new tree via index with two messages
-	foreach my $simple ($cur, $new) {
-		my $id = $git->simple_to_blob($simple);
-		my $path2 = $git->hash_simple2($simple);
+	foreach my $mime ($cur, $new) {
+		my $id = $git->simple_to_blob($mime);
+		my $path2 = $git->hash_simple2($mime);
 		$gii->update("100644", $id, "$path/$path2");
 	}
 	1;
@@ -68,7 +69,7 @@ sub tree_update {
 # this appends the given message-id to the git repo, requires locking
 # (Ssoma::Git::sync_do)
 sub append {
-	my ($self, $path, $simple, $once) = @_;
+	my ($self, $path, $mime, $once) = @_;
 
 	my $git = $self->{git};
 	my $ref = $self->{ref};
@@ -83,52 +84,63 @@ sub append {
 	if ($? == 0) { # rare, object already exists
 		chomp $type;
 		if ($once) {
-			my $mid = $simple->header("Message-ID");
+			my $mid = $mime->header("Message-ID");
 			die "CONFLICT: Message-ID: $mid exists ($path)\n";
 		}
 
 		# we return undef here if the message already exists
 		if ($type eq "blob") {
 			# this may upgrade the existing blob to a tree
-			$self->blob_upgrade($gii, $simple, $path) or return;
+			$self->blob_upgrade($gii, $mime, $path) or return;
 		} elsif ($type eq "tree") {
 			# possibly add object to an existing tree
-			$self->tree_update($gii, $simple, $path) or return;
+			$self->tree_update($gii, $mime, $path) or return;
 		} else {
 			# we're screwed if a commit/tag has the same SHA-1
 			die "CONFLICT: `$cmd' returned: $type\n";
 		}
 	} else { # new message, just create a blob, common
-		my $id = $git->simple_to_blob($simple);
+		my $id = $git->simple_to_blob($mime);
 		$gii->update('100644', $id, $path);
 	}
-	$git->commit_index($gii, 0, $ref, "mda");
+
+	{
+		my $from = $mime->header('From');
+		my @from = Email::Address->parse($from);
+		my $name = $from[0]->name;
+		my $email = $from[0]->address;
+		my $date = $mime->header('Date');
+		local $ENV{GIT_AUTHOR_NAME} ||= $name if defined $name;
+		local $ENV{GIT_AUTHOR_EMAIL} ||= $email if defined $email;
+		local $ENV{GIT_AUTHOR_DATE} ||= $date if defined $date;
+		$git->commit_index($gii, 0, $ref, "mda");
+	}
 }
 
 # the main entry point takes an Email::Simple object
 sub deliver {
-	my ($self, $simple, $once) = @_;
+	my ($self, $mime, $once) = @_;
 	my $git = $self->{git};
 
 	# convert the Message-ID into a path
-	my $mid = $simple->header("Message-ID");
+	my $mid = $mime->header("Message-ID");
 
 	# if there's no Message-ID, generate one to avoid too many conflicts
 	# leading to trees
 	if (!defined $mid || $mid =~ /\A\s*\z/) {
-		$mid = '<' . $git->hash_simple2($simple) . '@localhost>';
-		$simple->header_set("Message-ID", $mid);
+		$mid = '<' . $git->hash_simple2($mime) . '@localhost>';
+		$mime->header_set("Message-ID", $mid);
 	}
 	my $path = $git->mid2path($mid);
 
 	# kill potentially confusing/misleading headers
 	foreach my $d (qw(lines content-length)) {
-		$simple->header_set($d);
+		$mime->header_set($d);
 	}
 
 	my $sub = sub {
 		$git->tmp_index_do(sub {
-			$self->append($path, $simple, $once);
+			$self->append($path, $mime, $once);
 		});
 	};
 	$git->sync_do(sub { $git->tmp_git_do($sub) });
diff --git a/ssoma-mda b/ssoma-mda
index d763224..2d658d2 100755
--- a/ssoma-mda
+++ b/ssoma-mda
@@ -9,7 +9,7 @@ use strict;
 use warnings;
 use Ssoma::MDA;
 use Ssoma::Git;
-use Email::Simple;
+use Email::MIME;
 my $once = $ARGV[0] eq "-1";
 my $repo = pop @ARGV or die "Usage: $usage\n";
 my $git = Ssoma::Git->new($repo);
@@ -17,6 +17,6 @@ my $mda = Ssoma::MDA->new($git);
 my $simple;
 {
 	local $/;
-	$simple = Email::Simple->new(<STDIN>);
+	$simple = Email::MIME->new(<STDIN>);
 }
 $mda->deliver($simple, $once);
diff --git a/t/all.t b/t/all.t
index d58e1db..6f6a203 100644
--- a/t/all.t
+++ b/t/all.t
@@ -45,6 +45,14 @@ EOF
 	print $pipe $simple->as_string or die "print failed: $!\n";
 	close $pipe or die "close pipe failed: $!\n";
 	is($?, 0, "$mda exited successfully");
+
+	{
+		local $ENV{GIT_DIR} = $git_dir;
+		my @x = `git cat-file commit HEAD`;
+		chomp @x;
+		my @au = grep(/^author /, @x);
+		like($au[0], qr/\Aauthor me <me\@example\.com>/, "author set");
+	}
 }
 
 {
-- 
EW