We may not have PATH available on some servers (e.g. webrick)
and must rely on the hardcoded system PATH. My installation of
IPC::Run does not seem to work without PATH set in the env,
however normal Perl "open" calls work fine.
use strict;
use warnings;
use File::Path::Expand qw/expand_filename/;
use strict;
use warnings;
use File::Path::Expand qw/expand_filename/;
# returns key-value pairs of config directives in a hash
# if keys may be multi-value, the value is an array ref containing all values
# returns key-value pairs of config directives in a hash
# if keys may be multi-value, the value is an array ref containing all values
my ($in, $out);
$file = default_file() unless defined($file);
my ($in, $out);
$file = default_file() unless defined($file);
- IPC::Run::run([qw/git config --file/, $file, '-l'], \$in, \$out);
- $? == 0 or die "git config --file $file -l failed: $?\n";
+ my @cmd = (qw/git config/, "--file=$file", '-l');
+ my $cmd = join(' ', @cmd);
+ my $pid = open(my $fh, '-|', @cmd);
+ defined $pid or die "$cmd failed: $!\n";
- foreach my $line (split(/\n/, $out)) {
+ foreach my $line (<$fh>) {
+ chomp $line;
my ($k, $v) = split(/=/, $line, 2);
my $cur = $rv{$k};
my ($k, $v) = split(/=/, $line, 2);
my $cur = $rv{$k};
+ close $fh or die "failed to close ($cmd) pipe: $!\n";
+ $? and warn "$$ $cmd exited with: ($pid) $?\n";
my $hex = Digest::SHA::sha1_hex($ctx->{mid});
$hex =~ /\A([a-f0-9]{2})([a-f0-9]{38})\z/i or
die "BUG: not a SHA-1 hex: $hex";
my $hex = Digest::SHA::sha1_hex($ctx->{mid});
$hex =~ /\A([a-f0-9]{2})([a-f0-9]{38})\z/i or
die "BUG: not a SHA-1 hex: $hex";
- require IPC::Run;
- my ($in, $blob, $err);
- open my $null, '+<', '/dev/null' or die "open: $!\n";
- IPC::Run::run(['git', "--git-dir=$ctx->{git_dir}",
- qw(cat-file blob), "HEAD:$1/$2"],
- $null, \$blob, $null);
- $? == 0 ? \$blob : undef;
+
+ my @cmd = ('git', "--git-dir=$ctx->{git_dir}",
+ qw(cat-file blob), "HEAD:$1/$2");
+ my $cmd = join(' ', @cmd);
+ my $pid = open my $fh, '-|';
+ defined $pid or die "fork failed: $!\n";
+ if ($pid == 0) {
+ open STDERR, '>', '/dev/null'; # ignore errors
+ exec @cmd;
+ exit 1;
+ } else {
+ my $blob = eval { local $/; <$fh> };
+ close $fh;
+ $? == 0 ? \$blob : undef;
+ }
}
# /$LISTNAME/m/$MESSAGE_ID.txt -> raw original
}
# /$LISTNAME/m/$MESSAGE_ID.txt -> raw original