X-Git-Url: http://git.tremily.us/?a=blobdiff_plain;f=lib%2FSsoma%2FGit.pm;h=e8d4cf625c4c91789a4877cf63acbc9bfc7b3bad;hb=af679af8257e250ac606e35a1307ad02907b8426;hp=87bf86864443f5b3dd36e9f43f6234e63e3ed1aa;hpb=ee41e4ed76acd5d57fb3c8b9b40b7f45146606f8;p=ssoma-mda.git

diff --git a/lib/Ssoma/Git.pm b/lib/Ssoma/Git.pm
index 87bf868..e8d4cf6 100644
--- 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;