[thirdparty/git.git] / perl / Git / SVN / Fetcher.pm

package Git::SVN::Fetcher;
use vars qw/@ISA $_ignore_regex $_include_regex $_preserve_empty_dirs
            $_placeholder_filename @deleted_gpath %added_placeholder
            $repo_id/;
use strict;
use warnings;
use SVN::Delta;
use Carp qw/croak/;
use File::Basename qw/dirname/;
use IO::File qw//;
use Git qw/command command_oneline command_noisy command_output_pipe
           command_input_pipe command_close_pipe
           command_bidi_pipe command_close_bidi_pipe/;
BEGIN {
	@ISA = qw(SVN::Delta::Editor);
}

# file baton members: path, mode_a, mode_b, pool, fh, blob, base
sub new {
	my ($class, $git_svn, $switch_path) = @_;
	my $self = SVN::Delta::Editor->new;
	bless $self, $class;
	if (exists $git_svn->{last_commit}) {
		$self->{c} = $git_svn->{last_commit};
		$self->{empty_symlinks} =
		                  _mark_empty_symlinks($git_svn, $switch_path);
	}

	# some options are read globally, but can be overridden locally
	# per [svn-remote "..."] section.  Command-line options will *NOT*
	# override options set in an [svn-remote "..."] section
	$repo_id = $git_svn->{repo_id};
	my $k = "svn-remote.$repo_id.ignore-paths";
	my $v = eval { command_oneline('config', '--get', $k) };
	$self->{ignore_regex} = $v;

	$k = "svn-remote.$repo_id.include-paths";
	$v = eval { command_oneline('config', '--get', $k) };
	$self->{include_regex} = $v;

	$k = "svn-remote.$repo_id.preserve-empty-dirs";
	$v = eval { command_oneline('config', '--get', '--bool', $k) };
	if ($v && $v eq 'true') {
		$_preserve_empty_dirs = 1;
		$k = "svn-remote.$repo_id.placeholder-filename";
		$v = eval { command_oneline('config', '--get', $k) };
		$_placeholder_filename = $v;
	}

	# Load the list of placeholder files added during previous invocations.
	$k = "svn-remote.$repo_id.added-placeholder";
	$v = eval { command_oneline('config', '--get-all', $k) };
	if ($_preserve_empty_dirs && $v) {
		# command() prints errors to stderr, so we only call it if
		# command_oneline() succeeded.
		my @v = command('config', '--get-all', $k);
		$added_placeholder{ dirname($_) } = $_ foreach @v;
	}

	$self->{empty} = {};
	$self->{dir_prop} = {};
	$self->{file_prop} = {};
	$self->{absent_dir} = {};
	$self->{absent_file} = {};
	require Git::IndexInfo;
	$self->{gii} = $git_svn->tmp_index_do(sub { Git::IndexInfo->new });
	$self->{pathnameencoding} = Git::config('svn.pathnameencoding');
	$self;
}

# this uses the Ra object, so it must be called before do_{switch,update},
# not inside them (when the Git::SVN::Fetcher object is passed) to
# do_{switch,update}
sub _mark_empty_symlinks {
	my ($git_svn, $switch_path) = @_;
	my $bool = Git::config_bool('svn.brokenSymlinkWorkaround');
	return {} if (!defined($bool)) || (defined($bool) && ! $bool);

	my %ret;
	my ($rev, $cmt) = $git_svn->last_rev_commit;
	return {} unless ($rev && $cmt);

	# allow the warning to be printed for each revision we fetch to
	# ensure the user sees it.  The user can also disable the workaround
	# on the repository even while git svn is running and the next
	# revision fetched will skip this expensive function.
	my $printed_warning;
	chomp(my $empty_blob = `git hash-object -t blob --stdin < /dev/null`);
	my ($ls, $ctx) = command_output_pipe(qw/ls-tree -r -z/, $cmt);
	local $/ = "\0";
	my $pfx = defined($switch_path) ? $switch_path : $git_svn->path;
	$pfx .= '/' if length($pfx);
	while (<$ls>) {
		chomp;
		s/\A100644 blob $empty_blob\t//o or next;
		unless ($printed_warning) {
			print STDERR "Scanning for empty symlinks, ",
			             "this may take a while if you have ",
				     "many empty files\n",
				     "You may disable this with `",
				     "git config svn.brokenSymlinkWorkaround ",
				     "false'.\n",
				     "This may be done in a different ",
				     "terminal without restarting ",
				     "git svn\n";
			$printed_warning = 1;
		}
		my $path = $_;
		my (undef, $props) =
		               $git_svn->ra->get_file($pfx.$path, $rev, undef);
		if ($props->{'svn:special'}) {
			$ret{$path} = 1;
		}
	}
	command_close_pipe($ls, $ctx);
	\%ret;
}

# returns true if a given path is inside a ".git" directory
sub in_dot_git {
	$_[0] =~ m{(?:^|/)\.git(?:/|$)};
}

# return value: 0 -- don't ignore, 1 -- ignore
# This will also check whether the path is explicitly included
sub is_path_ignored {
	my ($self, $path) = @_;
	return 1 if in_dot_git($path);
	return 1 if defined($self->{ignore_regex}) &&
	            $path =~ m!$self->{ignore_regex}!;
	return 0 if defined($self->{include_regex}) &&
	            $path =~ m!$self->{include_regex}!;
	return 0 if defined($_include_regex) &&
	            $path =~ m!$_include_regex!;
	return 1 if defined($self->{include_regex});
	return 1 if defined($_include_regex);
	return 0 unless defined($_ignore_regex);
	return 1 if $path =~ m!$_ignore_regex!o;
	return 0;
}

