summaryrefslogtreecommitdiff
path: root/perl
diff options
context:
space:
mode:
Diffstat (limited to 'perl')
-rw-r--r--perl/Git.pm9
-rw-r--r--perl/Git/SVN.pm127
-rw-r--r--perl/Git/SVN/Editor.pm38
-rw-r--r--perl/Git/SVN/Ra.pm102
4 files changed, 182 insertions, 94 deletions
diff --git a/perl/Git.pm b/perl/Git.pm
index 204fdc6737..9026a7bb98 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -695,7 +695,7 @@ Retrieve the integer configuration C<VARIABLE>. The return value
is simple decimal number. An optional value suffix of 'k', 'm',
or 'g' in the config file will cause the value to be multiplied
by 1024, 1048576 (1024^2), or 1073741824 (1024^3) prior to output.
-It would return C<undef> if configuration variable is not defined,
+It would return C<undef> if configuration variable is not defined.
=cut
@@ -704,7 +704,7 @@ sub config_int {
}
# Common subroutine to implement bulk of what the config* family of methods
-# do. This curently wraps command('config') so it is not so fast.
+# do. This currently wraps command('config') so it is not so fast.
sub _config_common {
my ($opts) = shift @_;
my ($self, $var) = _maybe_self(@_);
@@ -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 09cff135ef..8e4af7153e 100644
--- a/perl/Git/SVN.pm
+++ b/perl/Git/SVN.pm
@@ -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;
}
@@ -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 {
@@ -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,9 +1598,8 @@ 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;
- my %_rev_list_cache;
tie_for_persistent_memoization(\%lookup_svn_merge_cache,
"$cache_path/lookup_svn_merge");
@@ -1608,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,
@@ -1621,14 +1621,6 @@ sub tie_for_persistent_memoization {
SCALAR_CACHE => ['HASH' => \%has_no_changes_cache],
LIST_CACHE => 'FAULT',
;
-
- tie_for_persistent_memoization(\%_rev_list_cache,
- "$cache_path/_rev_list");
- memoize '_rev_list',
- SCALAR_CACHE => 'FAULT',
- LIST_CACHE => ['HASH' => \%_rev_list_cache],
- ;
-
}
sub unmemoize_svn_mergeinfo_functions {
@@ -1636,9 +1628,8 @@ 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';
- Memoize::unmemoize '_rev_list';
}
sub clear_memoized_mergeinfo_caches {
@@ -1648,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";
@@ -1702,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();
@@ -1715,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;
@@ -1738,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;
@@ -1759,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;
}
}
@@ -1797,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 $!;
@@ -2338,7 +2365,7 @@ sub _new {
# Older repos imported by us used $GIT_DIR/svn/foo instead of
# $GIT_DIR/svn/refs/remotes/foo when tracking refs/remotes/foo
- if ($ref_id =~ m{^refs/remotes/(.*)}) {
+ if ($ref_id =~ m{^refs/remotes/(.+)}) {
my $old_dir = "$ENV{GIT_DIR}/svn/$1";
if (-d $old_dir && ! -d $dir) {
$dir = $old_dir;
diff --git a/perl/Git/SVN/Editor.pm b/perl/Git/SVN/Editor.pm
index 34e8af966c..4088f13e72 100644
--- a/perl/Git/SVN/Editor.pm
+++ b/perl/Git/SVN/Editor.pm
@@ -288,6 +288,40 @@ sub apply_autoprops {
}
}
+sub check_attr {
+ my ($attr,$path) = @_;
+ my $val = command_oneline("check-attr", $attr, "--", $path);
+ if ($val) { $val =~ s/^[^:]*:\s*[^:]*:\s*(.*)\s*$/$1/; }
+ return $val;
+}
+
+sub apply_manualprops {
+ my ($self, $file, $fbat) = @_;
+ my $pending_properties = check_attr( "svn-properties", $file );
+ if ($pending_properties eq "") { return; }
+ # Parse the list of properties to set.
+ my @props = split(/;/, $pending_properties);
+ # TODO: get existing properties to compare to
+ # - this fails for add so currently not done
+ # my $existing_props = ::get_svnprops($file);
+ my $existing_props = {};
+ # TODO: caching svn properties or storing them in .gitattributes
+ # would make that faster
+ foreach my $prop (@props) {
+ # Parse 'name=value' syntax and set the property.
+ if ($prop =~ /([^=]+)=(.*)/) {
+ my ($n,$v) = ($1,$2);
+ for ($n, $v) {
+ s/^\s+//; s/\s+$//;
+ }
+ my $existing = $existing_props->{$n};
+ if (!defined($existing) || $existing ne $v) {
+ $self->change_file_prop($fbat, $n, $v);
+ }
+ }
+ }
+}
+
sub A {
my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
@@ -296,6 +330,7 @@ sub A {
undef, -1);
print "\tA\t$m->{file_b}\n" unless $::_q;
$self->apply_autoprops($file, $fbat);
+ $self->apply_manualprops($m->{file_b}, $fbat);
$self->chg_file($fbat, $m);
$self->close_file($fbat,undef,$self->{pool});
}
@@ -311,6 +346,7 @@ sub C {
my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
$upa, $self->{r});
print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
+ $self->apply_manualprops($m->{file_b}, $fbat);
$self->chg_file($fbat, $m);
$self->close_file($fbat,undef,$self->{pool});
}
@@ -333,6 +369,7 @@ sub R {
$upa, $self->{r});
print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
$self->apply_autoprops($file, $fbat);
+ $self->apply_manualprops($m->{file_b}, $fbat);
$self->chg_file($fbat, $m);
$self->close_file($fbat,undef,$self->{pool});
@@ -348,6 +385,7 @@ sub M {
my $fbat = $self->open_file($self->repo_path($m->{file_b}),
$pbat,$self->{r},$self->{pool});
print "\t$m->{chg}\t$m->{file_b}\n" unless $::_q;
+ $self->apply_manualprops($m->{file_b}, $fbat);
$self->chg_file($fbat, $m);
$self->close_file($fbat,undef,$self->{pool});
}
diff --git a/perl/Git/SVN/Ra.pm b/perl/Git/SVN/Ra.pm
index a7b0119ee5..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
@@ -76,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) = @_;
@@ -84,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,
@@ -166,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}) {
@@ -177,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 {
@@ -376,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;
@@ -426,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)) {
@@ -449,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
@@ -472,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-12-11 18:40:58 +0000