Git.pm: Try to support ActiveState output pipe

The code is stolen from git-annotate and completely untested since
I don't have access to any Microsoft operating system now. Someone
ActiveState-savvy should look at it anyway and try to implement
the input pipe as well, if it is possible at all; also, the implementation
seems to be horribly whitespace-unsafe.

Signed-off-by: Petr Baudis <[email protected]>
Signed-off-by: Junio C Hamano <[email protected]>

Author: Petr Baudis

perl/Git.pm

@@ -663,18 +663,29 @@ sub _command_common_pipe {
 	}
 	_check_valid_cmd($cmd);
 
-	my $pid = open(my $fh, $direction);
-	if (not defined $pid) {
-		throw Error::Simple("open failed: $!");
-	} elsif ($pid == 0) {
-		if (defined $opts{STDERR}) {
-			close STDERR;
-		}
-		if ($opts{STDERR}) {
-			open (STDERR, '>&', $opts{STDERR})
-				or die "dup failed: $!";
+	my $fh;
+	if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
+		# ActiveState Perl
+		#defined $opts{STDERR} and
+		#	warn 'ignoring STDERR option - running w/ ActiveState';
+		$direction eq '-|' or
+			die 'input pipe for ActiveState not implemented';
+		tie ($fh, 'Git::activestate_pipe', $cmd, @args);
+
+	} else {
+		my $pid = open($fh, $direction);
+		if (not defined $pid) {
+			throw Error::Simple("open failed: $!");
+		} elsif ($pid == 0) {
+			if (defined $opts{STDERR}) {
+				close STDERR;
+			}
+			if ($opts{STDERR}) {
+				open (STDERR, '>&', $opts{STDERR})
+					or die "dup failed: $!";
+			}
+			_cmd_exec($self, $cmd, @args);
 		}
-		_cmd_exec($self, $cmd, @args);
 	}
 	return wantarray ? ($fh, join(' ', $cmd, @args)) : $fh;
 }
@@ -749,4 +760,39 @@ sub AUTOLOAD {
 sub DESTROY { }
 
 
+# Pipe implementation for ActiveState Perl.
+
+package Git::activestate_pipe;
+use strict;
+
+sub TIEHANDLE {
+	my ($class, @params) = @_;
+	# FIXME: This is probably horrible idea and the thing will explode
+	# at the moment you give it arguments that require some quoting,
+	# but I have no ActiveState clue... --pasky
+	my $cmdline = join " ", @params;
+	my @data = qx{$cmdline};
+	bless { i => 0, data => \@data }, $class;
+}
+
+sub READLINE {
+	my $self = shift;
+	if ($self->{i} >= scalar @{$self->{data}}) {
+		return undef;
+	}
+	return $self->{'data'}->[ $self->{i}++ ];
+}
+
+sub CLOSE {
+	my $self = shift;
+	delete $self->{data};
+	delete $self->{i};
+}
+
+sub EOF {
+	my $self = shift;
+	return ($self->{i} >= scalar @{$self->{data}});
+}
+
+
 1; # Famous last words