git-svn: make Git::SVN::RA a separate file

This slices off another 600 or so lines from the frighteningly long
git-svn.perl script.

The Git::SVN::Ra interface is similar enough to SVN::Ra that it is
probably safe to ignore most of its implementation on first reading.
(Documenting or moving functions that do not fit that pattern is left
as an exercise to the interested reader.)

[ew: rebased and fixed conflict against
 commit c26ddce86d7215b4d9687bd4c6b5dd43a3fabf31
 (git-svn: platform auth providers are working only on 1.6.15 or newer)]

Signed-off-by: Jonathan Nieder <jrnieder@gmail.com>
Signed-off-by: Eric Wong <normalperson@yhbt.net>

1 files changed, 1 insertions, 611 deletions

diff --git a/git-svn.perl b/git-svn.perl
index aa14d45..24c0af2 100755
--- a/git-svn.perl
+++ b/git-svn.perl
@@ -67,7 +67,6 @@ sub _req_svn {
 	}
 }
 my $can_compress = eval { require Compress::Zlib; 1};
-push @Git::SVN::Ra::ISA, 'SVN::Ra';
 use Carp qw/croak/;
 use Digest::MD5;
 use IO::File qw//;
@@ -80,6 +79,7 @@ use IPC::Open3;
 use Git;
 use Git::SVN::Editor qw//;
 use Git::SVN::Fetcher qw//;
+use Git::SVN::Ra qw//;
 use Git::SVN::Prompt qw//;
 use Memoize;  # core since 5.8.0, Jul 2002
 
