ssoma-mda: Use the email subject as the commit message

[ssoma-mda.git] / lib / Ssoma / Git.pm

diff --git a/lib/Ssoma/Git.pm b/lib/Ssoma/Git.pm
index 87bf86864443f5b3dd36e9f43f6234e63e3ed1aa..e8d4cf625c4c91789a4877cf63acbc9bfc7b3bad 100644 (file)
--- a/lib/Ssoma/Git.pm
+++ b/lib/Ssoma/Git.pm
@@ -1,21 +1,17 @@
 # Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
-# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+# License: GPLv2 or later (https://www.gnu.org/licenses/gpl-2.0.txt)
 #
 # Note: some trivial code here stolen from git-svn + Perl modules
-# distributed with git.  I wrote these long ago and retain my copyright
-# to it, so I'm within my right to relicense as AGPLv3+.  The original
-# git versions remain GPLv2.
-#
-# Not using Git.pm and friends directly because some git installations may use
-# a different Perl than this (and I might end up rewriting this entirely
-# in C at a later time...)
+# distributed with git.  This remains GPLv2+ so improvements may flow
+# back into git.  Note: git-svn has always been GPLv2+, unlike most
+# of the rest of git being GPLv2-only.
+
 package Ssoma::Git;
 use strict;
 use warnings;
 use File::Path qw/mkpath/;
+use Fcntl qw/:DEFAULT :flock SEEK_END/;
 use IO::Handle;
-use Fcntl;
-use File::FcntlLock;
 use Email::Simple;
 use Digest::SHA qw/sha1_hex/;
 
@@ -50,12 +46,6 @@ sub lockfile { $_[0]->{git_dir} . "/ssoma.lock" }
 sub sync_do {
        my ($self, $sub) = @_;
 
-       my $fs = File::FcntlLock->new;
-       $fs->l_type(F_WRLCK);
-       $fs->l_type(SEEK_CUR);
-       $fs->l_start(0);
-       $fs->l_len(0);
-
        my $path = $self->lockfile;
        my $lock;
 
@@ -66,14 +56,14 @@ sub sync_do {
                die "failed to open lock $path: $!\n";
 
        # wait for other processes to be done
-       $fs->lock($lock, F_SETLKW) or die "lock failed: " . $fs->error . "\n";
+       flock($lock, LOCK_EX) or die "lock failed: $!\n";
 
        # run the sub!
        my @ret = eval { &$sub };
        my $err = $@;
 
        # these would happen anyways, but be explicit so we can detect errors
-       $fs->lock($lock, F_UNLCK) or die "unlock failed: " . $fs->error . "\n";
+       flock($lock, LOCK_UN) or die "unlock failed: $!\n";
        close $lock or die "close lockfile($path) failed: $!\n";
 
        die $err if $err;
@@ -200,6 +190,8 @@ sub stripws {
 sub mid2path {
        my ($self, $message_id) = @_;
        stripws($message_id);
+       $message_id =~ s/\A<//;
+       $message_id =~ s/>\z//;
        my $hex = sha1_hex($message_id);
        $hex =~ /\A([a-f0-9]{2})([a-f0-9]{38})\z/i or
                        die "BUG: not a SHA-1 hex: $hex";
@@ -207,10 +199,20 @@ sub mid2path {
 }
 
 sub cat_blob {
-       my ($self, $blob_id) = @_;
-       my $cmd = "git cat-file blob $blob_id";
-       my $str = `$cmd`;
-       die "$cmd failed: $?\n" if $?;
+       my ($self, $blob_id, $git_pm) = @_;
+       my $str;
+       if ($git_pm) {
+               open my $fh, '>', \$str or
+                               die "failed to setup string handle: $!\n";
+               binmode $fh;
+               my $bytes = $git_pm->cat_blob($blob_id, $fh);
+               close $fh or die "failed to close string handle: $!\n";
+               die "$blob_id invalid\n" if $bytes <= 0;
+       } else {
+               my $cmd = "git cat-file blob $blob_id";
+               $str = `$cmd`;
+               die "$cmd failed: $?\n" if $?;
+       }
        $str;
 }
 
@@ -261,9 +263,11 @@ sub commit_index {
        }
 
        # make the commit
-       my @cmd = (qw/git commit-tree -m/, $message);
-       push @cmd, '-p', $parent if $parent;
+       my @cmd = qw/git commit-tree/;
        push @cmd, $tree;
+       push @cmd, '-p', $parent if $parent;
+       push @cmd, '-m', "'$message'";
+
        my $commit = $self->qx_sha1(join(' ', @cmd));
 
        # update the ref
@@ -276,4 +280,13 @@ sub commit_index {
        system(@cmd) == 0 or die "command: ". join(' ', @cmd) . ": $?\n";
 }
 
+# keep Git.pm optional, not all installations of git have it
+sub try_git_pm {
+       my ($self) = @_;
+       eval {
+               require Git;
+               Git->repository(Directory => $self->{git_dir});
+       };
+}
+
 1;