![[tokkee]](http://tokkee.org/images/avatar.png){kind=avatar}
diff --git a/git-svn.perl b/git-svn.perl
index f7226714fadc59a501a536451ea66334f7baa404..473a0b9d556fc7ead7088c4cb6c6f14c4a70995b 100755 (executable)
--- a/git-svn.perl
+++ b/git-svn.perl
$ENV{SVN_SSH} = $ENV{GIT_SSH};
if ($^O eq 'msys') {
$ENV{SVN_SSH} =~ s/\\/\\\\/g;
+ $ENV{SVN_SSH} =~ s/(.*)/"$1"/;
}
}
}
use File::Copy qw/copy/;
use IPC::Open3;
use Memoize; # core since 5.8.0, Jul 2002
+use Memoize::Storable;
my ($_gc_nr, $_gc_period);
my $rs = {
t => $t,
remote => $remote,
- path => Git::SVN::GlobSpec->new($local_ref),
- ref => Git::SVN::GlobSpec->new($remote_ref) };
+ path => Git::SVN::GlobSpec->new($local_ref, 1),
+ ref => Git::SVN::GlobSpec->new($remote_ref, 0) };
if (length($rs->{ref}->{right}) != 0) {
die "The '*' glob character must be the last ",
"character of '$remote_ref'\n";
command_oneline("rev-parse", "$commit~1^{tree}"));
}
-BEGIN {
- memoize 'lookup_svn_merge';
- memoize 'check_cherry_pick';
- memoize 'has_no_changes';
+# The GIT_DIR environment variable is not always set until after the command
+# line arguments are processed, so we can't memoize in a BEGIN block.
+{
+ my $memoized = 0;
+
+ sub memoize_svn_mergeinfo_functions {
+ return if $memoized;
+ $memoized = 1;
+
+ my $cache_path = "$ENV{GIT_DIR}/svn/.caches/";
+ mkpath([$cache_path]) unless -d $cache_path;
+
+ tie my %lookup_svn_merge_cache => 'Memoize::Storable',
+ "$cache_path/lookup_svn_merge.db", 'nstore';
+ memoize 'lookup_svn_merge',
+ SCALAR_CACHE => 'FAULT',
+ LIST_CACHE => ['HASH' => \%lookup_svn_merge_cache],
+ ;
+
+ tie my %check_cherry_pick_cache => 'Memoize::Storable',
+ "$cache_path/check_cherry_pick.db", 'nstore';
+ memoize 'check_cherry_pick',
+ SCALAR_CACHE => 'FAULT',
+ LIST_CACHE => ['HASH' => \%check_cherry_pick_cache],
+ ;
+
+ tie my %has_no_changes_cache => 'Memoize::Storable',
+ "$cache_path/has_no_changes.db", 'nstore';
+ memoize 'has_no_changes',
+ SCALAR_CACHE => ['HASH' => \%has_no_changes_cache],
+ LIST_CACHE => 'FAULT',
+ ;
+ }
}
sub parents_exclude {
my ($self, $ed, $mergeinfo, $parents) = @_;
# aha! svk:merge property changed...
+ memoize_svn_mergeinfo_functions();
+
# We first search for merged tips which are not in our
# history. Then, we figure out which git revisions are in
# that tip, but not this revision. If all of those revisions
next if (length $g->{path}->{right} &&
($self->check_path($p, $r) !=
$SVN::Node::dir));
+ next unless $p =~ /$g->{path}->{regex}/;
$exists->{$p} = Git::SVN->init($self->{url}, $p, undef,
$g->{ref}->full_path($de), 1);
}
# adapted from pager.c
sub config_pager {
- chomp(my $pager = command_oneline(qw(var GIT_PAGER)));
+ if (! -t *STDOUT) {
+ $ENV{GIT_PAGER_IN_USE} = 'false';
+ $pager = undef;
+ return;
+ }
+ chomp($pager = command_oneline(qw(var GIT_PAGER)));
if ($pager eq 'cat') {
$pager = undef;
}
}
sub run_pager {
- return unless -t *STDOUT && defined $pager;
+ return unless defined $pager;
pipe my ($rfd, $wfd) or return;
defined(my $pid = fork) or ::fatal "Can't fork: $!";
if (!$pid) {
use warnings;
sub new {
- my ($class, $glob) = @_;
+ my ($class, $glob, $pattern_ok) = @_;
my $re = $glob;
$re =~ s!/+$!!g; # no need for trailing slashes
- $re =~ m!^([^*]*)(\*(?:/\*)*)(.*)$!;
- my $temp = $re;
- my ($left, $right) = ($1, $3);
- $re = $2;
- my $depth = $re =~ tr/*/*/;
- if ($depth != $temp =~ tr/*/*/) {
- die "Only one set of wildcard directories " .
- "(e.g. '*' or '*/*/*') is supported: '$glob'\n";
+ 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 for glob: '$glob'\n";
- }
- $re =~ s!\*!\[^/\]*!g;
- $re = quotemeta($left) . "($re)" . quotemeta($right);
- if (length $left && !($left =~ s!/+$!!g)) {
- die "Missing trailing '/' on left side of: '$glob' ($left)\n";
- }
- if (length $right && !($right =~ s!^/+!!g)) {
- die "Missing leading '/' on right side of: '$glob' ($right)\n";
+ 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;