diff options
Diffstat (limited to 'perl/Git.pm')
| -rw-r--r-- | perl/Git.pm | 121 |
1 files changed, 80 insertions, 41 deletions
diff --git a/perl/Git.pm b/perl/Git.pm index d856930b2e..117765dc73 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -9,10 +9,7 @@ package Git; use 5.008; use strict; -use warnings; - -use File::Temp (); -use File::Spec (); +use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); BEGIN { @@ -103,12 +100,9 @@ increase notwithstanding). =cut -use Carp qw(carp croak); # but croak is bad - throw instead +sub carp { require Carp; goto &Carp::carp } +sub croak { require Carp; goto &Carp::croak } use Git::LoadCPAN::Error qw(:try); -use Cwd qw(abs_path cwd); -use IPC::Open2 qw(open2); -use Fcntl qw(SEEK_SET SEEK_CUR); -use Time::Local qw(timegm); } @@ -183,21 +177,34 @@ sub repository { -d $opts{Directory} or throw Error::Simple("Directory not found: $opts{Directory} $!"); my $search = Git->repository(WorkingCopy => $opts{Directory}); - my $dir; + + # This rev-parse will throw an exception if we're not in a + # repository, which is what we want, but it's kind of noisy. + # Ideally we'd capture stderr and relay it, but doing so is + # awkward without depending on it fitting in a pipe buffer. So + # we just reproduce a plausible error message ourselves. + my $out; try { - $dir = $search->command_oneline(['rev-parse', '--git-dir'], - STDERR => 0); + # Note that "--is-bare-repository" must come first, as + # --git-dir output could contain newlines. + $out = $search->command([qw(rev-parse --is-bare-repository --git-dir)], + STDERR => 0); } catch Git::Error::Command with { - $dir = undef; + throw Error::Simple("fatal: not a git repository: $opts{Directory}"); }; - if ($dir) { + chomp $out; + my ($bare, $dir) = split /\n/, $out, 2; + + require Cwd; + if ($bare ne 'true') { + require File::Spec; File::Spec->file_name_is_absolute($dir) or $dir = $opts{Directory} . '/' . $dir; - $opts{Repository} = abs_path($dir); + $opts{Repository} = Cwd::abs_path($dir); # If --git-dir went ok, this shouldn't die either. my $prefix = $search->command_oneline('rev-parse', '--show-prefix'); - $dir = abs_path($opts{Directory}) . '/'; + $dir = Cwd::abs_path($opts{Directory}) . '/'; if ($prefix) { if (substr($dir, -length($prefix)) ne $prefix) { throw Error::Simple("rev-parse confused me - $dir does not have trailing $prefix"); @@ -208,22 +215,7 @@ sub repository { $opts{WorkingSubdir} = $prefix; } else { - # A bare repository? Let's see... - $dir = $opts{Directory}; - - unless (-d "$dir/refs" and -d "$dir/objects" and -e "$dir/HEAD") { - # Mimic git-rev-parse --git-dir error message: - throw Error::Simple("fatal: Not a git repository: $dir"); - } - my $search = Git->repository(Repository => $dir); - try { - $search->command('symbolic-ref', 'HEAD'); - } catch Git::Error::Command with { - # Mimic git-rev-parse --git-dir error message: - throw Error::Simple("fatal: Not a git repository: $dir"); - } - - $opts{Repository} = abs_path($dir); + $opts{Repository} = Cwd::abs_path($dir); } delete $opts{Directory}; @@ -408,10 +400,12 @@ sub command_bidi_pipe { my $cwd_save = undef; if ($self) { shift; - $cwd_save = cwd(); + require Cwd; + $cwd_save = Cwd::getcwd(); _setup_git_cmd_env($self); } - $pid = open2($in, $out, 'git', @_); + require IPC::Open2; + $pid = IPC::Open2::open2($in, $out, 'git', @_); chdir($cwd_save) if $cwd_save; return ($pid, $in, $out, join(' ', @_)); } @@ -538,7 +532,8 @@ sub get_tz_offset { my $t = shift || time; my @t = localtime($t); $t[5] += 1900; - my $gm = timegm(@t); + require Time::Local; + my $gm = Time::Local::timegm(@t); my $sign = qw( + + - )[ $gm <=> $t ]; return sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]); } @@ -563,7 +558,7 @@ sub get_record { Query user C<PROMPT> and return answer from user. Honours GIT_ASKPASS and SSH_ASKPASS environment variables for querying -the user. If no *_ASKPASS variable is set or an error occoured, +the user. If no *_ASKPASS variable is set or an error occurred, the terminal is tried as a fallback. If C<ISPASSWORD> is set and true, the terminal disables echo. @@ -723,6 +718,32 @@ sub config_int { return scalar _config_common({'kind' => '--int'}, @_); } +=item config_regexp ( RE ) + +Retrieve the list of configuration key names matching the regular +expression C<RE>. The return value is a list of strings matching +this regex. + +=cut + +sub config_regexp { + my ($self, $regex) = _maybe_self(@_); + try { + my @cmd = ('config', '--name-only', '--get-regexp', $regex); + unshift @cmd, $self if $self; + my @matches = command(@cmd); + return @matches; + } catch Git::Error::Command with { + my $E = shift; + if ($E->value() == 1) { + my @matches = (); + return @matches; + } else { + throw $E; + } + }; +} + # Common subroutine to implement bulk of what the config* family of methods # do. This currently wraps command('config') so it is not so fast. sub _config_common { @@ -980,7 +1001,7 @@ sub cat_blob { return -1; } - if ($description !~ /^[0-9a-fA-F]{40} \S+ (\d+)$/) { + if ($description !~ /^[0-9a-fA-F]{40}(?:[0-9a-fA-F]{24})? \S+ (\d+)$/) { carp "Unexpected result returned from git cat-file"; return -1; } @@ -1314,6 +1335,7 @@ sub _temp_cache { my $n = $name; $n =~ s/\W/_/g; # no strange chars + require File::Temp; ($$temp_fd, $fname) = File::Temp::tempfile( "Git_${n}_XXXXXX", UNLINK => 1, DIR => $tmpdir, ) or throw Error::Simple("couldn't open new temp file"); @@ -1336,9 +1358,9 @@ sub temp_reset { truncate $temp_fd, 0 or throw Error::Simple("couldn't truncate file"); - sysseek($temp_fd, 0, SEEK_SET) and seek($temp_fd, 0, SEEK_SET) + sysseek($temp_fd, 0, Fcntl::SEEK_SET()) and seek($temp_fd, 0, Fcntl::SEEK_SET()) or throw Error::Simple("couldn't seek to beginning of file"); - sysseek($temp_fd, 0, SEEK_CUR) == 0 and tell($temp_fd) == 0 + sysseek($temp_fd, 0, Fcntl::SEEK_CUR()) == 0 and tell($temp_fd) == 0 or throw Error::Simple("expected file position to be reset"); } @@ -1660,6 +1682,16 @@ sub _setup_git_cmd_env { # by searching for it at proper places. sub _execv_git_cmd { exec('git', @_); } +sub _is_sig { + my ($v, $n) = @_; + + # We are avoiding a "use POSIX qw(SIGPIPE SIGABRT)" in the hot + # Git.pm codepath. + require POSIX; + no strict 'refs'; + $v == *{"POSIX::$n"}->(); +} + # Close pipe to a subprocess. sub _cmd_close { my $ctx = shift @_; @@ -1672,9 +1704,16 @@ sub _cmd_close { } elsif ($? >> 8) { # The caller should pepper this. throw Git::Error::Command($ctx, $? >> 8); + } elsif ($? & 127 && _is_sig($? & 127, "SIGPIPE")) { + # we might e.g. closed a live stream; the command + # dying of SIGPIPE would drive us here. + } elsif ($? & 127 && _is_sig($? & 127, "SIGABRT")) { + die sprintf('BUG?: got SIGABRT ($? = %d, $? & 127 = %d) when closing pipe', + $?, $? & 127); + } elsif ($? & 127) { + die sprintf('got signal ($? = %d, $? & 127 = %d) when closing pipe', + $?, $? & 127); } - # else we might e.g. closed a live stream; the command - # dying of SIGPIPE would drive us here. } } |