Subject: [PATCH] fixes for ActiveState Perl

From: Rafael Kitover <[email-masked]>
Date: Mon, 14 Feb 2011 06:40:49 -0500

The make for perl is now retrieved from Perl's config. The make fragment in
perl/Makefile.PL added in MY::postamble is disabled on Win32, as it relies on
GNU make syntax, and Win32 users are not likely to have an ancient EU::MM
version.

A Windows path for PERL_PATH is now supported as well, e.g.:
make PERL_PATH=C:\\Perl\\bin\\perl
or from cmd.exe:
make PERL_PATH=C:\Perl\bin\perl
.

t9700-perl-git.sh now passes on ActiveState Perl. Some tweaks were necessary in
Git.pm: a more correct check for absolute directory, exit code check on closing
the "pipe", and always closing the cat_blob bidirectional pipe (with errors
 ignored) so as not to leave zombie processes. The waitpid call on closing the
bidirectional pipe is now timed and the process is killed if necessary. Also
added some binmode calls to t/t9700/test.pl to make the blob tests pass.

Signed-off-by: Rafael Kitover <[email-masked]>
---
 Makefile         |    8 ++++----
 perl/Git.pm      |   40 +++++++++++++++++++++++++++++++---------
 perl/Makefile    |   14 ++++++++++++--
 perl/Makefile.PL |    7 ++++++-
 t/t9700/test.pl  |   15 ++++++++++++++-
 5 files changed, 67 insertions(+), 17 deletions(-)

diff --git a/Makefile b/Makefile
index d3dcfb1..3465ab5 100644
--- a/Makefile
+++ b/Makefile
@@ -175,7 +175,7 @@ all::
 # will work.
 #
 # Define NO_PERL_MAKEMAKER if you cannot use Makefiles generated by perl's
-# MakeMaker (e.g. using ActiveState under Cygwin).
+# MakeMaker.
 #
 # Define NO_PERL if you do not want Perl scripts or libraries at all.
 #
@@ -1059,7 +1059,7 @@ ifeq ($(uname_S),Windows)
 	NO_MKSTEMPS = YesPlease
 	SNPRINTF_RETURNS_BOGUS = YesPlease
 	NO_SVN_TESTS = YesPlease
-	NO_PERL_MAKEMAKER = YesPlease
+	# NO_PERL_MAKEMAKER = YesPlease
 	RUNTIME_PREFIX = YesPlease
 	NO_POSIX_ONLY_PROGRAMS = YesPlease
 	NO_ST_BLOCKS_IN_STRUCT_STAT = YesPlease
@@ -1112,7 +1112,7 @@ ifneq (,$(findstring MINGW,$(uname_S)))
 	NO_MKDTEMP = YesPlease
 	NO_MKSTEMPS = YesPlease
 	NO_SVN_TESTS = YesPlease
-	NO_PERL_MAKEMAKER = YesPlease
+	# NO_PERL_MAKEMAKER = YesPlease
 	RUNTIME_PREFIX = YesPlease
 	NO_POSIX_ONLY_PROGRAMS = YesPlease
 	NO_ST_BLOCKS_IN_STRUCT_STAT = YesPlease
@@ -1652,7 +1652,7 @@ perl/perl.mak: GIT-CFLAGS perl/Makefile perl/Makefile.PL
 
 $(patsubst %.perl,%,$(SCRIPT_PERL)): % : %.perl
 	$(QUIET_GEN)$(RM) $@ $@+ && \
-	INSTLIBDIR=`MAKEFLAGS= $(MAKE) -C perl -s --no-print-directory instlibdir` && \
+	INSTLIBDIR=`MAKEFLAGS= $(MAKE) -C perl -s --no-print-directory instlibdir | sed -e 's/\\\\/\\\\\\\\/g' -e "s/'//g"` && \
 	sed -e '1{' \
 	    -e '	s|#!.*perl|#!$(PERL_PATH_SQ)|' \
 	    -e '	h' \
diff --git a/perl/Git.pm b/perl/Git.pm
index 6cb0dd1..f7d99bd 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -101,6 +101,7 @@ use Error qw(:try);
 use Cwd qw(abs_path);
 use IPC::Open2 qw(open2);
 use Fcntl qw(SEEK_SET SEEK_CUR);
+use File::Spec ();
 }