sub set_path_strip {
	my ($self, $path) = @_;
	$self->{path_strip} = qr/^\Q$path\E(\/|$)/ if length $path;
}

sub open_root {
	{ path => '' };
}

sub open_directory {
	my ($self, $path, $pb, $rev) = @_;
	{ path => $path };
}

sub git_path {
	my ($self, $path) = @_;
	if (my $enc = $self->{pathnameencoding}) {
		require Encode;
		Encode::from_to($path, 'UTF-8', $enc);
	}
	if ($self->{path_strip}) {
		$path =~ s!$self->{path_strip}!! or
		  die "Failed to strip path '$path' ($self->{path_strip})\n";
	}
	$path;
}

sub delete_entry {
	my ($self, $path, $rev, $pb) = @_;
	return undef if $self->is_path_ignored($path);

	my $gpath = $self->git_path($path);
	return undef if ($gpath eq '');

	# remove entire directories.
	my ($tree) = (command('ls-tree', '-z', $self->{c}, "./$gpath")
	                 =~ /\A040000 tree ([a-f\d]{40})\t\Q$gpath\E\0/);
	if ($tree) {
		my ($ls, $ctx) = command_output_pipe(qw/ls-tree
		                                     -r --name-only -z/,
				                     $tree);
		local $/ = "\0";
		while (<$ls>) {
			chomp;
			my $rmpath = "$gpath/$_";
			$self->{gii}->remove($rmpath);
			print "\tD\t$rmpath\n" unless $::_q;
		}
		print "\tD\t$gpath/\n" unless $::_q;
		command_close_pipe($ls, $ctx);
	} else {
		$self->{gii}->remove($gpath);
		print "\tD\t$gpath\n" unless $::_q;
	}
	# Don't add to @deleted_gpath if we're deleting a placeholder file.
	push @deleted_gpath, $gpath unless $added_placeholder{dirname($path)};
	$self->{empty}->{$path} = 0;
	undef;
}

sub open_file {
	my ($self, $path, $pb, $rev) = @_;
	my ($mode, $blob);

	goto out if $self->is_path_ignored($path);

	my $gpath = $self->git_path($path);
	($mode, $blob) = (command('ls-tree', '-z', $self->{c}, "./$gpath")
	                     =~ /\A(\d{6}) blob ([a-f\d]{40})\t\Q$gpath\E\0/);
	unless (defined $mode && defined $blob) {
		die "$path was not found in commit $self->{c} (r$rev)\n";
	}
	if ($mode eq '100644' && $self->{empty_symlinks}->{$path}) {
		$mode = '120000';
	}
out:
	{ path => $path, mode_a => $mode, mode_b => $mode, blob => $blob,
	  pool => SVN::Pool->new, action => 'M' };
}

sub add_file {
	my ($self, $path, $pb, $cp_path, $cp_rev) = @_;
	my $mode;

	if (!$self->is_path_ignored($path)) {
		my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
		delete $self->{empty}->{$dir};
		$mode = '100644';

		if ($added_placeholder{$dir}) {
			# Remove our placeholder file, if we created one.
			delete_entry($self, $added_placeholder{$dir})
				unless $path eq $added_placeholder{$dir};
			delete $added_placeholder{$dir}
		}
	}

	{ path => $path, mode_a => $mode, mode_b => $mode,
	  pool => SVN::Pool->new, action => 'A' };
}

sub add_directory {
	my ($self, $path, $cp_path, $cp_rev) = @_;
	goto out if $self->is_path_ignored($path);
	my $gpath = $self->git_path($path);
	if ($gpath eq '') {
		my ($ls, $ctx) = command_output_pipe(qw/ls-tree
		                                     -r --name-only -z/,
				                     $self->{c});
		local $/ = "\0";
		while (<$ls>) {
			chomp;
			$self->{gii}->remove($_);
			print "\tD\t$_\n" unless $::_q;
			push @deleted_gpath, $gpath;
		}
		command_close_pipe($ls, $ctx);
		$self->{empty}->{$path} = 0;
	}
	my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
	delete $self->{empty}->{$dir};
	$self->{empty}->{$path} = 1;

	if ($added_placeholder{$dir}) {
		# Remove our placeholder file, if we created one.
		delete_entry($self, $added_placeholder{$dir});
		delete $added_placeholder{$dir}
	}

out:
	{ path => $path };
}

sub change_dir_prop {
	my ($self, $db, $prop, $value) = @_;
	return undef if $self->is_path_ignored($db->{path});
	$self->{dir_prop}->{$db->{path}} ||= {};
	$self->{dir_prop}->{$db->{path}}->{$prop} = $value;
	undef;
}

sub absent_directory {
	my ($self, $path, $pb) = @_;
	return undef if $self->is_path_ignored($path);
	$self->{absent_dir}->{$pb->{path}} ||= [];
	push @{$self->{absent_dir}->{$pb->{path}}}, $path;
	undef;
}

sub absent_file {
	my ($self, $path, $pb) = @_;
	return undef if $self->is_path_ignored($path);
	$self->{absent_file}->{$pb->{path}} ||= [];
	push @{$self->{absent_file}->{$pb->{path}}}, $path;
	undef;
}

sub change_file_prop {
	my ($self, $fb, $prop, $value) = @_;
	return undef if $self->is_path_ignored($fb->{path});
	if ($prop eq 'svn:executable') {
		if ($fb->{mode_b} != 120000) {
			$fb->{mode_b} = defined $value ? 100755 : 100644;
		}
	} elsif ($prop eq 'svn:special') {
		$fb->{mode_b} = defined $value ? 120000 : 100644;
	} else {
		$self->{file_prop}->{$fb->{path}} ||= {};
		$self->{file_prop}->{$fb->{path}}->{$prop} = $value;
	}
	undef;
}

