diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Git.pm | 5 | ||||
| -rw-r--r-- | perl/Git/SVN/Editor.pm | 4 | ||||
| -rw-r--r-- | perl/Git/SVN/GlobSpec.pm | 18 |
3 files changed, 17 insertions, 10 deletions
diff --git a/perl/Git.pm b/perl/Git.pm index 19ef081103..ce7e4e8da3 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -188,7 +188,8 @@ sub repository { }; if ($dir) { - $dir =~ m#^/# or $dir = $opts{Directory} . '/' . $dir; + _verify_require(); + File::Spec->file_name_is_absolute($dir) or $dir = $opts{Directory} . '/' . $dir; $opts{Repository} = abs_path($dir); # If --git-dir went ok, this shouldn't die either. @@ -392,7 +393,7 @@ sub command_close_pipe { Execute the given C<COMMAND> in the same way as command_output_pipe() does but return both an input pipe filehandle and an output pipe filehandle. -The function will return return C<($pid, $pipe_in, $pipe_out, $ctx)>. +The function will return C<($pid, $pipe_in, $pipe_out, $ctx)>. See C<command_close_bidi_pipe()> for details. =cut diff --git a/perl/Git/SVN/Editor.pm b/perl/Git/SVN/Editor.pm index c50176eec9..4c4199afec 100644 --- a/perl/Git/SVN/Editor.pm +++ b/perl/Git/SVN/Editor.pm @@ -41,6 +41,7 @@ sub new { "$self->{svn_path}/" : ''; $self->{config} = $opts->{config}; $self->{mergeinfo} = $opts->{mergeinfo}; + $self->{pathnameencoding} = Git::config('svn.pathnameencoding'); return $self; } @@ -143,11 +144,12 @@ sub repo_path { sub url_path { my ($self, $path) = @_; + $path = $self->repo_path($path); if ($self->{url} =~ m#^https?://#) { # 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); + $self->{url} . '/' . $path; } sub rmdirs { diff --git a/perl/Git/SVN/GlobSpec.pm b/perl/Git/SVN/GlobSpec.pm index c95f5d76ca..a0a8d17621 100644 --- a/perl/Git/SVN/GlobSpec.pm +++ b/perl/Git/SVN/GlobSpec.pm @@ -8,19 +8,23 @@ sub new { $re =~ s!/+$!!g; # no need for trailing slashes my (@left, @right, @patterns); my $state = "left"; - my $die_msg = "Only one set of wildcard directories " . - "(e.g. '*' or '*/*/*') is supported: '$glob'\n"; + my $die_msg = "Only one set of wildcards " . + "(e.g. '*' or '*/*/*') is supported: $glob\n"; for my $part (split(m|/|, $glob)) { - if ($part =~ /\*/ && $part ne "*") { - die "Invalid pattern in '$glob': $part\n"; - } elsif ($pattern_ok && $part =~ /[{}]/ && + if ($pattern_ok && $part =~ /[{}]/ && $part !~ /^\{[^{}]+\}/) { die "Invalid pattern in '$glob': $part\n"; } - if ($part eq "*") { + my $nstars = $part =~ tr/*//; + if ($nstars > 1) { + die "Only one '*' is allowed in a pattern: '$part'\n"; + } + if ($part =~ /(.*)\*(.*)/) { die $die_msg if $state eq "right"; + my ($l, $r) = ($1, $2); $state = "pattern"; - push(@patterns, "[^/]*"); + my $pat = quotemeta($l) . '[^/]*' . quotemeta($r); + push(@patterns, $pat); } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) { die $die_msg if $state eq "right"; $state = "pattern"; |