@@ -184,7 +185,8 @@ sub repository {
 		};
 
 		if ($dir) {
-			$dir =~ m#^/# or $dir = $opts{Directory} . '/' . $dir;
+                        File::Spec->file_name_is_absolute($dir)
+				or $dir = $opts{Directory} . '/' . $dir;
 			$opts{Repository} = abs_path($dir);
 
 			# If --git-dir went ok, this shouldn't die either.
@@ -420,7 +422,15 @@ have more complicated structure.
 
 sub command_close_bidi_pipe {
 	local $?;
-	my ($pid, $in, $out, $ctx) = @_;
+	my ($pid, $in, $out, $ctx, $ignore_errors) = @_;
+
+	if ($ignore_errors) {
+		close $in;
+		close $out;
+		kill -9, $pid;
+		return;
+	}
+
 	foreach my $fh ($in, $out) {
 		unless (close $fh) {
 			if ($!) {
@@ -431,7 +441,14 @@ sub command_close_bidi_pipe {
 		}
 	}
 
-	waitpid $pid, 0;
+	{
+		local $SIG{ALRM} = sub {
+			kill -9, $pid;
+		};
+		alarm 1;
+		waitpid $pid, 0;
+		alarm 0;
+	}
 
 	if ($? >> 8) {
 		throw Git::Error::Command($ctx, $? >>8);
@@ -876,11 +893,13 @@ sub cat_blob {
 
 	my $description = <$in>;
 	if ($description =~ / missing$/) {
+		$self->_close_cat_blob();
 		carp "$sha1 doesn't exist in the repository";
 		return -1;
 	}
 
 	if ($description !~ /^[0-9a-fA-F]{40} \S+ (\d+)$/) {
+		$self->_close_cat_blob();
 		carp "Unexpected result returned from git cat-file";
 		return -1;
 	}
@@ -921,6 +940,8 @@ sub cat_blob {
 		throw Error::Simple("couldn't write to passed in filehandle");
 	}
 
+	$self->_close_cat_blob;
+
 	return $size;
 }
 
@@ -941,7 +962,7 @@ sub _close_cat_blob {
 
 	my @vars = map { 'cat_blob_' . $_ } qw(pid in out ctx);
 
-	command_close_bidi_pipe(@$self{@vars});
+	command_close_bidi_pipe(@$self{@vars}, 1);
 	delete @$self{@vars};
 }
 
@@ -1300,16 +1321,16 @@ sub _cmd_close {
 		if ($!) {
 			# It's just close, no point in fatalities
 			carp "error closing pipe: $!";
-		} elsif ($? >> 8) {
-			# The caller should pepper this.
-			throw Git::Error::Command($ctx, $? >> 8);
-		}
+                }
 		# else we might e.g. closed a live stream; the command
 		# dying of SIGPIPE would drive us here.
 	}
+	if ($? >> 8) {
+		# The caller should pepper this.
+		throw Git::Error::Command($ctx, $? >> 8);
+	}
 }
 
-
 sub DESTROY {
 	my ($self) = @_;
 	$self->_close_hash_and_insert_object();
@@ -1360,3 +1381,4 @@ sub EOF {

 1; # Famous last words
+# vim:noet ts=8 sw=8 sts=8:
diff --git a/perl/Makefile b/perl/Makefile
index a2ffb64..1fa99cd 100644
--- a/perl/Makefile
+++ b/perl/Makefile
@@ -3,18 +3,28 @@
 #
 makfile:=perl.mak
 
+# support PERL_PATH=C:\\Perl\\bin\\perl
+PERL_PATH := $(subst \,\\,$(PERL_PATH))
+
 PERL_PATH_SQ = $(subst ','\'',$(PERL_PATH))
+PERL_MAKE := MAKEFLAGS="" $(subst \,\\,$(shell $(subst \,\\,$(PERL_PATH)) -MConfig -le "print ((\%Config)->{make})"))
+
+ifneq (,$(findstring nmake,$(PERL_MAKE)))
+	PERL_MAKE := $(PERL_MAKE) -nologo
+endif
+
 prefix_SQ = $(subst ','\'',$(prefix))
 
 ifndef V
 	QUIET = @
 endif
 
+
 all install instlibdir: $(makfile)
-	$(QUIET)$(MAKE) -f $(makfile) $@
+	$(QUIET)$(PERL_MAKE) -f $(makfile) $@
 
 clean:
-	$(QUIET)test -f $(makfile) && $(MAKE) -f $(makfile) $@ || exit 0
+	$(QUIET)test -f $(makfile) && ($(PERL_MAKE) -f $(makfile) $@) || exit 0
 	$(RM) ppport.h
 	$(RM) $(makfile)
 	$(RM) $(makfile).old
diff --git a/perl/Makefile.PL b/perl/Makefile.PL
index 0b9deca..7ceec50 100644
--- a/perl/Makefile.PL
+++ b/perl/Makefile.PL
@@ -1,10 +1,13 @@
 use ExtUtils::MakeMaker;
 
 sub MY::postamble {
-	return <<'MAKE_FRAG';
+	my $make_frag = <<'MAKE_FRAG';
 instlibdir:
 	@echo '$(INSTALLSITELIB)'
 
+MAKE_FRAG
+
+	$make_frag .= <<'MAKE_FRAG' if $^O ne 'MSWin32';
 ifneq (,$(DESTDIR))
 ifeq (0,$(shell expr '$(MM_VERSION)' '>' 6.10))
 $(error ExtUtils::MakeMaker version "$(MM_VERSION)" is older than 6.11 and so \
@@ -14,6 +17,8 @@ endif
 endif
 
 MAKE_FRAG
+
+	return $make_frag;
 }
 
 my %pm = ('Git.pm' => '$(INST_LIBDIR)/Git.pm');
diff --git a/t/t9700/test.pl b/t/t9700/test.pl
index 671f38d..d5328a3 100755
--- a/t/t9700/test.pl
+++ b/t/t9700/test.pl
@@ -1,4 +1,12 @@
 #!/usr/bin/perl
+
+BEGIN {
+	use Cwd 'abs_path';
+	my $perl_dir = abs_path('../../perl');
+	eval "use lib '${perl_dir}/blib/lib';";
+	eval "use lib '${perl_dir}/blib/arch/auto/Git';";
+}
+
 use lib (split(/:/, $ENV{GITPERLLIB}));
 
 use 5.006002;
@@ -74,6 +82,7 @@ is($r->ident_person("Name", "email", "123 +0000"), "Name <email>",
 ok(our $file1hash = $r->command_oneline('rev-parse', "HEAD:file1"), "(get file hash)");
 my $tmpfile = "file.tmp";
 open TEMPFILE, "+>$tmpfile" or die "Can't open $tmpfile: $!";
+binmode TEMPFILE;
 is($r->cat_blob($file1hash, \*TEMPFILE), 15, "cat_blob: size");
 our $blobcontents;
 { local $/; seek TEMPFILE, 0, 0; $blobcontents = <TEMPFILE>; }
@@ -81,11 +90,13 @@ is($blobcontents, "changed file 1\n", "cat_blob: data");
 close TEMPFILE or die "Failed writing to $tmpfile: $!";
 is(Git::hash_object("blob", $tmpfile), $file1hash, "hash_object: roundtrip");
 open TEMPFILE, ">$tmpfile" or die "Can't open $tmpfile: $!";
+binmode TEMPFILE;
 print TEMPFILE my $test_text = "test blob, to be inserted\n";
 close TEMPFILE or die "Failed writing to $tmpfile: $!";
 like(our $newhash = $r->hash_and_insert_object($tmpfile), qr/[0-9a-fA-F]{40}/,
      "hash_and_insert_object: returns hash");
 open TEMPFILE, "+>$tmpfile" or die "Can't open $tmpfile: $!";
+binmode TEMPFILE;
 is($r->cat_blob($newhash, \*TEMPFILE), length $test_text, "cat_blob: roundtrip size");
 { local $/; seek TEMPFILE, 0, 0; $blobcontents = <TEMPFILE>; }
 is($blobcontents, $test_text, "cat_blob: roundtrip data");
@@ -115,5 +126,7 @@ isnt($last_commit, $dir_commit, 'log . does not show last commit');
 
 printf "1..%d\n", Test::More->builder->current_test;
 
-my $is_passing = eval { Test::More->is_passing };
+my $is_passing = eval { Test::More->builder->is_passing }
+	|| eval { Test::More->is_passing };
 exit($is_passing ? 0 : 1) unless $@ =~ /Can't locate object method/;
+# vim:noet ts=8 sw=8 sts=8:
-- 
1.7.3.1.msysgit.0.1.g49f6d.dirty