diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Git.pm | 2 | ||||
| -rw-r--r-- | perl/Git/SVN.pm | 3 | ||||
| -rw-r--r-- | perl/Git/SVN/GlobSpec.pm | 18 |
3 files changed, 14 insertions, 9 deletions
diff --git a/perl/Git.pm b/perl/Git.pm index 49eb88af8..ce7e4e8da 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -393,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.pm b/perl/Git/SVN.pm index b2c14e2ff..d94d01cfd 100644 --- a/perl/Git/SVN.pm +++ b/perl/Git/SVN.pm @@ -97,7 +97,8 @@ sub resolve_local_globs { "existing: $existing\n", " globbed: $refname\n"; } - my $u = (::cmt_metadata("$refname"))[0]; + my $u = (::cmt_metadata("$refname"))[0] or die + "$refname: no associated commit metadata\n"; $u =~ s!^\Q$url\E(/|$)!! or die "$refname: '$url' not found in '$u'\n"; if ($pathname ne $u) { diff --git a/perl/Git/SVN/GlobSpec.pm b/perl/Git/SVN/GlobSpec.pm index c95f5d76c..a0a8d1762 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"; |