summaryrefslogtreecommitdiff
path: root/perl
diff options
context:
space:
mode:
Diffstat (limited to 'perl')
-rw-r--r--perl/Git.pm102
-rw-r--r--perl/Git/I18N.pm2
-rw-r--r--perl/Git/SVN.pm23
-rw-r--r--perl/Git/SVN/Editor.pm7
-rw-r--r--perl/Git/SVN/Log.pm8
-rw-r--r--perl/Git/SVN/Prompt.pm34
-rw-r--r--perl/Git/SVN/Utils.pm2
-rw-r--r--perl/private-Error.pm6
8 files changed, 119 insertions, 65 deletions
diff --git a/perl/Git.pm b/perl/Git.pm
index 497f420178..a69467feaa 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -58,7 +58,8 @@ require Exporter;
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);
@@ -102,6 +103,7 @@ use 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);
}
@@ -512,6 +514,79 @@ C<git --html-path>). Useful mostly only internally.
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.
@@ -890,20 +965,22 @@ sub cat_blob {
my $size = $1;
my $blob;
- my $bytesRead = 0;
+ my $bytesLeft = $size;
while (1) {
- my $bytesLeft = $size - $bytesRead;
last unless $bytesLeft;
my $bytesToRead = $bytesLeft < 1024 ? $bytesLeft : 1024;
- my $read = read($in, $blob, $bytesToRead, $bytesRead);
+ my $read = read($in, $blob, $bytesToRead);
unless (defined($read)) {
$self->_close_cat_blob();
throw Error::Simple("in pipe went bad");
}
-
- $bytesRead += $read;
+ unless (print $fh $blob) {
+ $self->_close_cat_blob();
+ throw Error::Simple("couldn't write to passed in filehandle");
+ }
+ $bytesLeft -= $read;
}
# Skip past the trailing newline.
@@ -918,11 +995,6 @@ sub cat_blob {
throw Error::Simple("didn't find newline after blob");
}
- unless (print $fh $blob) {
- $self->_close_cat_blob();
- throw Error::Simple("couldn't write to passed in filehandle");
- }
-
return $size;
}
@@ -954,7 +1026,7 @@ my (%TEMP_FILEMAP, %TEMP_FILES);
=item temp_acquire ( NAME )
-Attempts to retreive the temporary file mapped to the string C<NAME>. If an
+Attempts to retrieve the temporary file mapped to the string C<NAME>. If an
associated temp file has not been created this session or was closed, it is
created, cached, and set for autoflush and binmode.
@@ -1263,12 +1335,12 @@ sub _command_common_pipe {
if (not defined $pid) {
throw Error::Simple("open failed: $!");
} elsif ($pid == 0) {
- if (defined $opts{STDERR}) {
- close STDERR;
- }
if ($opts{STDERR}) {
open (STDERR, '>&', $opts{STDERR})
or die "dup failed: $!";
+ } elsif (defined $opts{STDERR}) {
+ open (STDERR, '>', '/dev/null')
+ or die "opening /dev/null failed: $!";
}
_cmd_exec($self, $cmd, @args);
}
diff --git a/perl/Git/I18N.pm b/perl/Git/I18N.pm
index 40dd897191..f889fd6da9 100644
--- a/perl/Git/I18N.pm
+++ b/perl/Git/I18N.pm
@@ -68,7 +68,7 @@ Git::I18N - Perl interface to Git's Gettext localizations
print __("Welcome to Git!\n");
- printf __("The following error occured: %s\n"), $error;
+ printf __("The following error occurred: %s\n"), $error;
=head1 DESCRIPTION
diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm
index 59215fa86e..5273ee8867 100644
--- a/perl/Git/SVN.pm
+++ b/perl/Git/SVN.pm
@@ -11,7 +11,6 @@ use Carp qw/croak/;
use File::Path qw/mkpath/;
use File::Copy qw/copy/;
use IPC::Open3;
-use Time::Local;
use Memoize; # core since 5.8.0, Jul 2002
use Memoize::Storable;
use POSIX qw(:signal_h);
@@ -22,6 +21,7 @@ use Git qw(
command_noisy
command_output_pipe
command_close_pipe
+ get_tz_offset
);
use Git::SVN::Utils qw(
fatal
@@ -490,7 +490,7 @@ sub refname {
#
# Additionally, % must be escaped because it is used for escaping
# and we want our escaped refname to be reversible
- $refname =~ s{([ \%~\^:\?\*\[\t])}{uc sprintf('%%%02x',ord($1))}eg;
+ $refname =~ s{([ \%~\^:\?\*\[\t])}{sprintf('%%%02X',ord($1))}eg;
# no slash-separated component can begin with a dot .
# /.* becomes /%2E*
@@ -1311,14 +1311,6 @@ sub get_untracked {
\@out;
}
-sub get_tz {
- # some systmes don't handle or mishandle %z, so be creative.
- my $t = shift || time;
- my $gm = timelocal(gmtime($t));
- my $sign = qw( + + - )[ $t <=> $gm ];
- return sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]);
-}
-
# parse_svn_date(DATE)
# --------------------
# Given a date (in UTC) from Subversion, return a string in the format
@@ -1351,7 +1343,7 @@ sub parse_svn_date {
delete $ENV{TZ};
}
- my $our_TZ = get_tz();
+ my $our_TZ = get_tz_offset();
# This converts $epoch_in_UTC into our local timezone.
my ($sec, $min, $hour, $mday, $mon, $year,
@@ -1501,13 +1493,18 @@ sub lookup_svn_merge {
my @merged_commit_ranges;
# find the tip
for my $range ( @ranges ) {
+ if ($range =~ /[*]$/) {
+ warn "W: Ignoring partial merge in svn:mergeinfo "
+ ."dirprop: $source:$range\n";
+ next;
+ }
my ($bottom, $top) = split "-", $range;
$top ||= $bottom;
my $bottom_commit = $gs->find_rev_after( $bottom, 1, $top );
my $top_commit = $gs->find_rev_before( $top, 1, $bottom );
unless ($top_commit and $bottom_commit) {
- warn "W:unknown path/rev in svn:mergeinfo "
+ warn "W: unknown path/rev in svn:mergeinfo "
."dirprop: $source:$range\n";
next;
}
@@ -2377,7 +2374,7 @@ sub map_path {
sub uri_encode {
my ($f) = @_;
- $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg;
+ $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#sprintf("%%%02X",ord($1))#eg;
$f
}
diff --git a/perl/Git/SVN/Editor.pm b/perl/Git/SVN/Editor.pm
index 3bbc20a054..fa0d3c6cdd 100644
--- a/perl/Git/SVN/Editor.pm
+++ b/perl/Git/SVN/Editor.pm
@@ -145,7 +145,8 @@ sub repo_path {
sub url_path {
my ($self, $path) = @_;
if ($self->{url} =~ m#^https?://#) {
- $path =~ s!([^~a-zA-Z0-9_./-])!uc sprintf("%%%02x",ord($1))!eg;
+ # characters are taken from subversion/libsvn_subr/path.c
+ $path =~ s#([^~a-zA-Z0-9_./!$&'()*+,-])#sprintf("%%%02X",ord($1))#eg;
}
$self->{url} . '/' . $self->repo_path($path);
}
@@ -358,12 +359,12 @@ sub T {
mode_a => $m->{mode_a}, mode_b => '000000',
sha1_a => $m->{sha1_a}, sha1_b => '0' x 40,
chg => 'D', file_b => $m->{file_b}
- });
+ }, $deletions);
$self->A({
mode_a => '000000', mode_b => $m->{mode_b},
sha1_a => '0' x 40, sha1_b => $m->{sha1_b},
chg => 'A', file_b => $m->{file_b}
- });
+ }, $deletions);
return;
}
diff --git a/perl/Git/SVN/Log.pm b/perl/Git/SVN/Log.pm
index 3cc1c6f081..3f8350a57d 100644
--- a/perl/Git/SVN/Log.pm
+++ b/perl/Git/SVN/Log.pm
@@ -2,7 +2,11 @@ package Git::SVN::Log;
use strict;
use warnings;
use Git::SVN::Utils qw(fatal);
-use Git qw(command command_oneline command_output_pipe command_close_pipe);
+use Git qw(command
+ command_oneline
+ command_output_pipe
+ command_close_pipe
+ get_tz_offset);
use POSIX qw/strftime/;
use constant commit_log_separator => ('-' x 72) . "\n";
use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline
@@ -119,7 +123,7 @@ sub run_pager {
sub format_svn_date {
my $t = shift || time;
require Git::SVN;
- my $gmoff = Git::SVN::get_tz($t);
+ my $gmoff = get_tz_offset($t);
return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t));
}
diff --git a/perl/Git/SVN/Prompt.pm b/perl/Git/SVN/Prompt.pm
index 3a6f8af0d9..74daa7a597 100644
--- a/perl/Git/SVN/Prompt.pm
+++ b/perl/Git/SVN/Prompt.pm
@@ -62,16 +62,16 @@ sub ssl_server_trust {
issuer_dname fingerprint);
my $choice;
prompt:
- print STDERR $may_save ?
+ my $options = $may_save ?
"(R)eject, accept (t)emporarily or accept (p)ermanently? " :
"(R)eject or accept (t)emporarily? ";
STDERR->flush;
- $choice = lc(substr(<STDIN> || 'R', 0, 1));
- if ($choice =~ /^t$/i) {
+ $choice = lc(substr(Git::prompt("Certificate problem.\n" . $options) || 'R', 0, 1));
+ if ($choice eq 't') {
$cred->may_save(undef);
- } elsif ($choice =~ /^r$/i) {
+ } elsif ($choice eq 'r') {
return -1;
- } elsif ($may_save && $choice =~ /^p$/i) {
+ } elsif ($may_save && $choice eq 'p') {
$cred->may_save($may_save);
} else {
goto prompt;
@@ -109,9 +109,7 @@ sub username {
if (defined $_username) {
$username = $_username;
} else {
- print STDERR "Username: ";
- STDERR->flush;
- chomp($username = <STDIN>);
+ $username = Git::prompt("Username: ");
}
$cred->username($username);
$cred->may_save($may_save);
@@ -120,25 +118,7 @@ sub username {
sub _read_password {
my ($prompt, $realm) = @_;
- my $password = '';
- if (exists $ENV{GIT_ASKPASS}) {
- open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt);
- $password = <PH>;
- $password =~ s/[\012\015]//; # \n\r
- close(PH);
- } else {
- print STDERR $prompt;
- STDERR->flush;
- require Term::ReadKey;
- Term::ReadKey::ReadMode('noecho');
- while (defined(my $key = Term::ReadKey::ReadKey(0))) {
- last if $key =~ /[\012\015]/; # \n\r
- $password .= $key;
- }
- Term::ReadKey::ReadMode('restore');
- print STDERR "\n";
- STDERR->flush;
- }
+ my $password = Git::prompt($prompt, 1);
$password;
}
diff --git a/perl/Git/SVN/Utils.pm b/perl/Git/SVN/Utils.pm
index 8b8cf3755c..3d1a0933a2 100644
--- a/perl/Git/SVN/Utils.pm
+++ b/perl/Git/SVN/Utils.pm
@@ -155,7 +155,7 @@ sub _canonicalize_url_path {
my @parts;
foreach my $part (split m{/+}, $uri_path) {
- $part =~ s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
+ $part =~ s/([^!\$%&'()*+,.\/\w:=\@_`~-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
push @parts, $part;
}
diff --git a/perl/private-Error.pm b/perl/private-Error.pm
index 11e9cd9a02..6098135ae2 100644
--- a/perl/private-Error.pm
+++ b/perl/private-Error.pm
@@ -630,7 +630,7 @@ Only one finally block may be specified per try block
=head2 CONSTRUCTORS
The C<Error> object is implemented as a HASH. This HASH is initialized
-with the arguments that are passed to it's constructor. The elements
+with the arguments that are passed to its constructor. The elements
that are used by, or are retrievable by the C<Error> class are listed
below, other classes may add to these.
@@ -763,13 +763,13 @@ to the constructor.
=item Error::Simple
-This class can be used to hold simple error strings and values. It's
+This class can be used to hold simple error strings and values. Its
constructor takes two arguments. The first is a text value, the second
is a numeric value. These values are what will be returned by the
overload methods.
If the text value ends with C<at file line 1> as $@ strings do, then
-this infomation will be used to set the C<-file> and C<-line> arguments
+this information will be used to set the C<-file> and C<-line> arguments
of the error object.
This class is used internally if an eval'd block die's with an error
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-17 23:50:22 +0000