summaryrefslogtreecommitdiff
path: root/perl
diff options
context:
space:
mode:
Diffstat (limited to 'perl')
-rw-r--r--perl/Git.pm5
-rw-r--r--perl/Git/SVN.pm154
-rw-r--r--perl/Git/SVN/Editor.pm10
-rw-r--r--perl/Git/SVN/Log.pm3
-rw-r--r--perl/Git/SVN/Migration.pm2
-rw-r--r--perl/Git/SVN/Ra.pm110
6 files changed, 192 insertions, 92 deletions
diff --git a/perl/Git.pm b/perl/Git.pm
index 204fdc6737..b5905ee1ad 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -1294,8 +1294,11 @@ sub _temp_cache {
$tmpdir = $self->repo_path();
}
+ my $n = $name;
+ $n =~ s/\W/_/g; # no strange chars
+
($$temp_fd, $fname) = File::Temp::tempfile(
- 'Git_XXXXXX', UNLINK => 1, DIR => $tmpdir,
+ "Git_${n}_XXXXXX", UNLINK => 1, DIR => $tmpdir,
) or throw Error::Simple("couldn't open new temp file");
$$temp_fd->autoflush;
diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm
index 5273ee8867..d9a52a52df 100644
--- a/perl/Git/SVN.pm
+++ b/perl/Git/SVN.pm
@@ -480,8 +480,8 @@ sub refname {
# It cannot end with a slash /, we'll throw up on this because
# SVN can't have directories with a slash in their name, either:
if ($refname =~ m{/$}) {
- die "ref: '$refname' ends with a trailing slash, this is ",
- "not permitted by git nor Subversion\n";
+ die "ref: '$refname' ends with a trailing slash; this is ",
+ "not permitted by git or Subversion\n";
}
# It cannot have ASCII control character space, tilde ~, caret ^,
@@ -1178,7 +1178,7 @@ sub find_parent_branch {
or die "SVN connection failed somewhere...\n";
}
print STDERR "Successfully followed parent\n" unless $::_q > 1;
- return $self->make_log_entry($rev, [$parent], $ed);
+ return $self->make_log_entry($rev, [$parent], $ed, $r0, $branch_from);
}
return undef;
}
@@ -1191,7 +1191,7 @@ sub do_fetch {
# we can have a branch that was deleted, then re-added
# under the same name but copied from another path, in
# which case we'll have multiple parents (we don't
- # want to break the original ref, nor lose copypath info):
+ # want to break the original ref or lose copypath info):
if (my $log_entry = $self->find_parent_branch($paths, $rev)) {
push @{$log_entry->{parents}}, $lc;
return $log_entry;
@@ -1210,7 +1210,7 @@ sub do_fetch {
unless ($self->ra->gs_do_update($last_rev, $rev, $self, $ed)) {
die "SVN connection failed somewhere...\n";
}
- $self->make_log_entry($rev, \@parents, $ed);
+ $self->make_log_entry($rev, \@parents, $ed, $last_rev, $self->path);
}
sub mkemptydirs {
@@ -1321,7 +1321,7 @@ sub get_untracked {
sub parse_svn_date {
my $date = shift || return '+0000 1970-01-01 00:00:00';
my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T
- (\d\d)\:(\d\d)\:(\d\d)\.\d*Z$/x) or
+ (\d\d?)\:(\d\d)\:(\d\d)\.\d*Z$/x) or
croak "Unable to parse date: $date\n";
my $parsed_date; # Set next.
@@ -1433,7 +1433,7 @@ sub check_author {
}
sub find_extra_svk_parents {
- my ($self, $ed, $tickets, $parents) = @_;
+ my ($self, $tickets, $parents) = @_;
# aha! svk:merge property changed...
my @tickets = split "\n", $tickets;
my @known_parents;
@@ -1478,9 +1478,9 @@ sub find_extra_svk_parents {
sub lookup_svn_merge {
my $uuid = shift;
my $url = shift;
- my $merge = shift;
+ my $source = shift;
+ my $revs = shift;
- my ($source, $revs) = split ":", $merge;
my $path = $source;
$path =~ s{^/}{};
my $gs = Git::SVN->find_by_url($url.$source, $url, $path);
@@ -1537,7 +1537,7 @@ sub _rev_list {
@rv;
}
-sub check_cherry_pick {
+sub check_cherry_pick2 {
my $base = shift;
my $tip = shift;
my $parents = shift;
@@ -1552,7 +1552,8 @@ sub check_cherry_pick {
delete $commits{$commit};
}
}
- return (keys %commits);
+ my @k = (keys %commits);
+ return (scalar @k, $k[0]);
}
sub has_no_changes {
@@ -1597,7 +1598,7 @@ sub tie_for_persistent_memoization {
mkpath([$cache_path]) unless -d $cache_path;
my %lookup_svn_merge_cache;
- my %check_cherry_pick_cache;
+ my %check_cherry_pick2_cache;
my %has_no_changes_cache;
tie_for_persistent_memoization(\%lookup_svn_merge_cache,
@@ -1607,11 +1608,11 @@ sub tie_for_persistent_memoization {
LIST_CACHE => ['HASH' => \%lookup_svn_merge_cache],
;
- tie_for_persistent_memoization(\%check_cherry_pick_cache,
- "$cache_path/check_cherry_pick");
- memoize 'check_cherry_pick',
+ tie_for_persistent_memoization(\%check_cherry_pick2_cache,
+ "$cache_path/check_cherry_pick2");
+ memoize 'check_cherry_pick2',
SCALAR_CACHE => 'FAULT',
- LIST_CACHE => ['HASH' => \%check_cherry_pick_cache],
+ LIST_CACHE => ['HASH' => \%check_cherry_pick2_cache],
;
tie_for_persistent_memoization(\%has_no_changes_cache,
@@ -1627,7 +1628,7 @@ sub tie_for_persistent_memoization {
$memoized = 0;
Memoize::unmemoize 'lookup_svn_merge';
- Memoize::unmemoize 'check_cherry_pick';
+ Memoize::unmemoize 'check_cherry_pick2';
Memoize::unmemoize 'has_no_changes';
}
@@ -1638,7 +1639,8 @@ sub tie_for_persistent_memoization {
return unless -d $cache_path;
for my $cache_file (("$cache_path/lookup_svn_merge",
- "$cache_path/check_cherry_pick",
+ "$cache_path/check_cherry_pick", # old
+ "$cache_path/check_cherry_pick2",
"$cache_path/has_no_changes")) {
for my $suffix (qw(yaml db)) {
my $file = "$cache_file.$suffix";
@@ -1692,11 +1694,49 @@ sub parents_exclude {
return @excluded;
}
+# Compute what's new in svn:mergeinfo.
+sub mergeinfo_changes {
+ my ($self, $old_path, $old_rev, $path, $rev, $mergeinfo_prop) = @_;
+ my %minfo = map {split ":", $_ } split "\n", $mergeinfo_prop;
+ my $old_minfo = {};
+
+ my $ra = $self->ra;
+ # Give up if $old_path isn't in the repo.
+ # This is probably a merge on a subtree.
+ if ($ra->check_path($old_path, $old_rev) != $SVN::Node::dir) {
+ warn "W: ignoring svn:mergeinfo on $old_path, ",
+ "directory didn't exist in r$old_rev\n";
+ return {};
+ }
+ my (undef, undef, $props) = $ra->get_dir($old_path, $old_rev);
+ if (defined $props->{"svn:mergeinfo"}) {
+ my %omi = map {split ":", $_ } split "\n",
+ $props->{"svn:mergeinfo"};
+ $old_minfo = \%omi;
+ }
+
+ my %changes = ();
+ foreach my $p (keys %minfo) {
+ my $a = $old_minfo->{$p} || "";
+ my $b = $minfo{$p};
+ # Omit merged branches whose ranges lists are unchanged.
+ next if $a eq $b;
+ # Remove any common range list prefix.
+ ($a ^ $b) =~ /^[\0]*/;
+ my $common_prefix = rindex $b, ",", $+[0] - 1;
+ $changes{$p} = substr $b, $common_prefix + 1;
+ }
+ print STDERR "Checking svn:mergeinfo changes since r$old_rev: ",
+ scalar(keys %minfo), " sources, ",
+ scalar(keys %changes), " changed\n";
+
+ return \%changes;
+}
# note: this function should only be called if the various dirprops
# have actually changed
sub find_extra_svn_parents {
- my ($self, $ed, $mergeinfo, $parents) = @_;
+ my ($self, $mergeinfo, $parents) = @_;
# aha! svk:merge property changed...
memoize_svn_mergeinfo_functions();
@@ -1705,14 +1745,15 @@ sub find_extra_svn_parents {
# history. Then, we figure out which git revisions are in
# that tip, but not this revision. If all of those revisions
# are now marked as merge, we can add the tip as a parent.
- my @merges = split "\n", $mergeinfo;
+ my @merges = sort keys %$mergeinfo;
my @merge_tips;
my $url = $self->url;
my $uuid = $self->ra_uuid;
my @all_ranges;
for my $merge ( @merges ) {
my ($tip_commit, @ranges) =
- lookup_svn_merge( $uuid, $url, $merge );
+ lookup_svn_merge( $uuid, $url,
+ $merge, $mergeinfo->{$merge} );
unless (!$tip_commit or
grep { $_ eq $tip_commit } @$parents ) {
push @merge_tips, $tip_commit;
@@ -1728,8 +1769,9 @@ sub find_extra_svn_parents {
# check merge tips for new parents
my @new_parents;
for my $merge_tip ( @merge_tips ) {
- my $spec = shift @merges;
+ my $merge = shift @merges;
next unless $merge_tip and $excluded{$merge_tip};
+ my $spec = "$merge:$mergeinfo->{$merge}";
# check out 'new' tips
my $merge_base;
@@ -1749,19 +1791,17 @@ sub find_extra_svn_parents {
}
# double check that there are no missing non-merge commits
- my (@incomplete) = check_cherry_pick(
+ my ($ninc, $ifirst) = check_cherry_pick2(
$merge_base, $merge_tip,
$parents,
@all_ranges,
);
- if ( @incomplete ) {
- warn "W:svn cherry-pick ignored ($spec) - missing "
- .@incomplete." commit(s) (eg $incomplete[0])\n";
+ if ($ninc) {
+ warn "W: svn cherry-pick ignored ($spec) - missing " .
+ "$ninc commit(s) (eg $ifirst)\n";
} else {
- warn
- "Found merge parent (svn:mergeinfo prop): ",
- $merge_tip, "\n";
+ warn "Found merge parent ($spec): ", $merge_tip, "\n";
push @new_parents, $merge_tip;
}
}
@@ -1787,23 +1827,20 @@ sub find_extra_svn_parents {
}
sub make_log_entry {
- my ($self, $rev, $parents, $ed) = @_;
+ my ($self, $rev, $parents, $ed, $parent_rev, $parent_path) = @_;
my $untracked = $self->get_untracked($ed);
my @parents = @$parents;
- my $ps = $ed->{path_strip} || "";
- for my $path ( grep { m/$ps/ } %{$ed->{dir_prop}} ) {
- my $props = $ed->{dir_prop}{$path};
- if ( $props->{"svk:merge"} ) {
- $self->find_extra_svk_parents
- ($ed, $props->{"svk:merge"}, \@parents);
- }
- if ( $props->{"svn:mergeinfo"} ) {
- $self->find_extra_svn_parents
- ($ed,
- $props->{"svn:mergeinfo"},
- \@parents);
- }
+ my $props = $ed->{dir_prop}{$self->path};
+ if ( $props->{"svk:merge"} ) {
+ $self->find_extra_svk_parents($props->{"svk:merge"}, \@parents);
+ }
+ if ( $props->{"svn:mergeinfo"} ) {
+ my $mi_changes = $self->mergeinfo_changes
+ ($parent_path, $parent_rev,
+ $self->path, $rev,
+ $props->{"svn:mergeinfo"});
+ $self->find_extra_svn_parents($mi_changes, \@parents);
}
open my $un, '>>', "$self->{dir}/unhandled.log" or croak $!;
@@ -1959,11 +1996,25 @@ sub rebuild_from_rev_db {
unlink $path or croak "unlink: $!";
}
+#define a global associate map to record rebuild status
+my %rebuild_status;
+#define a global associate map to record rebuild verify status
+my %rebuild_verify_status;
+
sub rebuild {
my ($self) = @_;
my $map_path = $self->map_path;
my $partial = (-e $map_path && ! -z $map_path);
- return unless ::verify_ref($self->refname.'^0');
+ my $verify_key = $self->refname.'^0';
+ if (!$rebuild_verify_status{$verify_key}) {
+ my $verify_result = ::verify_ref($verify_key);
+ if ($verify_result) {
+ $rebuild_verify_status{$verify_key} = 1;
+ }
+ }
+ if (!$rebuild_verify_status{$verify_key}) {
+ return;
+ }
if (!$partial && ($self->use_svm_props || $self->no_metadata)) {
my $rev_db = $self->rev_db_path;
$self->rebuild_from_rev_db($rev_db);
@@ -1977,10 +2028,21 @@ sub rebuild {
print "Rebuilding $map_path ...\n" if (!$partial);
my ($base_rev, $head) = ($partial ? $self->rev_map_max_norebuild(1) :
(undef, undef));
+ my $key_value = ($head ? "$head.." : "") . $self->refname;
+ if (exists $rebuild_status{$key_value}) {
+ print "Done rebuilding $map_path\n" if (!$partial || !$head);
+ my $rev_db_path = $self->rev_db_path;
+ if (-f $self->rev_db_path) {
+ unlink $self->rev_db_path or croak "unlink: $!";
+ }
+ $self->unlink_rev_db_symlink;
+ return;
+ }
my ($log, $ctx) =
- command_output_pipe(qw/rev-list --pretty=raw --reverse/,
- ($head ? "$head.." : "") . $self->refname,
+ command_output_pipe(qw/rev-list --pretty=raw --reverse/,
+ $key_value,
'--');
+ $rebuild_status{$key_value} = 1;
my $metadata_url = $self->metadata_url;
remove_username($metadata_url);
my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid;
diff --git a/perl/Git/SVN/Editor.pm b/perl/Git/SVN/Editor.pm
index b3bcd476da..34e8af966c 100644
--- a/perl/Git/SVN/Editor.pm
+++ b/perl/Git/SVN/Editor.pm
@@ -304,8 +304,12 @@ sub C {
my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
my $pbat = $self->ensure_path($dir, $deletions);
+ # workaround for a bug in svn serf backend (v1.8.5 and below):
+ # store third argument to ->add_file() in a local variable, to make it
+ # have the same lifetime as $fbat
+ my $upa = $self->url_path($m->{file_a});
my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
- $self->url_path($m->{file_a}), $self->{r});
+ $upa, $self->{r});
print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
$self->chg_file($fbat, $m);
$self->close_file($fbat,undef,$self->{pool});
@@ -323,8 +327,10 @@ sub R {
my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
my $pbat = $self->ensure_path($dir, $deletions);
+ # workaround for a bug in svn serf backend, see comment in C() above
+ my $upa = $self->url_path($m->{file_a});
my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
- $self->url_path($m->{file_a}), $self->{r});
+ $upa, $self->{r});
print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
$self->apply_autoprops($file, $fbat);
$self->chg_file($fbat, $m);
diff --git a/perl/Git/SVN/Log.pm b/perl/Git/SVN/Log.pm
index 3f8350a57d..664105357c 100644
--- a/perl/Git/SVN/Log.pm
+++ b/perl/Git/SVN/Log.pm
@@ -116,7 +116,8 @@ sub run_pager {
return;
}
open STDIN, '<&', $rfd or fatal "Can't redirect stdin: $!";
- $ENV{LESS} ||= 'FRSX';
+ $ENV{LESS} ||= 'FRX';
+ $ENV{LV} ||= '-c';
exec $pager or fatal "Can't run pager: $! ($pager)";
}
diff --git a/perl/Git/SVN/Migration.pm b/perl/Git/SVN/Migration.pm
index 30daf35465..cf6ffa7581 100644
--- a/perl/Git/SVN/Migration.pm
+++ b/perl/Git/SVN/Migration.pm
@@ -1,6 +1,6 @@
package Git::SVN::Migration;
# these version numbers do NOT correspond to actual version numbers
-# of git nor git-svn. They are just relative.
+# of git or git-svn. They are just relative.
#
# v0 layout: .git/$id/info/url, refs/heads/$id-HEAD
#
diff --git a/perl/Git/SVN/Ra.pm b/perl/Git/SVN/Ra.pm
index 75ecc425b6..622535e217 100644
--- a/perl/Git/SVN/Ra.pm
+++ b/perl/Git/SVN/Ra.pm
@@ -2,6 +2,7 @@ package Git::SVN::Ra;
use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/;
use strict;
use warnings;
+use Memoize;
use SVN::Client;
use Git::SVN::Utils qw(
canonicalize_url
@@ -32,6 +33,14 @@ BEGIN {
}
}
+# serf has a bug that leads to a coredump upon termination if the
+# remote access object is left around (not fixed yet in serf 1.3.1).
+# Explicitly free it to work around the issue.
+END {
+ $RA = undef;
+ $ra_invalid = 1;
+}
+
sub _auth_providers () {
my @rv = (
SVN::Client::get_simple_provider(),
@@ -68,6 +77,40 @@ sub _auth_providers () {
\@rv;
}
+sub prepare_config_once {
+ SVN::_Core::svn_config_ensure($config_dir, undef);
+ my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers);
+ my $config = SVN::Core::config_get_config($config_dir);
+ my $dont_store_passwords = 1;
+ my $conf_t = $config->{'config'};
+
+ no warnings 'once';
+ # The usage of $SVN::_Core::SVN_CONFIG_* variables
+ # produces warnings that variables are used only once.
+ # I had not found the better way to shut them up, so
+ # the warnings of type 'once' are disabled in this block.
+ if (SVN::_Core::svn_config_get_bool($conf_t,
+ $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
+ $SVN::_Core::SVN_CONFIG_OPTION_STORE_PASSWORDS,
+ 1) == 0) {
+ SVN::_Core::svn_auth_set_parameter($baton,
+ $SVN::_Core::SVN_AUTH_PARAM_DONT_STORE_PASSWORDS,
+ bless (\$dont_store_passwords, "_p_void"));
+ }
+ if (SVN::_Core::svn_config_get_bool($conf_t,
+ $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
+ $SVN::_Core::SVN_CONFIG_OPTION_STORE_AUTH_CREDS,
+ 1) == 0) {
+ $Git::SVN::Prompt::_no_auth_cache = 1;
+ }
+
+ return ($config, $baton, $callbacks);
+} # no warnings 'once'
+
+INIT {
+ Memoize::memoize '_auth_providers';
+ Memoize::memoize 'prepare_config_once';
+}
sub new {
my ($class, $url) = @_;
@@ -76,34 +119,8 @@ sub new {
::_req_svn();
- SVN::_Core::svn_config_ensure($config_dir, undef);
- my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers);
- my $config = SVN::Core::config_get_config($config_dir);
$RA = undef;
- my $dont_store_passwords = 1;
- my $conf_t = ${$config}{'config'};
- {
- no warnings 'once';
- # The usage of $SVN::_Core::SVN_CONFIG_* variables
- # produces warnings that variables are used only once.
- # I had not found the better way to shut them up, so
- # the warnings of type 'once' are disabled in this block.
- if (SVN::_Core::svn_config_get_bool($conf_t,
- $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
- $SVN::_Core::SVN_CONFIG_OPTION_STORE_PASSWORDS,
- 1) == 0) {
- SVN::_Core::svn_auth_set_parameter($baton,
- $SVN::_Core::SVN_AUTH_PARAM_DONT_STORE_PASSWORDS,
- bless (\$dont_store_passwords, "_p_void"));
- }
- if (SVN::_Core::svn_config_get_bool($conf_t,
- $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
- $SVN::_Core::SVN_CONFIG_OPTION_STORE_AUTH_CREDS,
- 1) == 0) {
- $Git::SVN::Prompt::_no_auth_cache = 1;
- }
- } # no warnings 'once'
-
+ my ($config, $baton, $callbacks) = prepare_config_once();
my $self = SVN::Ra->new(url => $url, auth => $baton,
config => $config,
pool => SVN::Pool->new,
@@ -158,7 +175,17 @@ sub get_dir {
}
}
my $pool = SVN::Pool->new;
- my ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
+ my ($d, undef, $props);
+
+ if (::compare_svn_version('1.4.0') >= 0) {
+ # n.b. in addition to being potentially more efficient,
+ # this works around what appears to be a bug in some
+ # SVN 1.8 versions
+ my $kind = 1; # SVN_DIRENT_KIND
+ ($d, undef, $props) = $self->get_dir2($dir, $r, $kind, $pool);
+ } else {
+ ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
+ }
my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d;
$pool->clear;
if ($r != $cache->{r}) {
@@ -169,10 +196,6 @@ sub get_dir {
wantarray ? (\%dirents, $r, $props) : \%dirents;
}
-sub DESTROY {
- # do not call the real DESTROY since we store ourselves in $RA
-}
-
# get_log(paths, start, end, limit,
# discover_changed_paths, strict_node_history, receiver)
sub get_log {
@@ -368,10 +391,19 @@ sub longest_common_path {
sub gs_fetch_loop_common {
my ($self, $base, $head, $gsv, $globs) = @_;
return if ($base > $head);
+ my $gpool = SVN::Pool->new_default;
+ my $ra_url = $self->url;
+ my $reload_ra = sub {
+ $_[0] = undef;
+ $self = undef;
+ $RA = undef;
+ $gpool->clear;
+ $self = Git::SVN::Ra->new($ra_url);
+ $ra_invalid = undef;
+ };
my $inc = $_log_window_size;
my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
my $longest_path = longest_common_path($gsv, $globs);
- my $ra_url = $self->url;
my $find_trailing_edge;
while (1) {
my %revs;
@@ -418,7 +450,7 @@ sub gs_fetch_loop_common {
my %exists = map { $_->path => $_ } @$gsv;
foreach my $r (sort {$a <=> $b} keys %revs) {
- my ($paths, $logged) = @{$revs{$r}};
+ my ($paths, $logged) = @{delete $revs{$r}};
foreach my $gs ($self->match_globs(\%exists, $paths,
$globs, $r)) {
@@ -441,13 +473,7 @@ sub gs_fetch_loop_common {
"$g->{t}-maxRev";
Git::SVN::tmp_config($k, $r);
}
- if ($ra_invalid) {
- $_[0] = undef;
- $self = undef;
- $RA = undef;
- $self = Git::SVN::Ra->new($ra_url);
- $ra_invalid = undef;
- }
+ $reload_ra->() if $ra_invalid;
}
# pre-fill the .rev_db since it'll eventually get filled in
# with '0' x40 if something new gets committed
@@ -464,6 +490,8 @@ sub gs_fetch_loop_common {
$min = $max + 1;
$max += $inc;
$max = $head if ($max > $head);
+
+ $reload_ra->();
}
Git::SVN::gc();
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-30 09:32:42 +0000