Extract Git::SVN::GlobSpec from git-svn.
Straight cut & paste. That's the last class. * Make Git::SVN load it on its own, its the only thing that needs it. Signed-off-by: Eric Wong <normalperson@yhbt.net>
Michael G. Schwern committed
Jul 26, 2012 at 17:26 UTC
3d9be15fc2b8c8198253ae1c4dcaa343b74c3b8d
5 files changed
+64
-60
git-svn.perl
-59
@@ -2039,65 +2039,6 @@ sub gc_directory {
2039
}
2040
}
2041
2042
-
2043
-package Git::SVN::GlobSpec;
2044
-use strict;
2045
-use warnings;
2046
-
2047
-sub new {
2048
- my ($class, $glob, $pattern_ok) = @_;
2049
- my $re = $glob;
2050
- $re =~ s!/+$!!g; # no need for trailing slashes
2051
- my (@left, @right, @patterns);
2052
- my $state = "left";
2053
- my $die_msg = "Only one set of wildcard directories " .
2054
- "(e.g. '*' or '*/*/*') is supported: '$glob'\n";
2055
- for my $part (split(m|/|, $glob)) {
2056
- if ($part =~ /\*/ && $part ne "*") {
2057
- die "Invalid pattern in '$glob': $part\n";
2058
- } elsif ($pattern_ok && $part =~ /[{}]/ &&
2059
- $part !~ /^\{[^{}]+\}/) {
2060
- die "Invalid pattern in '$glob': $part\n";
2061
- }
2062
- if ($part eq "*") {
2063
- die $die_msg if $state eq "right";
2064
- $state = "pattern";
2065
- push(@patterns, "[^/]*");
2066
- } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) {
2067
- die $die_msg if $state eq "right";
2068
- $state = "pattern";
2069
- my $p = quotemeta($1);
2070
- $p =~ s/\\,/|/g;
2071
- push(@patterns, "(?:$p)");
2072
- } else {
2073
- if ($state eq "left") {
2074
- push(@left, $part);
2075
- } else {
2076
- push(@right, $part);
2077
- $state = "right";
2078
- }
2079
- }
2080
- }
2081
- my $depth = @patterns;
2082
- if ($depth == 0) {
2083
- die "One '*' is needed in glob: '$glob'\n";
2084
- }
2085
- my $left = join('/', @left);
2086
- my $right = join('/', @right);
2087
- $re = join('/', @patterns);
2088
- $re = join('\/',
2089
- grep(length, quotemeta($left), "($re)", quotemeta($right)));
2090
- my $left_re = qr/^\/\Q$left\E(\/|$)/;
2091
- bless { left => $left, right => $right, left_regex => $left_re,
2092
- regex => qr/$re/, glob => $glob, depth => $depth }, $class;
2093
-}
2094
-
2095
-sub full_path {
2096
- my ($self, $path) = @_;
2097
- return (length $self->{left} ? "$self->{left}/" : '') .
2098
- $path . (length $self->{right} ? "/$self->{right}" : '');
2099
-}
2100
-
2042
__END__
2043
2044
Data structures:
perl/Git/SVN.pm
+2
@@ -207,6 +207,8 @@ sub read_all_remotes {
207
. "must start with 'refs/'\n")
208
unless $remote_ref =~ m{^refs/};
209
$local_ref = uri_decode($local_ref);
210
+
211
+ require Git::SVN::GlobSpec;
212
my $rs = {
213
t => $t,
214
remote => $remote,
perl/Git/SVN/GlobSpec.pm
new
+59
@@ -0,0 +1,59 @@
1
+package Git::SVN::GlobSpec;
2
+use strict;
3
+use warnings;
4
+
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";
19
+ }
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";
36
+ }
37
+ }
38
+ }
39
+ my $depth = @patterns;
40
+ if ($depth == 0) {
41
+ die "One '*' is needed in glob: '$glob'\n";
42
+ }
43
+ my $left = join('/', @left);
44
+ my $right = join('/', @right);
45
+ $re = join('/', @patterns);
46
+ $re = join('\/',
47
+ grep(length, quotemeta($left), "($re)", quotemeta($right)));
48
+ my $left_re = qr/^\/\Q$left\E(\/|$)/;
49
+ bless { left => $left, right => $right, left_regex => $left_re,
50
+ regex => qr/$re/, glob => $glob, depth => $depth }, $class;
51
+}
52
+
53
+sub full_path {
54
+ my ($self, $path) = @_;
55
+ return (length $self->{left} ? "$self->{left}/" : '') .
56
+ $path . (length $self->{right} ? "/$self->{right}" : '');
57
+}
58
+
59
+1;
perl/Makefile
+1
@@ -34,6 +34,7 @@ modules += Git/SVN
34
modules += Git/SVN/Memoize/YAML
35
modules += Git/SVN/Fetcher
36
modules += Git/SVN/Editor
37
+modules += Git/SVN/GlobSpec
38
modules += Git/SVN/Log
39
modules += Git/SVN/Migration
40
modules += Git/SVN/Prompt
t/Git-SVN/00compile.t
+2
-1
@@ -3,7 +3,7 @@
3
use strict;
4
use warnings;
5
6
-use Test::More tests => 6;
6
+use Test::More tests => 7;
7
8
require_ok 'Git::SVN';
9
require_ok 'Git::SVN::Utils';
@@ -11,3 +11,4 @@ require_ok 'Git::SVN::Ra';
11
require_ok 'Git::SVN::Log';
12
require_ok 'Git::SVN::Migration';
13
require_ok 'Git::IndexInfo';
14
+require_ok 'Git::SVN::GlobSpec';