revert: allow cherry-pick --continue to commit before resuming

[git.git] / perl / Git.pm

diff --git a/perl/Git.pm b/perl/Git.pm
index 205e48aa3a7b912005565ac9c296205a897a1476..f7ce511bbbfbff5a479200f2814ad87b96f16791 100644 (file)
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -99,7 +99,7 @@ increase notwithstanding).
 
 use Carp qw(carp croak); # but croak is bad - throw instead
 use Error qw(:try);
-use Cwd qw(abs_path);
+use Cwd qw(abs_path cwd);
 use IPC::Open2 qw(open2);
 use Fcntl qw(SEEK_SET SEEK_CUR);
 }
@@ -396,7 +396,16 @@ See C<command_close_bidi_pipe()> for details.
 
 sub command_bidi_pipe {
        my ($pid, $in, $out);
+       my ($self) = _maybe_self(@_);
+       local %ENV = %ENV;
+       my $cwd_save = undef;
+       if ($self) {
+               shift;
+               $cwd_save = cwd();
+               _setup_git_cmd_env($self);
+       }
        $pid = open2($in, $out, 'git', @_);
+       chdir($cwd_save) if $cwd_save;
        return ($pid, $in, $out, join(' ', @_));
 }
 
@@ -561,30 +570,10 @@ does. In scalar context requires the variable to be set only one time
 (exception is thrown otherwise), in array context returns allows the
 variable to be set multiple times and returns all the values.
 
-This currently wraps command('config') so it is not so fast.
-
 =cut
 
 sub config {
-       my ($self, $var) = _maybe_self(@_);
-
-       try {
-               my @cmd = ('config');
-               unshift @cmd, $self if $self;
-               if (wantarray) {
-                       return command(@cmd, '--get-all', $var);
-               } else {
-                       return command_oneline(@cmd, '--get', $var);
-               }
-       } catch Git::Error::Command with {
-               my $E = shift;
-               if ($E->value() == 1) {
-                       # Key not found.
-                       return;
-               } else {
-                       throw $E;
-               }
-       };
+       return _config_common({}, @_);
 }
 
 
@@ -594,30 +583,33 @@ Retrieve the bool configuration C<VARIABLE>. The return value
 is usable as a boolean in perl (and C<undef> if it's not defined,
 of course).
 
-This currently wraps command('config') so it is not so fast.
-
 =cut
 
 sub config_bool {
-       my ($self, $var) = _maybe_self(@_);
+       my $val = scalar _config_common({'kind' => '--bool'}, @_);
 
-       try {
-               my @cmd = ('config', '--bool', '--get', $var);
-               unshift @cmd, $self if $self;
-               my $val = command_oneline(@cmd);
-               return undef unless defined $val;
+       # Do not rewrite this as return (defined $val && $val eq 'true')
+       # as some callers do care what kind of falsehood they receive.
+       if (!defined $val) {
+               return undef;
+       } else {
                return $val eq 'true';
-       } catch Git::Error::Command with {
-               my $E = shift;
-               if ($E->value() == 1) {
-                       # Key not found.
-                       return undef;
-               } else {
-                       throw $E;
-               }
-       };
+       }
 }
 
+
+=item config_path ( VARIABLE )
+
+Retrieve the path configuration C<VARIABLE>. The return value
+is an expanded path or C<undef> if it's not defined.
+
+=cut
+
+sub config_path {
+       return _config_common({'kind' => '--path'}, @_);
+}
+
+
 =item config_int ( VARIABLE )
 
 Retrieve the integer configuration C<VARIABLE>. The return value
@@ -626,22 +618,31 @@ or 'g' in the config file will cause the value to be multiplied
 by 1024, 1048576 (1024^2), or 1073741824 (1024^3) prior to output.
 It would return C<undef> if configuration variable is not defined,
 
-This currently wraps command('config') so it is not so fast.
-
 =cut
 
 sub config_int {
+       return scalar _config_common({'kind' => '--int'}, @_);
+}
+
+# Common subroutine to implement bulk of what the config* family of methods
+# do. This curently wraps command('config') so it is not so fast.
+sub _config_common {
+       my ($opts) = shift @_;
        my ($self, $var) = _maybe_self(@_);
 
        try {
-               my @cmd = ('config', '--int', '--get', $var);
+               my @cmd = ('config', $opts->{'kind'} ? $opts->{'kind'} : ());
                unshift @cmd, $self if $self;
-               return command_oneline(@cmd);
+               if (wantarray) {
+                       return command(@cmd, '--get-all', $var);
+               } else {
+                       return command_oneline(@cmd, '--get', $var);
+               }
        } catch Git::Error::Command with {
                my $E = shift;
                if ($E->value() == 1) {
                        # Key not found.
-                       return undef;
+                       return;
                } else {
                        throw $E;
                }
@@ -843,7 +844,7 @@ sub _open_hash_and_insert_object_if_needed {
 
        ($self->{hash_object_pid}, $self->{hash_object_in},
         $self->{hash_object_out}, $self->{hash_object_ctx}) =
-               command_bidi_pipe(qw(hash-object -w --stdin-paths --no-filters));
+               $self->command_bidi_pipe(qw(hash-object -w --stdin-paths --no-filters));
 }
 
 sub _close_hash_and_insert_object {
@@ -932,7 +933,7 @@ sub _open_cat_blob_if_needed {
 
        ($self->{cat_blob_pid}, $self->{cat_blob_in},
         $self->{cat_blob_out}, $self->{cat_blob_ctx}) =
-               command_bidi_pipe(qw(cat-file --batch));
+               $self->command_bidi_pipe(qw(cat-file --batch));
 }
 
 sub _close_cat_blob {
@@ -1279,6 +1280,14 @@ sub _command_common_pipe {
 # for the given repository and execute the git command.
 sub _cmd_exec {
        my ($self, @args) = @_;
+       _setup_git_cmd_env($self);
+       _execv_git_cmd(@args);
+       die qq[exec "@args" failed: $!];
+}
+
+# set up the appropriate state for git command
+sub _setup_git_cmd_env {
+       my $self = shift;
        if ($self) {
                $self->repo_path() and $ENV{'GIT_DIR'} = $self->repo_path();
                $self->repo_path() and $self->wc_path()
@@ -1286,8 +1295,6 @@ sub _cmd_exec {
                $self->wc_path() and chdir($self->wc_path());
                $self->wc_subdir() and chdir($self->wc_subdir());
        }
-       _execv_git_cmd(@args);
-       die qq[exec "@args" failed: $!];
 }
 
 # Execute the given Git command ($_[0]) with arguments ($_[1..])