sub apply_textdelta {
	my ($self, $fb, $exp) = @_;
	return undef if $self->is_path_ignored($fb->{path});
	my $fh = $::_repository->temp_acquire('svn_delta');
	# $fh gets auto-closed() by SVN::TxDelta::apply(),
	# (but $base does not,) so dup() it for reading in close_file
	open my $dup, '<&', $fh or croak $!;
	my $base = $::_repository->temp_acquire('git_blob');

	if ($fb->{blob}) {
		my ($base_is_link, $size);

		if ($fb->{mode_a} eq '120000' &&
		    ! $self->{empty_symlinks}->{$fb->{path}}) {
			print $base 'link ' or die "print $!\n";
			$base_is_link = 1;
		}
	retry:
		$size = $::_repository->cat_blob($fb->{blob}, $base);
		die "Failed to read object $fb->{blob}" if ($size < 0);

		if (defined $exp) {
			seek $base, 0, 0 or croak $!;
			my $got = ::md5sum($base);
			if ($got ne $exp) {
				my $err = "Checksum mismatch: ".
				       "$fb->{path} $fb->{blob}\n" .
				       "expected: $exp\n" .
				       "     got: $got\n";
				if ($base_is_link) {
					warn $err,
					     "Retrying... (possibly ",
					     "a bad symlink from SVN)\n";
					$::_repository->temp_reset($base);
					$base_is_link = 0;
					goto retry;
				}
				die $err;
			}
		}
	}
	seek $base, 0, 0 or croak $!;
	$fb->{fh} = $fh;
	$fb->{base} = $base;
	[ SVN::TxDelta::apply($base, $dup, undef, $fb->{path}, $fb->{pool}) ];
}

sub close_file {
	my ($self, $fb, $exp) = @_;
	return undef if $self->is_path_ignored($fb->{path});

	my $hash;
	my $path = $self->git_path($fb->{path});
	if (my $fh = $fb->{fh}) {
		if (defined $exp) {
			seek($fh, 0, 0) or croak $!;
			my $got = ::md5sum($fh);
			if ($got ne $exp) {
				die "Checksum mismatch: $path\n",
				    "expected: $exp\n    got: $got\n";
			}
		}
		if ($fb->{mode_b} == 120000) {
			sysseek($fh, 0, 0) or croak $!;
			my $rd = sysread($fh, my $buf, 5);

			if (!defined $rd) {
				croak "sysread: $!\n";
			} elsif ($rd == 0) {
				warn "$path has mode 120000",
				     " but it points to nothing\n",
				     "converting to an empty file with mode",
				     " 100644\n";
				$fb->{mode_b} = '100644';
			} elsif ($buf ne 'link ') {
				warn "$path has mode 120000",
				     " but is not a link\n";
			} else {
				my $tmp_fh = $::_repository->temp_acquire(
					'svn_hash');
				my $res;
				while ($res = sysread($fh, my $str, 1024)) {
					my $out = syswrite($tmp_fh, $str, $res);
					defined($out) && $out == $res
						or croak("write ",
							Git::temp_path($tmp_fh),
							": $!\n");
				}
				defined $res or croak $!;

				($fh, $tmp_fh) = ($tmp_fh, $fh);
				Git::temp_release($tmp_fh, 1);
			}
		}

		$hash = $::_repository->hash_and_insert_object(
				Git::temp_path($fh));
		$hash =~ /^[a-f\d]{40}$/ or die "not a sha1: $hash\n";

		Git::temp_release($fb->{base}, 1);
		Git::temp_release($fh, 1);
	} else {
		$hash = $fb->{blob} or die "no blob information\n";
	}
	$fb->{pool}->clear;
	$self->{gii}->update($fb->{mode_b}, $hash, $path) or croak $!;
	print "\t$fb->{action}\t$path\n" if $fb->{action} && ! $::_q;
	undef;
}

sub abort_edit {
	my $self = shift;
	$self->{nr} = $self->{gii}->{nr};
	delete $self->{gii};
	$self->SUPER::abort_edit(@_);
}

sub close_edit {
	my $self = shift;

	if ($_preserve_empty_dirs) {
		my @empty_dirs;

		# Any entry flagged as empty that also has an associated
		# dir_prop represents a newly created empty directory.
		foreach my $i (keys %{$self->{empty}}) {
			push @empty_dirs, $i if exists $self->{dir_prop}->{$i};
		}

		# Search for directories that have become empty due subsequent
		# file deletes.
		push @empty_dirs, $self->find_empty_directories();

		# Finally, add a placeholder file to each empty directory.
		$self->add_placeholder_file($_) foreach (@empty_dirs);

		$self->stash_placeholder_list();
	}

	$self->{git_commit_ok} = 1;
	$self->{nr} = $self->{gii}->{nr};
	delete $self->{gii};
	$self->SUPER::close_edit(@_);
}

sub find_empty_directories {
	my ($self) = @_;
	my @empty_dirs;
	my %dirs = map { dirname($_) => 1 } @deleted_gpath;

	foreach my $dir (sort keys %dirs) {
		next if $dir eq ".";

		# If there have been any additions to this directory, there is
		# no reason to check if it is empty.
		my $skip_added = 0;
		foreach my $t (qw/dir_prop file_prop/) {
			foreach my $path (keys %{ $self->{$t} }) {
				if (exists $self->{$t}->{dirname($path)}) {
					$skip_added = 1;
					last;
				}
			}
			last if $skip_added;
		}
		next if $skip_added;

		# Use `git ls-tree` to get the filenames of this directory
		# that existed prior to this particular commit.
		my $ls = command('ls-tree', '-z', '--name-only',
				 $self->{c}, "$dir/");
		my %files = map { $_ => 1 } split(/\0/, $ls);

		# Remove the filenames that were deleted during this commit.
		delete $files{$_} foreach (@deleted_gpath);

		# Report the directory if there are no filenames left.
		push @empty_dirs, $dir unless (scalar %files);
	}
	@empty_dirs;
}

