diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Git/SVN.pm | 2 | ||||
| -rw-r--r-- | perl/Git/SVN/GlobSpec.pm | 59 | ||||
| -rw-r--r-- | perl/Makefile | 1 |
3 files changed, 62 insertions, 0 deletions
diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm index 2e0d7f0373..b8b34744ea 100644 --- a/perl/Git/SVN.pm +++ b/perl/Git/SVN.pm @@ -207,6 +207,8 @@ sub read_all_remotes { . "must start with 'refs/'\n") unless $remote_ref =~ m{^refs/}; $local_ref = uri_decode($local_ref); + + require Git::SVN::GlobSpec; my $rs = { t => $t, remote => $remote, diff --git a/perl/Git/SVN/GlobSpec.pm b/perl/Git/SVN/GlobSpec.pm new file mode 100644 index 0000000000..96cfd9896e --- /dev/null +++ b/perl/Git/SVN/GlobSpec.pm @@ -0,0 +1,59 @@ +package Git::SVN::GlobSpec; +use strict; +use warnings; + +sub new { + my ($class, $glob, $pattern_ok) = @_; + my $re = $glob; + $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"; + for my $part (split(m|/|, $glob)) { + if ($part =~ /\*/ && $part ne "*") { + die "Invalid pattern in '$glob': $part\n"; + } elsif ($pattern_ok && $part =~ /[{}]/ && + $part !~ /^\{[^{}]+\}/) { + die "Invalid pattern in '$glob': $part\n"; + } + if ($part eq "*") { + die $die_msg if $state eq "right"; + $state = "pattern"; + push(@patterns, "[^/]*"); + } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) { + die $die_msg if $state eq "right"; + $state = "pattern"; + my $p = quotemeta($1); + $p =~ s/\\,/|/g; + push(@patterns, "(?:$p)"); + } else { + if ($state eq "left") { + push(@left, $part); + } else { + push(@right, $part); + $state = "right"; + } + } + } + my $depth = @patterns; + if ($depth == 0) { + die "One '*' is needed in glob: '$glob'\n"; + } + my $left = join('/', @left); + my $right = join('/', @right); + $re = join('/', @patterns); + $re = join('\/', + grep(length, quotemeta($left), "($re)", quotemeta($right))); + my $left_re = qr/^\/\Q$left\E(\/|$)/; + bless { left => $left, right => $right, left_regex => $left_re, + regex => qr/$re/, glob => $glob, depth => $depth }, $class; +} + +sub full_path { + my ($self, $path) = @_; + return (length $self->{left} ? "$self->{left}/" : '') . + $path . (length $self->{right} ? "/$self->{right}" : ''); +} + +1; diff --git a/perl/Makefile b/perl/Makefile index 0b0e345cc0..15d96fcc7a 100644 --- a/perl/Makefile +++ b/perl/Makefile @@ -34,6 +34,7 @@ modules += Git/SVN modules += Git/SVN/Memoize/YAML modules += Git/SVN/Fetcher modules += Git/SVN/Editor +modules += Git/SVN/GlobSpec modules += Git/SVN/Log modules += Git/SVN/Migration modules += Git/SVN/Prompt |