summaryrefslogtreecommitdiff
path: root/perl/Git.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl/Git.pm')
-rw-r--r--perl/Git.pm82
1 files changed, 71 insertions, 11 deletions
diff --git a/perl/Git.pm b/perl/Git.pm
index 7d7f2b1d36..c279bfb244 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -7,6 +7,7 @@ Git - Perl interface to the Git version control system
package Git;
+use 5.008;
use strict;
@@ -56,7 +57,7 @@ require Exporter;
@EXPORT_OK = qw(command command_oneline command_noisy
command_output_pipe command_input_pipe command_close_pipe
command_bidi_pipe command_close_bidi_pipe
- version exec_path hash_object git_cmd_try
+ version exec_path html_path hash_object git_cmd_try
remote_refs
temp_acquire temp_release temp_reset temp_path);
@@ -98,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);
}
@@ -172,7 +173,7 @@ sub repository {
}
if (defined $opts{Directory}) {
- -d $opts{Directory} or throw Error::Simple("Directory not found: $!");
+ -d $opts{Directory} or throw Error::Simple("Directory not found: $opts{Directory} $!");
my $search = Git->repository(WorkingCopy => $opts{Directory});
my $dir;
@@ -185,7 +186,7 @@ sub repository {
if ($dir) {
$dir =~ m#^/# or $dir = $opts{Directory} . '/' . $dir;
- $opts{Repository} = $dir;
+ $opts{Repository} = abs_path($dir);
# If --git-dir went ok, this shouldn't die either.
my $prefix = $search->command_oneline('rev-parse', '--show-prefix');
@@ -204,14 +205,14 @@ sub repository {
$dir = $opts{Directory};
unless (-d "$dir/refs" and -d "$dir/objects" and -e "$dir/HEAD") {
- # Mimick git-rev-parse --git-dir error message:
+ # 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 {
- # Mimick git-rev-parse --git-dir error message:
+ # Mimic git-rev-parse --git-dir error message:
throw Error::Simple("fatal: Not a git repository: $dir");
}
@@ -395,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(' ', @_));
}
@@ -492,6 +502,16 @@ C<git --exec-path>). Useful mostly only internally.
sub exec_path { command_oneline('--exec-path') }
+=item html_path ()
+
+Return path to the Git html documentation (the same as
+C<git --html-path>). Useful mostly only internally.
+
+=cut
+
+sub html_path { command_oneline('--html-path') }
+
+
=item repo_path ()
Return path to the git repository. Must be called on a repository instance.
@@ -535,7 +555,7 @@ sub wc_chdir {
or throw Error::Simple("bare repository");
-d $self->wc_path().'/'.$subdir
- or throw Error::Simple("subdir not found: $!");
+ or throw Error::Simple("subdir not found: $subdir $!");
# Of course we will not "hold" the subdirectory so anyone
# can delete it now and we will never know. But at least we tried.
@@ -607,6 +627,38 @@ sub config_bool {
};
}
+
+=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.
+
+This currently wraps command('config') so it is not so fast.
+
+=cut
+
+sub config_path {
+ my ($self, $var) = _maybe_self(@_);
+
+ try {
+ my @cmd = ('config', '--path');
+ 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 undef;
+ } else {
+ throw $E;
+ }
+ };
+}
+
=item config_int ( VARIABLE )
Retrieve the integer configuration C<VARIABLE>. The return value
@@ -832,7 +884,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));
+ $self->command_bidi_pipe(qw(hash-object -w --stdin-paths --no-filters));
}
sub _close_hash_and_insert_object {
@@ -921,7 +973,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 {
@@ -1268,13 +1320,21 @@ 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()
+ and $ENV{'GIT_WORK_TREE'} = $self->wc_path();
$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..])