@@ -4326,616 +4326,6 @@ sub remove_username {
 	$_[0] =~ s{^([^:]*://)[^@]+@}{$1};
 }
 
-package Git::SVN::Ra;
-use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/;
-use strict;
-use warnings;
-my ($ra_invalid, $can_do_switch, %ignored_err, $RA);
-
-BEGIN {
-	# enforce temporary pool usage for some simple functions
-	no strict 'refs';
-	for my $f (qw/rev_proplist get_latest_revnum get_uuid get_repos_root
-	              get_file/) {
-		my $SUPER = "SUPER::$f";
-		*$f = sub {
-			my $self = shift;
-			my $pool = SVN::Pool->new;
-			my @ret = $self->$SUPER(@_,$pool);
-			$pool->clear;
-			wantarray ? @ret : $ret[0];
-		};
-	}
-}
-
-sub _auth_providers () {
-	my @rv = (
-	  SVN::Client::get_simple_provider(),
-	  SVN::Client::get_ssl_server_trust_file_provider(),
-	  SVN::Client::get_simple_prompt_provider(
-	    \&Git::SVN::Prompt::simple, 2),
-	  SVN::Client::get_ssl_client_cert_file_provider(),
-	  SVN::Client::get_ssl_client_cert_prompt_provider(
-	    \&Git::SVN::Prompt::ssl_client_cert, 2),
-	  SVN::Client::get_ssl_client_cert_pw_file_provider(),
-	  SVN::Client::get_ssl_client_cert_pw_prompt_provider(
-	    \&Git::SVN::Prompt::ssl_client_cert_pw, 2),
-	  SVN::Client::get_username_provider(),
-	  SVN::Client::get_ssl_server_trust_prompt_provider(
-	    \&Git::SVN::Prompt::ssl_server_trust),
-	  SVN::Client::get_username_prompt_provider(
-	    \&Git::SVN::Prompt::username, 2)
-	);
-
-	# earlier 1.6.x versions would segfault, and <= 1.5.x didn't have
-	# this function
-	if (::compare_svn_version('1.6.15') >= 0) {
-		my $config = SVN::Core::config_get_config($config_dir);
-		my ($p, @a);
-		# config_get_config returns all config files from
-		# ~/.subversion, auth_get_platform_specific_client_providers
-		# just wants the config "file".
-		@a = ($config->{'config'}, undef);
-		$p = SVN::Core::auth_get_platform_specific_client_providers(@a);
-		# Insert the return value from
-		# auth_get_platform_specific_providers
-		unshift @rv, @$p;
-	}
-	\@rv;
-}
-
-sub escape_uri_only {
-	my ($uri) = @_;
-	my @tmp;
-	foreach (split m{/}, $uri) {
-		s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
-		push @tmp, $_;
-	}
-	join('/', @tmp);
-}
-
-sub escape_url {
-	my ($url) = @_;
-	if ($url =~ m#^(https?)://([^/]+)(.*)$#) {
-		my ($scheme, $domain, $uri) = ($1, $2, escape_uri_only($3));
-		$url = "$scheme://$domain$uri";
-	}
-	$url;
-}
-
-sub new {
-	my ($class, $url) = @_;
-	$url =~ s!/+$!!;
-	return $RA if ($RA && $RA->{url} eq $url);
-
-	::_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 $self = SVN::Ra->new(url => escape_url($url), auth => $baton,
-	                      config => $config,
-			      pool => SVN::Pool->new,
-	                      auth_provider_callbacks => $callbacks);
-	$self->{url} = $url;
-	$self->{svn_path} = $url;
-	$self->{repos_root} = $self->get_repos_root;
-	$self->{svn_path} =~ s#^\Q$self->{repos_root}\E(/|$)##;
-	$self->{cache} = { check_path => { r => 0, data => {} },
-	                   get_dir => { r => 0, data => {} } };
-	$RA = bless $self, $class;
-}
-
-sub check_path {
-	my ($self, $path, $r) = @_;
-	my $cache = $self->{cache}->{check_path};
-	if ($r == $cache->{r} && exists $cache->{data}->{$path}) {
-		return $cache->{data}->{$path};
-	}
-	my $pool = SVN::Pool->new;
-	my $t = $self->SUPER::check_path($path, $r, $pool);
-	$pool->clear;
-	if ($r != $cache->{r}) {
-		%{$cache->{data}} = ();
-		$cache->{r} = $r;
-	}
-	$cache->{data}->{$path} = $t;
-}
-
-sub get_dir {
-	my ($self, $dir, $r) = @_;
-	my $cache = $self->{cache}->{get_dir};
-	if ($r == $cache->{r}) {
-		if (my $x = $cache->{data}->{$dir}) {
-			return wantarray ? @$x : $x->[0];
-		}
-	}
-	my $pool = SVN::Pool->new;
-	my ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
-	my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d;
-	$pool->clear;
-	if ($r != $cache->{r}) {
-		%{$cache->{data}} = ();
-		$cache->{r} = $r;
-	}
-	$cache->{data}->{$dir} = [ \%dirents, $r, $props ];
-	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 {
-	my ($self, @args) = @_;
-	my $pool = SVN::Pool->new;
-
-	# svn_log_changed_path_t objects passed to get_log are likely to be
-	# overwritten even if only the refs are copied to an external variable,
-	# so we should dup the structures in their entirety.  Using an
-	# externally passed pool (instead of our temporary and quickly cleared
-	# pool in Git::SVN::Ra) does not help matters at all...
-	my $receiver = pop @args;
-	my $prefix = "/".$self->{svn_path};
-	$prefix =~ s#/+($)##;
-	my $prefix_regex = qr#^\Q$prefix\E#;
-	push(@args, sub {
-		my ($paths) = $_[0];
-		return &$receiver(@_) unless $paths;
-		$_[0] = ();
-		foreach my $p (keys %$paths) {
-			my $i = $paths->{$p};
-			# Make path relative to our url, not repos_root
-			$p =~ s/$prefix_regex//;
-			my %s = map { $_ => $i->$_; }
-				qw/copyfrom_path copyfrom_rev action/;
-			if ($s{'copyfrom_path'}) {
-				$s{'copyfrom_path'} =~ s/$prefix_regex//;
-			}
-			$_[0]{$p} = \%s;
-		}
-		&$receiver(@_);
-	});
-
-
-	# the limit parameter was not supported in SVN 1.1.x, so we
-	# drop it.  Therefore, the receiver callback passed to it
-	# is made aware of this limitation by being wrapped if
-	# the limit passed to is being wrapped.
-	if (::compare_svn_version('1.2.0') <= 0) {
-		my $limit = splice(@args, 3, 1);
-		if ($limit > 0) {
-			my $receiver = pop @args;
-			push(@args, sub { &$receiver(@_) if (--$limit >= 0) });
-		}
-	}
-	my $ret = $self->SUPER::get_log(@args, $pool);
-	$pool->clear;
-	$ret;
-}
-
-sub trees_match {
-	my ($self, $url1, $rev1, $url2, $rev2) = @_;
-	my $ctx = SVN::Client->new(auth => _auth_providers);
-	my $out = IO::File->new_tmpfile;
-
-	# older SVN (1.1.x) doesn't take $pool as the last parameter for
-	# $ctx->diff(), so we'll create a default one
-	my $pool = SVN::Pool->new_default_sub;
-
-	$ra_invalid = 1; # this will open a new SVN::Ra connection to $url1
-	$ctx->diff([], $url1, $rev1, $url2, $rev2, 1, 1, 0, $out, $out);
-	$out->flush;
-	my $ret = (($out->stat)[7] == 0);
-	close $out or croak $!;
-
-	$ret;
-}
-
-sub get_commit_editor {
-	my ($self, $log, $cb, $pool) = @_;
-
-	my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef, 0) : ();
-	$self->SUPER::get_commit_editor($log, $cb, @lock, $pool);
-}
-
-sub gs_do_update {
-	my ($self, $rev_a, $rev_b, $gs, $editor) = @_;
-	my $new = ($rev_a == $rev_b);
-	my $path = $gs->{path};
-
-	if ($new && -e $gs->{index}) {
-		unlink $gs->{index} or die
-		  "Couldn't unlink index: $gs->{index}: $!\n";
-	}
-	my $pool = SVN::Pool->new;
-	$editor->set_path_strip($path);
-	my (@pc) = split m#/#, $path;
-	my $reporter = $self->do_update($rev_b, (@pc ? shift @pc : ''),
-	                                1, $editor, $pool);
-	my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
-
-	# Since we can't rely on svn_ra_reparent being available, we'll
-	# just have to do some magic with set_path to make it so
-	# we only want a partial path.
-	my $sp = '';
-	my $final = join('/', @pc);
-	while (@pc) {
-		$reporter->set_path($sp, $rev_b, 0, @lock, $pool);
-		$sp .= '/' if length $sp;
-		$sp .= shift @pc;
-	}
-	die "BUG: '$sp' != '$final'\n" if ($sp ne $final);
-
-	$reporter->set_path($sp, $rev_a, $new, @lock, $pool);
-
-	$reporter->finish_report($pool);
-	$pool->clear;
-	$editor->{git_commit_ok};
-}
-
-# this requires SVN 1.4.3 or later (do_switch didn't work before 1.4.3, and
-# svn_ra_reparent didn't work before 1.4)
-sub gs_do_switch {
-	my ($self, $rev_a, $rev_b, $gs, $url_b, $editor) = @_;
-	my $path = $gs->{path};
-	my $pool = SVN::Pool->new;
-
-	my $full_url = $self->{url};
-	my $old_url = $full_url;
-	$full_url .= '/' . $path if length $path;
-	my ($ra, $reparented);
-
-	if ($old_url =~ m#^svn(\+ssh)?://# ||
-	    ($full_url =~ m#^https?://# &&
-	     escape_url($full_url) ne $full_url)) {
-		$_[0] = undef;
-		$self = undef;
-		$RA = undef;
-		$ra = Git::SVN::Ra->new($full_url);
-		$ra_invalid = 1;
-	} elsif ($old_url ne $full_url) {
-		SVN::_Ra::svn_ra_reparent($self->{session}, $full_url, $pool);
-		$self->{url} = $full_url;
-		$reparented = 1;
-	}
-
-	$ra ||= $self;
-	$url_b = escape_url($url_b);
-	my $reporter = $ra->do_switch($rev_b, '', 1, $url_b, $editor, $pool);
-	my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
-	$reporter->set_path('', $rev_a, 0, @lock, $pool);
-	$reporter->finish_report($pool);
-
-	if ($reparented) {
-		SVN::_Ra::svn_ra_reparent($self->{session}, $old_url, $pool);
-		$self->{url} = $old_url;
-	}
-
-	$pool->clear;
-	$editor->{git_commit_ok};
-}
-
-sub longest_common_path {
-	my ($gsv, $globs) = @_;
-	my %common;
-	my $common_max = scalar @$gsv;
-
-	foreach my $gs (@$gsv) {
-		my @tmp = split m#/#, $gs->{path};
-		my $p = '';
-		foreach (@tmp) {
-			$p .= length($p) ? "/$_" : $_;
-			$common{$p} ||= 0;
-			$common{$p}++;
-		}
-	}
-	$globs ||= [];
-	$common_max += scalar @$globs;
-	foreach my $glob (@$globs) {
-		my @tmp = split m#/#, $glob->{path}->{left};
-		my $p = '';
-		foreach (@tmp) {
-			$p .= length($p) ? "/$_" : $_;
-			$common{$p} ||= 0;
-			$common{$p}++;
-		}
-	}
-
-	my $longest_path = '';
-	foreach (sort {length $b <=> length $a} keys %common) {
-		if ($common{$_} == $common_max) {
-			$longest_path = $_;
-			last;
-		}
-	}
-	$longest_path;
-}
-
-sub gs_fetch_loop_common {
-	my ($self, $base, $head, $gsv, $globs) = @_;
-	return if ($base > $head);
-	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;
-		my $err;
-		my $err_handler = $SVN::Error::handler;
-		$SVN::Error::handler = sub {
-			($err) = @_;
-			skip_unknown_revs($err);
-		};
-		sub _cb {
-			my ($paths, $r, $author, $date, $log) = @_;
-			[ $paths,
-			  { author => $author, date => $date, log => $log } ];
-		}
-		$self->get_log([$longest_path], $min, $max, 0, 1, 1,
-		               sub { $revs{$_[1]} = _cb(@_) });
-		if ($err) {
-			print "Checked through r$max\r";
-		} else {
-			$find_trailing_edge = 1;
-		}
-		if ($err and $find_trailing_edge) {
-			print STDERR "Path '$longest_path' ",
-				     "was probably deleted:\n",
-				     $err->expanded_message,
-				     "\nWill attempt to follow ",
-				     "revisions r$min .. r$max ",
-				     "committed before the deletion\n";
-			my $hi = $max;
-			while (--$hi >= $min) {
-				my $ok;
-				$self->get_log([$longest_path], $min, $hi,
-				               0, 1, 1, sub {
-				               $ok = $_[1];
-				               $revs{$_[1]} = _cb(@_) });
-				if ($ok) {
-					print STDERR "r$min .. r$ok OK\n";
-					last;
-				}
-			}
-			$find_trailing_edge = 0;
-		}
-		$SVN::Error::handler = $err_handler;
-
-		my %exists = map { $_->{path} => $_ } @$gsv;
-		foreach my $r (sort {$a <=> $b} keys %revs) {
-			my ($paths, $logged) = @{$revs{$r}};
-
-			foreach my $gs ($self->match_globs(\%exists, $paths,
-			                                   $globs, $r)) {
-				if ($gs->rev_map_max >= $r) {
-					next;
-				}
-				next unless $gs->match_paths($paths, $r);
-				$gs->{logged_rev_props} = $logged;
-				if (my $last_commit = $gs->last_commit) {
-					$gs->assert_index_clean($last_commit);
-				}
-				my $log_entry = $gs->do_fetch($paths, $r);
-				if ($log_entry) {
-					$gs->do_git_commit($log_entry);
-				}
-				$INDEX_FILES{$gs->{index}} = 1;
-			}
-			foreach my $g (@$globs) {
-				my $k = "svn-remote.$g->{remote}." .
-				        "$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;
-			}
-		}
-		# pre-fill the .rev_db since it'll eventually get filled in
-		# with '0' x40 if something new gets committed
-		foreach my $gs (@$gsv) {
-			next if $gs->rev_map_max >= $max;
-			next if defined $gs->rev_map_get($max);
-			$gs->rev_map_set($max, 0 x40);
-		}
-		foreach my $g (@$globs) {
-			my $k = "svn-remote.$g->{remote}.$g->{t}-maxRev";
-			Git::SVN::tmp_config($k, $max);
-		}
-		last if $max >= $head;
-		$min = $max + 1;
-		$max += $inc;
-		$max = $head if ($max > $head);
-	}
-	Git::SVN::gc();
-}
-
-sub get_dir_globbed {
-	my ($self, $left, $depth, $r) = @_;
-
-	my @x = eval { $self->get_dir($left, $r) };
-	return unless scalar @x == 3;
-	my $dirents = $x[0];
-	my @finalents;
-	foreach my $de (keys %$dirents) {
-		next if $dirents->{$de}->{kind} != $SVN::Node::dir;
-		if ($depth > 1) {
-			my @args = ("$left/$de", $depth - 1, $r);
-			foreach my $dir ($self->get_dir_globbed(@args)) {
-				push @finalents, "$de/$dir";
-			}
-		} else {
-			push @finalents, $de;
-		}
-	}
-	@finalents;
-}
-
-# return value: 0 -- don't ignore, 1 -- ignore
-sub is_ref_ignored {
-	my ($g, $p) = @_;
-	my $refname = $g->{ref}->full_path($p);
-	return 1 if defined($g->{ignore_refs_regex}) &&
-	            $refname =~ m!$g->{ignore_refs_regex}!;
-	return 0 unless defined($_ignore_refs_regex);
-	return 1 if $refname =~ m!$_ignore_refs_regex!o;
-	return 0;
-}
-
-sub match_globs {
-	my ($self, $exists, $paths, $globs, $r) = @_;
-
-	sub get_dir_check {
-		my ($self, $exists, $g, $r) = @_;
-
-		my @dirs = $self->get_dir_globbed($g->{path}->{left},
-		                                  $g->{path}->{depth},
-		                                  $r);
-
-		foreach my $de (@dirs) {
-			my $p = $g->{path}->full_path($de);
-			next if $exists->{$p};
-			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);
-		}
-	}
-	foreach my $g (@$globs) {
-		if (my $path = $paths->{"/$g->{path}->{left}"}) {
-			if ($path->{action} =~ /^[AR]$/) {
-				get_dir_check($self, $exists, $g, $r);
-			}
-		}
-		foreach (keys %$paths) {
-			if (/$g->{path}->{left_regex}/ &&
-			    !/$g->{path}->{regex}/) {
-				next if $paths->{$_}->{action} !~ /^[AR]$/;
-				get_dir_check($self, $exists, $g, $r);
-			}
-			next unless /$g->{path}->{regex}/;
-			my $p = $1;
-			my $pathname = $g->{path}->full_path($p);
-			next if is_ref_ignored($g, $p);
-			next if $exists->{$pathname};
-			next if ($self->check_path($pathname, $r) !=
-			         $SVN::Node::dir);
-			$exists->{$pathname} = Git::SVN->init(
-			                      $self->{url}, $pathname, undef,
-			                      $g->{ref}->full_path($p), 1);
-		}
-		my $c = '';
-		foreach (split m#/#, $g->{path}->{left}) {
-			$c .= "/$_";
-			next unless ($paths->{$c} &&
-			             ($paths->{$c}->{action} =~ /^[AR]$/));
-			get_dir_check($self, $exists, $g, $r);
-		}
-	}
-	values %$exists;
-}
-
-sub minimize_url {
-	my ($self) = @_;
-	return $self->{url} if ($self->{url} eq $self->{repos_root});
-	my $url = $self->{repos_root};
-	my @components = split(m!/!, $self->{svn_path});
-	my $c = '';
-	do {
-		$url .= "/$c" if length $c;
-		eval {
-			my $ra = (ref $self)->new($url);
-			my $latest = $ra->get_latest_revnum;
-			$ra->get_log("", $latest, 0, 1, 0, 1, sub {});
-		};
-	} while ($@ && ($c = shift @components));
-	$url;
-}
-
-sub can_do_switch {
-	my $self = shift;
-	unless (defined $can_do_switch) {
-		my $pool = SVN::Pool->new;
-		my $rep = eval {
-			$self->do_switch(1, '', 0, $self->{url},
-			                 SVN::Delta::Editor->new, $pool);
-		};
-		if ($@) {
-			$can_do_switch = 0;
-		} else {
-			$rep->abort_report($pool);
-			$can_do_switch = 1;
-		}
-		$pool->clear;
-	}
-	$can_do_switch;
-}
-
-sub skip_unknown_revs {
-	my ($err) = @_;
-	my $errno = $err->apr_err();
-	# Maybe the branch we're tracking didn't
-	# exist when the repo started, so it's
-	# not an error if it doesn't, just continue
-	#
-	# Wonderfully consistent library, eh?
-	# 160013 - svn:// and file://
-	# 175002 - http(s)://
-	# 175007 - http(s):// (this repo required authorization, too...)
-	#   More codes may be discovered later...
-	if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
-		my $err_key = $err->expanded_message;
-		# revision numbers change every time, filter them out
-		$err_key =~ s/\d+/\0/g;
-		$err_key = "$errno\0$err_key";
-		unless ($ignored_err{$err_key}) {
-			warn "W: Ignoring error from SVN, path probably ",
-			     "does not exist: ($errno): ",
-			     $err->expanded_message,"\n";
-			warn "W: Do not be alarmed at the above message ",
-			     "git-svn is just searching aggressively for ",
-			     "old history.\n",
-			     "This may take a while on large repositories\n";
-			$ignored_err{$err_key} = 1;
-		}
-		return;
-	}
-	die "Error from SVN, ($errno): ", $err->expanded_message,"\n";
-}
-
 package Git::SVN::Log;
 use strict;
 use warnings;