command_output_pipe command_input_pipe command_close_pipe
command_bidi_pipe command_close_bidi_pipe
version exec_path html_path hash_object git_cmd_try
- remote_refs
+ remote_refs prompt
+ get_tz_offset
temp_acquire temp_release temp_reset temp_path);
use Cwd qw(abs_path cwd);
use IPC::Open2 qw(open2);
use Fcntl qw(SEEK_SET SEEK_CUR);
+use Time::Local qw(timegm);
}
sub html_path { command_oneline('--html-path') }
+=item get_tz_offset ( TIME )
+
+Return the time zone offset from GMT in the form +/-HHMM where HH is
+the number of hours from GMT and MM is the number of minutes. This is
+the equivalent of what strftime("%z", ...) would provide on a GNU
+platform.
+
+If TIME is not supplied, the current local time is used.
+
+=cut
+
+sub get_tz_offset {
+ # some systmes don't handle or mishandle %z, so be creative.
+ my $t = shift || time;
+ my $gm = timegm(localtime($t));
+ my $sign = qw( + + - )[ $gm <=> $t ];
+ return sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]);
+}
+
+
+=item prompt ( PROMPT , ISPASSWORD )
+
+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 terminal is tried as a fallback.
+If C<ISPASSWORD> is set and true, the terminal disables echo.
+
+=cut
+
+sub prompt {
+ my ($prompt, $isPassword) = @_;
+ my $ret;
+ if (exists $ENV{'GIT_ASKPASS'}) {
+ $ret = _prompt($ENV{'GIT_ASKPASS'}, $prompt);
+ }
+ if (!defined $ret && exists $ENV{'SSH_ASKPASS'}) {
+ $ret = _prompt($ENV{'SSH_ASKPASS'}, $prompt);
+ }
+ if (!defined $ret) {
+ print STDERR $prompt;
+ STDERR->flush;
+ if (defined $isPassword && $isPassword) {
+ require Term::ReadKey;
+ Term::ReadKey::ReadMode('noecho');
+ $ret = '';
+ while (defined(my $key = Term::ReadKey::ReadKey(0))) {
+ last if $key =~ /[\012\015]/; # \n\r
+ $ret .= $key;
+ }
+ Term::ReadKey::ReadMode('restore');
+ print STDERR "\n";
+ STDERR->flush;
+ } else {
+ chomp($ret = <STDIN>);
+ }
+ }
+ return $ret;
+}
+
+sub _prompt {
+ my ($askpass, $prompt) = @_;
+ return unless length $askpass;
+ $prompt =~ s/\n/ /g;
+ my $ret;
+ open my $fh, "-|", $askpass, $prompt or return;
+ $ret = <$fh>;
+ $ret =~ s/[\015\012]//g; # strip \r\n, chomp does not work on all systems (i.e. windows) as expected
+ close ($fh);
+ return $ret;
+}
+
=item repo_path ()
Return path to the git repository. Must be called on a repository instance.
(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({}, @_);
}
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
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;
}
contains the tag object while a C<refname^{}> entry gives the tagged objects.
C<REPOSITORY> has the same meaning as the appropriate C<git-ls-remote>
-argument; either an URL or a remote name (if called on a repository instance).
+argument; either a URL or a remote name (if called on a repository instance).
C<GROUPS> is an optional arrayref that can contain 'tags' to return all the
tags and/or 'heads' to return all the heads. C<REFGLOB> is an optional array
of strings containing a shell-like glob to further limit the refs returned in