Merge branch 'maint'
[git/mingw.git] / perl / Git / SVN / GlobSpec.pm
blobc95f5d76cae9fc40a1c1d2e6cff899e81186b6ca
1 package Git::SVN::GlobSpec;
2 use strict;
3 use warnings;
5 sub new {
6 my ($class, $glob, $pattern_ok) = @_;
7 my $re = $glob;
8 $re =~ s!/+$!!g; # no need for trailing slashes
9 my (@left, @right, @patterns);
10 my $state = "left";
11 my $die_msg = "Only one set of wildcard directories " .
12 "(e.g. '*' or '*/*/*') is supported: '$glob'\n";
13 for my $part (split(m|/|, $glob)) {
14 if ($part =~ /\*/ && $part ne "*") {
15 die "Invalid pattern in '$glob': $part\n";
16 } elsif ($pattern_ok && $part =~ /[{}]/ &&
17 $part !~ /^\{[^{}]+\}/) {
18 die "Invalid pattern in '$glob': $part\n";
20 if ($part eq "*") {
21 die $die_msg if $state eq "right";
22 $state = "pattern";
23 push(@patterns, "[^/]*");
24 } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) {
25 die $die_msg if $state eq "right";
26 $state = "pattern";
27 my $p = quotemeta($1);
28 $p =~ s/\\,/|/g;
29 push(@patterns, "(?:$p)");
30 } else {
31 if ($state eq "left") {
32 push(@left, $part);
33 } else {
34 push(@right, $part);
35 $state = "right";
39 my $depth = @patterns;
40 if ($depth == 0) {
41 die "One '*' is needed in glob: '$glob'\n";
43 my $left = join('/', @left);
44 my $right = join('/', @right);
45 $re = join('/', @patterns);
46 $re = join('\/',
47 grep(length, quotemeta($left),
48 "($re)(?=/|\$)",
49 quotemeta($right)));
50 my $left_re = qr/^\/\Q$left\E(\/|$)/;
51 bless { left => $left, right => $right, left_regex => $left_re,
52 regex => qr/$re/, glob => $glob, depth => $depth }, $class;
55 sub full_path {
56 my ($self, $path) = @_;
57 return (length $self->{left} ? "$self->{left}/" : '') .
58 $path . (length $self->{right} ? "/$self->{right}" : '');