sub add_placeholder_file {
	my ($self, $dir) = @_;
	my $path = "$dir/$_placeholder_filename";
	my $gpath = $self->git_path($path);

	my $fh = $::_repository->temp_acquire($gpath);
	my $hash = $::_repository->hash_and_insert_object(Git::temp_path($fh));
	Git::temp_release($fh, 1);
	$self->{gii}->update('100644', $hash, $gpath) or croak $!;

	# The directory should no longer be considered empty.
	delete $self->{empty}->{$dir} if exists $self->{empty}->{$dir};

	# Keep track of any placeholder files we create.
	$added_placeholder{$dir} = $path;
}

sub stash_placeholder_list {
	my ($self) = @_;
	my $k = "svn-remote.$repo_id.added-placeholder";
	my $v = eval { command_oneline('config', '--get-all', $k) };
	command_noisy('config', '--unset-all', $k) if $v;
	foreach (values %added_placeholder) {
		command_noisy('config', '--add', $k, $_);
	}
}

1;
__END__

=head1 NAME

Git::SVN::Fetcher - tree delta consumer for "git svn fetch"

=head1 SYNOPSIS

    use SVN::Core;
    use SVN::Ra;
    use Git::SVN;
    use Git::SVN::Fetcher;
    use Git;

    my $gs = Git::SVN->find_by_url($url);
    my $ra = SVN::Ra->new(url => $url);
    my $editor = Git::SVN::Fetcher->new($gs);
    my $reporter = $ra->do_update($SVN::Core::INVALID_REVNUM, '',
                                  1, $editor);
    $reporter->set_path('', $old_rev, 0);
    $reporter->finish_report;
    my $tree = $gs->tmp_index_do(sub { command_oneline('write-tree') });

    foreach my $path (keys %{$editor->{dir_prop}) {
        my $props = $editor->{dir_prop}{$path};
        foreach my $prop (keys %$props) {
            print "property $prop at $path changed to $props->{$prop}\n";
        }
    }
    foreach my $path (keys %{$editor->{empty}) {
        my $action = $editor->{empty}{$path} ? 'added' : 'removed';
        print "empty directory $path $action\n";
    }
    foreach my $path (keys %{$editor->{file_prop}) { ... }
    foreach my $parent (keys %{$editor->{absent_dir}}) {
        my @children = @{$editor->{abstent_dir}{$parent}};
        print "cannot fetch directory $parent/$_: not authorized?\n"
            foreach @children;
    }
    foreach my $parent (keys %{$editor->{absent_file}) { ... }

=head1 DESCRIPTION

This is a subclass of C<SVN::Delta::Editor>, which means it implements
callbacks to act as a consumer of Subversion tree deltas.  This
particular implementation of those callbacks is meant to store
information about the resulting content which B<git svn fetch> could
use to populate new commits and new entries for F<unhandled.log>.
More specifically:

=over

=item * Additions, removals, and modifications of files are propagated
to git-svn's index file F<$GIT_DIR/svn/$refname/index> using
B<git update-index>.

=item * Changes in Subversion path properties are recorded in the
C<dir_prop> and C<file_prop> fields (which are hashes).

=item * Addition and removal of empty directories are indicated by
entries with value 1 and 0 respectively in the C<empty> hash.

=item * Paths that are present but cannot be conveyed (presumably due
to permissions) are recorded in the C<absent_file> and
C<absent_dirs> hashes.  For each key, the corresponding value is
a list of paths under that directory that were present but
could not be conveyed.

=back

The interface is unstable.  Do not use this module unless you are
developing git-svn.

=head1 DEPENDENCIES

L<SVN::Delta> from the Subversion perl bindings,
the core L<Carp>, L<File::Basename>, and L<IO::File> modules,
and git's L<Git> helper module.

C<Git::SVN::Fetcher> has not been tested using callers other than
B<git-svn> itself.

=head1 SEE ALSO

L<SVN::Delta>,
L<Git::SVN::Editor>.

=head1 INCOMPATIBILITIES

None reported.

=head1 BUGS

None.
Commit	Line	Data
a6180325	1	package Git::SVN::Fetcher;
a7b10230 PW	2	use vars qw/@ISA $_ignore_regex $_include_regex $_preserve_empty_dirs
	3	$_placeholder_filename @deleted_gpath %added_placeholder
	4	$repo_id/;
a6180325 JN	5	use strict;
	6	use warnings;
	7	use SVN::Delta;
	8	use Carp qw/croak/;
	9	use File::Basename qw/dirname/;
	10	use IO::File qw//;
	11	use Git qw/command command_oneline command_noisy command_output_pipe
	12	command_input_pipe command_close_pipe
	13	command_bidi_pipe command_close_bidi_pipe/;
	14	BEGIN {
	15	@ISA = qw(SVN::Delta::Editor);
	16	}
	17
	18	# file baton members: path, mode_a, mode_b, pool, fh, blob, base
	19	sub new {
	20	my ($class, $git_svn, $switch_path) = @_;
	21	my $self = SVN::Delta::Editor->new;
	22	bless $self, $class;
	23	if (exists $git_svn->{last_commit}) {
	24	$self->{c} = $git_svn->{last_commit};
	25	$self->{empty_symlinks} =
	26	_mark_empty_symlinks($git_svn, $switch_path);
	27	}
	28
	29	# some options are read globally, but can be overridden locally
	30	# per [svn-remote "..."] section. Command-line options will NOT
	31	# override options set in an [svn-remote "..."] section
	32	$repo_id = $git_svn->{repo_id};
	33	my $k = "svn-remote.$repo_id.ignore-paths";
	34	my $v = eval { command_oneline('config', '--get', $k) };
	35	$self->{ignore_regex} = $v;
	36
a7b10230 PW	37	$k = "svn-remote.$repo_id.include-paths";
	38	$v = eval { command_oneline('config', '--get', $k) };
	39	$self->{include_regex} = $v;
	40
a6180325 JN	41	$k = "svn-remote.$repo_id.preserve-empty-dirs";
	42	$v = eval { command_oneline('config', '--get', '--bool', $k) };
	43	if ($v && $v eq 'true') {
	44	$_preserve_empty_dirs = 1;
	45	$k = "svn-remote.$repo_id.placeholder-filename";
	46	$v = eval { command_oneline('config', '--get', $k) };
	47	$_placeholder_filename = $v;
	48	}
	49
	50	# Load the list of placeholder files added during previous invocations.
	51	$k = "svn-remote.$repo_id.added-placeholder";
	52	$v = eval { command_oneline('config', '--get-all', $k) };
	53	if ($_preserve_empty_dirs && $v) {
	54	# command() prints errors to stderr, so we only call it if
	55	# command_oneline() succeeded.
	56	my @v = command('config', '--get-all', $k);
	57	$added_placeholder{ dirname($_) } = $_ foreach @v;
	58	}
	59
	60	$self->{empty} = {};
	61	$self->{dir_prop} = {};
	62	$self->{file_prop} = {};
	63	$self->{absent_dir} = {};
	64	$self->{absent_file} = {};
10c2aa59	65	require Git::IndexInfo;
a6180325 JN	66	$self->{gii} = $git_svn->tmp_index_do(sub { Git::IndexInfo->new });
	67	$self->{pathnameencoding} = Git::config('svn.pathnameencoding');
	68	$self;
	69	}
	70
	71	# this uses the Ra object, so it must be called before do_{switch,update},
	72	# not inside them (when the Git::SVN::Fetcher object is passed) to
	73	# do_{switch,update}
	74	sub _mark_empty_symlinks {
	75	my ($git_svn, $switch_path) = @_;
	76	my $bool = Git::config_bool('svn.brokenSymlinkWorkaround');
	77	return {} if (!defined($bool)) \|\| (defined($bool) && ! $bool);
	78
	79	my %ret;
	80	my ($rev, $cmt) = $git_svn->last_rev_commit;
	81	return {} unless ($rev && $cmt);
	82
	83	# allow the warning to be printed for each revision we fetch to
	84	# ensure the user sees it. The user can also disable the workaround
	85	# on the repository even while git svn is running and the next
	86	# revision fetched will skip this expensive function.
	87	my $printed_warning;
	88	chomp(my $empty_blob = `git hash-object -t blob --stdin < /dev/null`);
	89	my ($ls, $ctx) = command_output_pipe(qw/ls-tree -r -z/, $cmt);
	90	local $/ = "\0";
6a8d999e	91	my $pfx = defined($switch_path) ? $switch_path : $git_svn->path;
a6180325 JN	92	$pfx .= '/' if length($pfx);
	93	while (<$ls>) {
	94	chomp;
	95	s/\A100644 blob $empty_blob\t//o or next;
	96	unless ($printed_warning) {
	97	print STDERR "Scanning for empty symlinks, ",
	98	"this may take a while if you have ",
	99	"many empty files\n",
	100	"You may disable this with `",
	101	"git config svn.brokenSymlinkWorkaround ",
	102	"false'.\n",
	103	"This may be done in a different ",
	104	"terminal without restarting ",
	105	"git svn\n";
	106	$printed_warning = 1;
	107	}
	108	my $path = $_;
	109	my (undef, $props) =
	110	$git_svn->ra->get_file($pfx.$path, $rev, undef);
	111	if ($props->{'svn:special'}) {
	112	$ret{$path} = 1;
	113	}
	114	}
	115	command_close_pipe($ls, $ctx);
	116	\%ret;
	117	}
	118
	119	# returns true if a given path is inside a ".git" directory
	120	sub in_dot_git {
	121	$_[0] =~ m{(?:^\|/)\.git(?:/\|$)};
	122	}
	123
	124	# return value: 0 -- don't ignore, 1 -- ignore
a7b10230	125	# This will also check whether the path is explicitly included
a6180325 JN	126	sub is_path_ignored {
	127	my ($self, $path) = @_;
	128	return 1 if in_dot_git($path);
	129	return 1 if defined($self->{ignore_regex}) &&
	130	$path =~ m!$self->{ignore_regex}!;
a7b10230 PW	131	return 0 if defined($self->{include_regex}) &&
	132	$path =~ m!$self->{include_regex}!;
	133	return 0 if defined($_include_regex) &&
	134	$path =~ m!$_include_regex!;
	135	return 1 if defined($self->{include_regex});
	136	return 1 if defined($_include_regex);
a6180325 JN	137	return 0 unless defined($_ignore_regex);
	138	return 1 if $path =~ m!$_ignore_regex!o;
	139	return 0;
	140	}
	141
	142	sub set_path_strip {
	143	my ($self, $path) = @_;
	144	$self->{path_strip} = qr/^\Q$path\E(\/\|$)/ if length $path;
	145	}
	146
	147	sub open_root {
	148	{ path => '' };
	149	}
	150
	151	sub open_directory {
	152	my ($self, $path, $pb, $rev) = @_;
	153	{ path => $path };
	154	}
	155
	156	sub git_path {
	157	my ($self, $path) = @_;
	158	if (my $enc = $self->{pathnameencoding}) {
	159	require Encode;
	160	Encode::from_to($path, 'UTF-8', $enc);
	161	}
	162	if ($self->{path_strip}) {
	163	$path =~ s!$self->{path_strip}!! or
	164	die "Failed to strip path '$path' ($self->{path_strip})\n";
	165	}
	166	$path;
	167	}
	168
	169	sub delete_entry {
	170	my ($self, $path, $rev, $pb) = @_;
	171	return undef if $self->is_path_ignored($path);
	172
	173	my $gpath = $self->git_path($path);
	174	return undef if ($gpath eq '');
	175
	176	# remove entire directories.
	177	my ($tree) = (command('ls-tree', '-z', $self->{c}, "./$gpath")
	178	=~ /\A040000 tree ([a-f\d]{40})\t\Q$gpath\E\0/);
	179	if ($tree) {
	180	my ($ls, $ctx) = command_output_pipe(qw/ls-tree
	181	-r --name-only -z/,
	182	$tree);
	183	local $/ = "\0";
	184	while (<$ls>) {
	185	chomp;
	186	my $rmpath = "$gpath/$_";
	187	$self->{gii}->remove($rmpath);
	188	print "\tD\t$rmpath\n" unless $::_q;
	189	}
	190	print "\tD\t$gpath/\n" unless $::_q;
	191	command_close_pipe($ls, $ctx);
	192	} else {
	193	$self->{gii}->remove($gpath);
	194	print "\tD\t$gpath\n" unless $::_q;
	195	}
	196	# Don't add to @deleted_gpath if we're deleting a placeholder file.
	197	push @deleted_gpath, $gpath unless $added_placeholder{dirname($path)};
	198	$self->{empty}->{$path} = 0;
	199	undef;
	200	}
201
202	sub open_file {
203	my ($self, $path, $pb, $rev) = @_;
204	my ($mode, $blob);
205
206	goto out if $self->is_path_ignored($path);
207
208	my $gpath = $self->git_path($path);
209	($mode, $blob) = (command('ls-tree', '-z', $self->{c}, "./$gpath")
210	=~ /\A(\d{6}) blob ([a-f\d]{40})\t\Q$gpath\E\0/);
211	unless (defined $mode && defined $blob) {
212	die "$path was not found in commit $self->{c} (r$rev)\n";
213	}
214	if ($mode eq '100644' && $self->{empty_symlinks}->{$path}) {
215	$mode = '120000';
216	}
217	out:
218	{ path => $path, mode_a => $mode, mode_b => $mode, blob => $blob,
219	pool => SVN::Pool->new, action => 'M' };
220	}
221
222	sub add_file {
223	my ($self, $path, $pb, $cp_path, $cp_rev) = @_;
224	my $mode;
225
226	if (!$self->is_path_ignored($path)) {
227	my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
228	delete $self->{empty}->{$dir};
229	$mode = '100644';
230
231	if ($added_placeholder{$dir}) {
232	# Remove our placeholder file, if we created one.
233	delete_entry($self, $added_placeholder{$dir})
234	unless $path eq $added_placeholder{$dir};
235	delete $added_placeholder{$dir}
236	}
237	}
238
239	{ path => $path, mode_a => $mode, mode_b => $mode,
240	pool => SVN::Pool->new, action => 'A' };
241	}
242
243	sub add_directory {
244	my ($self, $path, $cp_path, $cp_rev) = @_;
245	goto out if $self->is_path_ignored($path);
246	my $gpath = $self->git_path($path);
247	if ($gpath eq '') {
248	my ($ls, $ctx) = command_output_pipe(qw/ls-tree
249	-r --name-only -z/,
250	$self->{c});
251	local $/ = "\0";
252	while (<$ls>) {
253	chomp;
254	$self->{gii}->remove($_);
255	print "\tD\t$_\n" unless $::_q;
256	push @deleted_gpath, $gpath;
257	}
258	command_close_pipe($ls, $ctx);
259	$self->{empty}->{$path} = 0;
260	}
261	my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
262	delete $self->{empty}->{$dir};
263	$self->{empty}->{$path} = 1;
264
265	if ($added_placeholder{$dir}) {
266	# Remove our placeholder file, if we created one.
267	delete_entry($self, $added_placeholder{$dir});
268	delete $added_placeholder{$dir}
269	}
270
271	out:
272	{ path => $path };
273	}
274
275	sub change_dir_prop {
276	my ($self, $db, $prop, $value) = @_;
277	return undef if $self->is_path_ignored($db->{path});
278	$self->{dir_prop}->{$db->{path}} \|\|= {};
279	$self->{dir_prop}->{$db->{path}}->{$prop} = $value;
280	undef;
281	}
282
283	sub absent_directory {
284	my ($self, $path, $pb) = @_;
285	return undef if $self->is_path_ignored($path);
286	$self->{absent_dir}->{$pb->{path}} \|\|= [];
287	push @{$self->{absent_dir}->{$pb->{path}}}, $path;
288	undef;
289	}
290
291	sub absent_file {
292	my ($self, $path, $pb) = @_;
293	return undef if $self->is_path_ignored($path);
294	$self->{absent_file}->{$pb->{path}} \|\|= [];
295	push @{$self->{absent_file}->{$pb->{path}}}, $path;
296	undef;
297	}
298
299	sub change_file_prop {
300	my ($self, $fb, $prop, $value) = @_;
301	return undef if $self->is_path_ignored($fb->{path});
302	if ($prop eq 'svn:executable') {
303	if ($fb->{mode_b} != 120000) {
304	$fb->{mode_b} = defined $value ? 100755 : 100644;
305	}
306	} elsif ($prop eq 'svn:special') {
307	$fb->{mode_b} = defined $value ? 120000 : 100644;
308	} else {
309	$self->{file_prop}->{$fb->{path}} \|\|= {};
310	$self->{file_prop}->{$fb->{path}}->{$prop} = $value;
311	}
312	undef;
313	}
314
315	sub apply_textdelta {
316	my ($self, $fb, $exp) = @_;
317	return undef if $self->is_path_ignored($fb->{path});
318	my $fh = $::_repository->temp_acquire('svn_delta');
319	# $fh gets auto-closed() by SVN::TxDelta::apply(),
320	# (but $base does not,) so dup() it for reading in close_file
321	open my $dup, '<&', $fh or croak $!;
322	my $base = $::_repository->temp_acquire('git_blob');
323
324	if ($fb->{blob}) {
325	my ($base_is_link, $size);
326
327	if ($fb->{mode_a} eq '120000' &&
328	! $self->{empty_symlinks}->{$fb->{path}}) {
329	print $base 'link ' or die "print $!\n";
330	$base_is_link = 1;
331	}
332	retry:
333	$size = $::_repository->cat_blob($fb->{blob}, $base);
334	die "Failed to read object $fb->{blob}" if ($size < 0);
335
336	if (defined $exp) {
337	seek $base, 0, 0 or croak $!;
338	my $got = ::md5sum($base);
339	if ($got ne $exp) {
340	my $err = "Checksum mismatch: ".
341	"$fb->{path} $fb->{blob}\n" .
342	"expected: $exp\n" .
343	" got: $got\n";
344	if ($base_is_link) {
345	warn $err,
346	"Retrying... (possibly ",
347	"a bad symlink from SVN)\n";
348	$::_repository->temp_reset($base);
349	$base_is_link = 0;
350	goto retry;
351	}
352	die $err;
353	}
354	}
355	}
356	seek $base, 0, 0 or croak $!;
357	$fb->{fh} = $fh;
358	$fb->{base} = $base;
359	[ SVN::TxDelta::apply($base, $dup, undef, $fb->{path}, $fb->{pool}) ];
360	}
361
362	sub close_file {
363	my ($self, $fb, $exp) = @_;
364	return undef if $self->is_path_ignored($fb->{path});
365
366	my $hash;
367	my $path = $self->git_path($fb->{path});
368	if (my $fh = $fb->{fh}) {
369	if (defined $exp) {
370	seek($fh, 0, 0) or croak $!;
371	my $got = ::md5sum($fh);
372	if ($got ne $exp) {
373	die "Checksum mismatch: $path\n",
374	"expected: $exp\n got: $got\n";
375	}
376	}
377	if ($fb->{mode_b} == 120000) {
378	sysseek($fh, 0, 0) or croak $!;
379	my $rd = sysread($fh, my $buf, 5);
380
381	if (!defined $rd) {
382	croak "sysread: $!\n";
383	} elsif ($rd == 0) {
384	warn "$path has mode 120000",
385	" but it points to nothing\n",
386	"converting to an empty file with mode",
387	" 100644\n";
388	$fb->{mode_b} = '100644';
389	} elsif ($buf ne 'link ') {
390	warn "$path has mode 120000",
391	" but is not a link\n";
392	} else {
393	my $tmp_fh = $::_repository->temp_acquire(
394	'svn_hash');
395	my $res;
396	while ($res = sysread($fh, my $str, 1024)) {
397	my $out = syswrite($tmp_fh, $str, $res);
398	defined($out) && $out == $res
399	or croak("write ",
400	Git::temp_path($tmp_fh),
401	": $!\n");
402	}
403	defined $res or croak $!;
404
405	($fh, $tmp_fh) = ($tmp_fh, $fh);
406	Git::temp_release($tmp_fh, 1);
407	}
408	}
409
410	$hash = $::_repository->hash_and_insert_object(
411	Git::temp_path($fh));
412	$hash =~ /^[a-f\d]{40}$/ or die "not a sha1: $hash\n";
413
414	Git::temp_release($fb->{base}, 1);
415	Git::temp_release($fh, 1);
416	} else {
417	$hash = $fb->{blob} or die "no blob information\n";
418	}
419	$fb->{pool}->clear;
420	$self->{gii}->update($fb->{mode_b}, $hash, $path) or croak $!;
421	print "\t$fb->{action}\t$path\n" if $fb->{action} && ! $::_q;
422	undef;
423	}
424
425	sub abort_edit {
426	my $self = shift;
427	$self->{nr} = $self->{gii}->{nr};
428	delete $self->{gii};
429	$self->SUPER::abort_edit(@_);
430	}
431
432	sub close_edit {
433	my $self = shift;
434
435	if ($_preserve_empty_dirs) {
436	my @empty_dirs;
437
438	# Any entry flagged as empty that also has an associated
439	# dir_prop represents a newly created empty directory.
440	foreach my $i (keys %{$self->{empty}}) {
441	push @empty_dirs, $i if exists $self->{dir_prop}->{$i};
442	}
443
444	# Search for directories that have become empty due subsequent
445	# file deletes.
446	push @empty_dirs, $self->find_empty_directories();
447
448	# Finally, add a placeholder file to each empty directory.
449	$self->add_placeholder_file($_) foreach (@empty_dirs);
450
451	$self->stash_placeholder_list();
452	}
453
454	$self->{git_commit_ok} = 1;
455	$self->{nr} = $self->{gii}->{nr};
456	delete $self->{gii};
457	$self->SUPER::close_edit(@_);
458	}
459
460	sub find_empty_directories {
461	my ($self) = @_;
462	my @empty_dirs;
463	my %dirs = map { dirname($_) => 1 } @deleted_gpath;
464
465	foreach my $dir (sort keys %dirs) {
466	next if $dir eq ".";
467
468	# If there have been any additions to this directory, there is
469	# no reason to check if it is empty.
470	my $skip_added = 0;
471	foreach my $t (qw/dir_prop file_prop/) {
472	foreach my $path (keys %{ $self->{$t} }) {
473	if (exists $self->{$t}->{dirname($path)}) {
474	$skip_added = 1;
475	last;
476	}
477	}
478	last if $skip_added;
479	}
480	next if $skip_added;
481
482	# Use `git ls-tree` to get the filenames of this directory
483	# that existed prior to this particular commit.
484	my $ls = command('ls-tree', '-z', '--name-only',
485	$self->{c}, "$dir/");
486	my %files = map { $_ => 1 } split(/\0/, $ls);
487
488	# Remove the filenames that were deleted during this commit.
489	delete $files{$_} foreach (@deleted_gpath);
490
491	# Report the directory if there are no filenames left.
492	push @empty_dirs, $dir unless (scalar %files);
493	}
494	@empty_dirs;
495	}
496
497	sub add_placeholder_file {
498	my ($self, $dir) = @_;
499	my $path = "$dir/$_placeholder_filename";
500	my $gpath = $self->git_path($path);
501
502	my $fh = $::_repository->temp_acquire($gpath);
503	my $hash = $::_repository->hash_and_insert_object(Git::temp_path($fh));
504	Git::temp_release($fh, 1);
505	$self->{gii}->update('100644', $hash, $gpath) or croak $!;
506
507	# The directory should no longer be considered empty.
508	delete $self->{empty}->{$dir} if exists $self->{empty}->{$dir};
509
510	# Keep track of any placeholder files we create.
511	$added_placeholder{$dir} = $path;
512	}
513
514	sub stash_placeholder_list {
515	my ($self) = @_;
516	my $k = "svn-remote.$repo_id.added-placeholder";
517	my $v = eval { command_oneline('config', '--get-all', $k) };
518	command_noisy('config', '--unset-all', $k) if $v;
519	foreach (values %added_placeholder) {
520	command_noisy('config', '--add', $k, $_);
521	}
522	}
523
524	1;
525	__END__
526
d301f181 JN	527	=head1 NAME
d301f181 JN	528
a6180325 JN	529	Git::SVN::Fetcher - tree delta consumer for "git svn fetch"
	530
	531	=head1 SYNOPSIS
	532
	533	use SVN::Core;
	534	use SVN::Ra;
	535	use Git::SVN;
	536	use Git::SVN::Fetcher;
	537	use Git;
	538
	539	my $gs = Git::SVN->find_by_url($url);
	540	my $ra = SVN::Ra->new(url => $url);
	541	my $editor = Git::SVN::Fetcher->new($gs);
	542	my $reporter = $ra->do_update($SVN::Core::INVALID_REVNUM, '',
	543	1, $editor);
	544	$reporter->set_path('', $old_rev, 0);
	545	$reporter->finish_report;
	546	my $tree = $gs->tmp_index_do(sub { command_oneline('write-tree') });
	547
	548	foreach my $path (keys %{$editor->{dir_prop}) {
	549	my $props = $editor->{dir_prop}{$path};
	550	foreach my $prop (keys %$props) {
	551	print "property $prop at $path changed to $props->{$prop}\n";
	552	}
	553	}
	554	foreach my $path (keys %{$editor->{empty}) {
	555	my $action = $editor->{empty}{$path} ? 'added' : 'removed';
	556	print "empty directory $path $action\n";
	557	}
	558	foreach my $path (keys %{$editor->{file_prop}) { ... }
	559	foreach my $parent (keys %{$editor->{absent_dir}}) {
	560	my @children = @{$editor->{abstent_dir}{$parent}};
	561	print "cannot fetch directory $parent/$_: not authorized?\n"
	562	foreach @children;
	563	}
	564	foreach my $parent (keys %{$editor->{absent_file}) { ... }
	565
	566	=head1 DESCRIPTION
	567
	568	This is a subclass of C<SVN::Delta::Editor>, which means it implements
	569	callbacks to act as a consumer of Subversion tree deltas. This
	570	particular implementation of those callbacks is meant to store
	571	information about the resulting content which B<git svn fetch> could
	572	use to populate new commits and new entries for F<unhandled.log>.
	573	More specifically:
	574
	575	=over
	576
	577	=item * Additions, removals, and modifications of files are propagated
	578	to git-svn's index file F<$GIT_DIR/svn/$refname/index> using
	579	B<git update-index>.
	580
	581	=item * Changes in Subversion path properties are recorded in the
	582	C<dir_prop> and C<file_prop> fields (which are hashes).
	583
	584	=item * Addition and removal of empty directories are indicated by
	585	entries with value 1 and 0 respectively in the C<empty> hash.
	586
	587	=item * Paths that are present but cannot be conveyed (presumably due
	588	to permissions) are recorded in the C<absent_file> and
	589	C<absent_dirs> hashes. For each key, the corresponding value is
	590	a list of paths under that directory that were present but
	591	could not be conveyed.
	592
593	=back
594
595	The interface is unstable. Do not use this module unless you are
596	developing git-svn.
597
598	=head1 DEPENDENCIES
599
600	L<SVN::Delta> from the Subversion perl bindings,
601	the core L<Carp>, L<File::Basename>, and L<IO::File> modules,
602	and git's L<Git> helper module.
603
604	C<Git::SVN::Fetcher> has not been tested using callers other than
605	B<git-svn> itself.
606
607	=head1 SEE ALSO
608
8f9facfe JN	609	L<SVN::Delta>,
8f9facfe JN	610	L<Git::SVN::Editor>.
a6180325 JN	611
	612	=head1 INCOMPATIBILITIES
	613
	614	None reported.
	615
	616	=head1 BUGS
	617
	618	None.