git@vger.kernel.org mailing list mirror (one of many)
 help / color / mirror / code / Atom feed
From: Jonathan Nieder <jrnieder@gmail.com>
To: Eric Wong <normalperson@yhbt.net>
Cc: Junio C Hamano <gitster@pobox.com>, Jason Gross <jgross@MIT.EDU>,
	git@vger.kernel.org
Subject: [PATCH 1/3] git-svn: make Git::SVN::Editor a separate file
Date: Sat, 9 Jun 2012 17:25:56 -0500	[thread overview]
Message-ID: <20120609222556.GE28412@burratino> (raw)
In-Reply-To: <20120609222039.GD28412@burratino>

This makes the git-svn script shorter and less scary for beginners to
read through for the first time.  Take the opportunity to explain the
purpose and basic interface of the Git::SVN::Editor class while at it.

Signed-off-by: Jonathan Nieder <jrnieder@gmail.com>
---
 git-svn.perl            |  472 +----------------------------------------
 perl/Git/SVN/Editor.pm  |  536 +++++++++++++++++++++++++++++++++++++++++++++++
 perl/Git/SVN/Fetcher.pm |    3 +-
 perl/Makefile.PL        |    1 +
 4 files changed, 541 insertions(+), 471 deletions(-)
 create mode 100644 perl/Git/SVN/Editor.pm

diff --git a/git-svn.perl b/git-svn.perl
index 7870cc15..7cec4416 100755
--- a/git-svn.perl
+++ b/git-svn.perl
@@ -68,7 +68,6 @@ sub _req_svn {
 }
 my $can_compress = eval { require Compress::Zlib; 1};
 push @Git::SVN::Ra::ISA, 'SVN::Ra';
-push @Git::SVN::Editor::ISA, 'SVN::Delta::Editor';
 use Carp qw/croak/;
 use Digest::MD5;
 use IO::File qw//;
@@ -79,6 +78,7 @@ use File::Find;
 use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/;
 use IPC::Open3;
 use Git;
+use Git::SVN::Editor qw//;
 use Git::SVN::Fetcher qw//;
 use Git::SVN::Prompt qw//;
 use Memoize;  # core since 5.8.0, Jul 2002
@@ -89,8 +89,7 @@ BEGIN {
 	foreach (qw/command command_oneline command_noisy command_output_pipe
 	            command_input_pipe command_close_pipe
 	            command_bidi_pipe command_close_bidi_pipe/) {
-		for my $package ( qw(Git::SVN::Editor
-			Git::SVN::Migration Git::SVN::Log Git::SVN),
+		for my $package ( qw(Git::SVN::Migration Git::SVN::Log Git::SVN),
 			__PACKAGE__) {
 			*{"${package}::$_"} = \&{"Git::$_"};
 		}
@@ -1066,7 +1065,6 @@ sub cmd_branch {
 		            " with the --destination argument.\n";
 		}
 		foreach my $g (@{$allglobs}) {
-			# Git::SVN::Editor could probably be moved to Git.pm..
 			my $re = Git::SVN::Editor::glob2pat($g->{path}->{left});
 			if ($_branch_dest =~ /$re/) {
 				$glob = $g;
@@ -4328,472 +4326,6 @@ sub remove_username {
 	$_[0] =~ s{^([^:]*://)[^@]+@}{$1};
 }
 
-package Git::SVN::Editor;
-use vars qw/@ISA $_rmdir $_cp_similarity $_find_copies_harder $_rename_limit/;
-use strict;
-use warnings;
-use Carp qw/croak/;
-use IO::File;
-
-sub new {
-	my ($class, $opts) = @_;
-	foreach (qw/svn_path r ra tree_a tree_b log editor_cb/) {
-		die "$_ required!\n" unless (defined $opts->{$_});
-	}
-
-	my $pool = SVN::Pool->new;
-	my $mods = generate_diff($opts->{tree_a}, $opts->{tree_b});
-	my $types = check_diff_paths($opts->{ra}, $opts->{svn_path},
-	                             $opts->{r}, $mods);
-
-	# $opts->{ra} functions should not be used after this:
-	my @ce  = $opts->{ra}->get_commit_editor($opts->{log},
-	                                        $opts->{editor_cb}, $pool);
-	my $self = SVN::Delta::Editor->new(@ce, $pool);
-	bless $self, $class;
-	foreach (qw/svn_path r tree_a tree_b/) {
-		$self->{$_} = $opts->{$_};
-	}
-	$self->{url} = $opts->{ra}->{url};
-	$self->{mods} = $mods;
-	$self->{types} = $types;
-	$self->{pool} = $pool;
-	$self->{bat} = { '' => $self->open_root($self->{r}, $self->{pool}) };
-	$self->{rm} = { };
-	$self->{path_prefix} = length $self->{svn_path} ?
-	                       "$self->{svn_path}/" : '';
-	$self->{config} = $opts->{config};
-	$self->{mergeinfo} = $opts->{mergeinfo};
-	return $self;
-}
-
-sub generate_diff {
-	my ($tree_a, $tree_b) = @_;
-	my @diff_tree = qw(diff-tree -z -r);
-	if ($_cp_similarity) {
-		push @diff_tree, "-C$_cp_similarity";
-	} else {
-		push @diff_tree, '-C';
-	}
-	push @diff_tree, '--find-copies-harder' if $_find_copies_harder;
-	push @diff_tree, "-l$_rename_limit" if defined $_rename_limit;
-	push @diff_tree, $tree_a, $tree_b;
-	my ($diff_fh, $ctx) = command_output_pipe(@diff_tree);
-	local $/ = "\0";
-	my $state = 'meta';
-	my @mods;
-	while (<$diff_fh>) {
-		chomp $_; # this gets rid of the trailing "\0"
-		if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s
-					($::sha1)\s($::sha1)\s
-					([MTCRAD])\d*$/xo) {
-			push @mods, {	mode_a => $1, mode_b => $2,
-					sha1_a => $3, sha1_b => $4,
-					chg => $5 };
-			if ($5 =~ /^(?:C|R)$/) {
-				$state = 'file_a';
-			} else {
-				$state = 'file_b';
-			}
-		} elsif ($state eq 'file_a') {
-			my $x = $mods[$#mods] or croak "Empty array\n";
-			if ($x->{chg} !~ /^(?:C|R)$/) {
-				croak "Error parsing $_, $x->{chg}\n";
-			}
-			$x->{file_a} = $_;
-			$state = 'file_b';
-		} elsif ($state eq 'file_b') {
-			my $x = $mods[$#mods] or croak "Empty array\n";
-			if (exists $x->{file_a} && $x->{chg} !~ /^(?:C|R)$/) {
-				croak "Error parsing $_, $x->{chg}\n";
-			}
-			if (!exists $x->{file_a} && $x->{chg} =~ /^(?:C|R)$/) {
-				croak "Error parsing $_, $x->{chg}\n";
-			}
-			$x->{file_b} = $_;
-			$state = 'meta';
-		} else {
-			croak "Error parsing $_\n";
-		}
-	}
-	command_close_pipe($diff_fh, $ctx);
-	\@mods;
-}
-
-sub check_diff_paths {
-	my ($ra, $pfx, $rev, $mods) = @_;
-	my %types;
-	$pfx .= '/' if length $pfx;
-
-	sub type_diff_paths {
-		my ($ra, $types, $path, $rev) = @_;
-		my @p = split m#/+#, $path;
-		my $c = shift @p;
-		unless (defined $types->{$c}) {
-			$types->{$c} = $ra->check_path($c, $rev);
-		}
-		while (@p) {
-			$c .= '/' . shift @p;
-			next if defined $types->{$c};
-			$types->{$c} = $ra->check_path($c, $rev);
-		}
-	}
-
-	foreach my $m (@$mods) {
-		foreach my $f (qw/file_a file_b/) {
-			next unless defined $m->{$f};
-			my ($dir) = ($m->{$f} =~ m#^(.*?)/?(?:[^/]+)$#);
-			if (length $pfx.$dir && ! defined $types{$dir}) {
-				type_diff_paths($ra, \%types, $pfx.$dir, $rev);
-			}
-		}
-	}
-	\%types;
-}
-
-sub split_path {
-	return ($_[0] =~ m#^(.*?)/?([^/]+)$#);
-}
-
-sub repo_path {
-	my ($self, $path) = @_;
-	if (my $enc = $self->{pathnameencoding}) {
-		require Encode;
-		Encode::from_to($path, $enc, 'UTF-8');
-	}
-	$self->{path_prefix}.(defined $path ? $path : '');
-}
-
-sub url_path {
-	my ($self, $path) = @_;
-	if ($self->{url} =~ m#^https?://#) {
-		$path =~ s!([^~a-zA-Z0-9_./-])!uc sprintf("%%%02x",ord($1))!eg;
-	}
-	$self->{url} . '/' . $self->repo_path($path);
-}
-
-sub rmdirs {
-	my ($self) = @_;
-	my $rm = $self->{rm};
-	delete $rm->{''}; # we never delete the url we're tracking
-	return unless %$rm;
-
-	foreach (keys %$rm) {
-		my @d = split m#/#, $_;
-		my $c = shift @d;
-		$rm->{$c} = 1;
-		while (@d) {
-			$c .= '/' . shift @d;
-			$rm->{$c} = 1;
-		}
-	}
-	delete $rm->{$self->{svn_path}};
-	delete $rm->{''}; # we never delete the url we're tracking
-	return unless %$rm;
-
-	my ($fh, $ctx) = command_output_pipe(qw/ls-tree --name-only -r -z/,
-	                                     $self->{tree_b});
-	local $/ = "\0";
-	while (<$fh>) {
-		chomp;
-		my @dn = split m#/#, $_;
-		while (pop @dn) {
-			delete $rm->{join '/', @dn};
-		}
-		unless (%$rm) {
-			close $fh;
-			return;
-		}
-	}
-	command_close_pipe($fh, $ctx);
-
-	my ($r, $p, $bat) = ($self->{r}, $self->{pool}, $self->{bat});
-	foreach my $d (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$rm) {
-		$self->close_directory($bat->{$d}, $p);
-		my ($dn) = ($d =~ m#^(.*?)/?(?:[^/]+)$#);
-		print "\tD+\t$d/\n" unless $::_q;
-		$self->SUPER::delete_entry($d, $r, $bat->{$dn}, $p);
-		delete $bat->{$d};
-	}
-}
-
-sub open_or_add_dir {
-	my ($self, $full_path, $baton, $deletions) = @_;
-	my $t = $self->{types}->{$full_path};
-	if (!defined $t) {
-		die "$full_path not known in r$self->{r} or we have a bug!\n";
-	}
-	{
-		no warnings 'once';
-		# SVN::Node::none and SVN::Node::file are used only once,
-		# so we're shutting up Perl's warnings about them.
-		if ($t == $SVN::Node::none || defined($deletions->{$full_path})) {
-			return $self->add_directory($full_path, $baton,
-			    undef, -1, $self->{pool});
-		} elsif ($t == $SVN::Node::dir) {
-			return $self->open_directory($full_path, $baton,
-			    $self->{r}, $self->{pool});
-		} # no warnings 'once'
-		print STDERR "$full_path already exists in repository at ",
-		    "r$self->{r} and it is not a directory (",
-		    ($t == $SVN::Node::file ? 'file' : 'unknown'),"/$t)\n";
-	} # no warnings 'once'
-	exit 1;
-}
-
-sub ensure_path {
-	my ($self, $path, $deletions) = @_;
-	my $bat = $self->{bat};
-	my $repo_path = $self->repo_path($path);
-	return $bat->{''} unless (length $repo_path);
-
-	my @p = split m#/+#, $repo_path;
-	my $c = shift @p;
-	$bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''}, $deletions);
-	while (@p) {
-		my $c0 = $c;
-		$c .= '/' . shift @p;
-		$bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0}, $deletions);
-	}
-	return $bat->{$c};
-}
-
-# Subroutine to convert a globbing pattern to a regular expression.
-# From perl cookbook.
-sub glob2pat {
-	my $globstr = shift;
-	my %patmap = ('*' => '.*', '?' => '.', '[' => '[', ']' => ']');
-	$globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;
-	return '^' . $globstr . '$';
-}
-
-sub check_autoprop {
-	my ($self, $pattern, $properties, $file, $fbat) = @_;
-	# Convert the globbing pattern to a regular expression.
-	my $regex = glob2pat($pattern);
-	# Check if the pattern matches the file name.
-	if($file =~ m/($regex)/) {
-		# Parse the list of properties to set.
-		my @props = split(/;/, $properties);
-		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+$//;
-				}
-				$self->change_file_prop($fbat, $n, $v);
-			}
-		}
-	}
-}
-
-sub apply_autoprops {
-	my ($self, $file, $fbat) = @_;
-	my $conf_t = ${$self->{config}}{'config'};
-	no warnings 'once';
-	# Check [miscellany]/enable-auto-props in svn configuration.
-	if (SVN::_Core::svn_config_get_bool(
-		$conf_t,
-		$SVN::_Core::SVN_CONFIG_SECTION_MISCELLANY,
-		$SVN::_Core::SVN_CONFIG_OPTION_ENABLE_AUTO_PROPS,
-		0)) {
-		# Auto-props are enabled.  Enumerate them to look for matches.
-		my $callback = sub {
-			$self->check_autoprop($_[0], $_[1], $file, $fbat);
-		};
-		SVN::_Core::svn_config_enumerate(
-			$conf_t,
-			$SVN::_Core::SVN_CONFIG_SECTION_AUTO_PROPS,
-			$callback);
-	}
-}
-
-sub A {
-	my ($self, $m, $deletions) = @_;
-	my ($dir, $file) = split_path($m->{file_b});
-	my $pbat = $self->ensure_path($dir, $deletions);
-	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
-					undef, -1);
-	print "\tA\t$m->{file_b}\n" unless $::_q;
-	$self->apply_autoprops($file, $fbat);
-	$self->chg_file($fbat, $m);
-	$self->close_file($fbat,undef,$self->{pool});
-}
-
-sub C {
-	my ($self, $m, $deletions) = @_;
-	my ($dir, $file) = split_path($m->{file_b});
-	my $pbat = $self->ensure_path($dir, $deletions);
-	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
-				$self->url_path($m->{file_a}), $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});
-}
-
-sub delete_entry {
-	my ($self, $path, $pbat) = @_;
-	my $rpath = $self->repo_path($path);
-	my ($dir, $file) = split_path($rpath);
-	$self->{rm}->{$dir} = 1;
-	$self->SUPER::delete_entry($rpath, $self->{r}, $pbat, $self->{pool});
-}
-
-sub R {
-	my ($self, $m, $deletions) = @_;
-	my ($dir, $file) = split_path($m->{file_b});
-	my $pbat = $self->ensure_path($dir, $deletions);
-	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
-				$self->url_path($m->{file_a}), $self->{r});
-	print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
-	$self->apply_autoprops($file, $fbat);
-	$self->chg_file($fbat, $m);
-	$self->close_file($fbat,undef,$self->{pool});
-
-	($dir, $file) = split_path($m->{file_a});
-	$pbat = $self->ensure_path($dir, $deletions);
-	$self->delete_entry($m->{file_a}, $pbat);
-}
-
-sub M {
-	my ($self, $m, $deletions) = @_;
-	my ($dir, $file) = split_path($m->{file_b});
-	my $pbat = $self->ensure_path($dir, $deletions);
-	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->chg_file($fbat, $m);
-	$self->close_file($fbat,undef,$self->{pool});
-}
-
-sub T { shift->M(@_) }
-
-sub change_file_prop {
-	my ($self, $fbat, $pname, $pval) = @_;
-	$self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool});
-}
-
-sub change_dir_prop {
-	my ($self, $pbat, $pname, $pval) = @_;
-	$self->SUPER::change_dir_prop($pbat, $pname, $pval, $self->{pool});
-}
-
-sub _chg_file_get_blob ($$$$) {
-	my ($self, $fbat, $m, $which) = @_;
-	my $fh = $::_repository->temp_acquire("git_blob_$which");
-	if ($m->{"mode_$which"} =~ /^120/) {
-		print $fh 'link ' or croak $!;
-		$self->change_file_prop($fbat,'svn:special','*');
-	} elsif ($m->{mode_a} =~ /^120/ && $m->{"mode_$which"} !~ /^120/) {
-		$self->change_file_prop($fbat,'svn:special',undef);
-	}
-	my $blob = $m->{"sha1_$which"};
-	return ($fh,) if ($blob =~ /^0{40}$/);
-	my $size = $::_repository->cat_blob($blob, $fh);
-	croak "Failed to read object $blob" if ($size < 0);
-	$fh->flush == 0 or croak $!;
-	seek $fh, 0, 0 or croak $!;
-
-	my $exp = ::md5sum($fh);
-	seek $fh, 0, 0 or croak $!;
-	return ($fh, $exp);
-}
-
-sub chg_file {
-	my ($self, $fbat, $m) = @_;
-	if ($m->{mode_b} =~ /755$/ && $m->{mode_a} !~ /755$/) {
-		$self->change_file_prop($fbat,'svn:executable','*');
-	} elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
-		$self->change_file_prop($fbat,'svn:executable',undef);
-	}
-	my ($fh_a, $exp_a) = _chg_file_get_blob $self, $fbat, $m, 'a';
-	my ($fh_b, $exp_b) = _chg_file_get_blob $self, $fbat, $m, 'b';
-	my $pool = SVN::Pool->new;
-	my $atd = $self->apply_textdelta($fbat, $exp_a, $pool);
-	if (-s $fh_a) {
-		my $txstream = SVN::TxDelta::new ($fh_a, $fh_b, $pool);
-		my $res = SVN::TxDelta::send_txstream($txstream, @$atd, $pool);
-		if (defined $res) {
-			die "Unexpected result from send_txstream: $res\n",
-			    "(SVN::Core::VERSION: $SVN::Core::VERSION)\n";
-		}
-	} else {
-		my $got = SVN::TxDelta::send_stream($fh_b, @$atd, $pool);
-		die "Checksum mismatch\nexpected: $exp_b\ngot: $got\n"
-		    if ($got ne $exp_b);
-	}
-	Git::temp_release($fh_b, 1);
-	Git::temp_release($fh_a, 1);
-	$pool->clear;
-}
-
-sub D {
-	my ($self, $m, $deletions) = @_;
-	my ($dir, $file) = split_path($m->{file_b});
-	my $pbat = $self->ensure_path($dir, $deletions);
-	print "\tD\t$m->{file_b}\n" unless $::_q;
-	$self->delete_entry($m->{file_b}, $pbat);
-}
-
-sub close_edit {
-	my ($self) = @_;
-	my ($p,$bat) = ($self->{pool}, $self->{bat});
-	foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) {
-		next if $_ eq '';
-		$self->close_directory($bat->{$_}, $p);
-	}
-	$self->close_directory($bat->{''}, $p);
-	$self->SUPER::close_edit($p);
-	$p->clear;
-}
-
-sub abort_edit {
-	my ($self) = @_;
-	$self->SUPER::abort_edit($self->{pool});
-}
-
-sub DESTROY {
-	my $self = shift;
-	$self->SUPER::DESTROY(@_);
-	$self->{pool}->clear;
-}
-
-# this drives the editor
-sub apply_diff {
-	my ($self) = @_;
-	my $mods = $self->{mods};
-	my %o = ( D => 0, C => 1, R => 2, A => 3, M => 4, T => 5 );
-	my %deletions;
-
-	foreach my $m (@$mods) {
-		if ($m->{chg} eq "D") {
-			$deletions{$m->{file_b}} = 1;
-		}
-	}
-
-	foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
-		my $f = $m->{chg};
-		if (defined $o{$f}) {
-			$self->$f($m, \%deletions);
-		} else {
-			fatal("Invalid change type: $f");
-		}
-	}
-
-	if (defined($self->{mergeinfo})) {
-		$self->change_dir_prop($self->{bat}{''}, "svn:mergeinfo",
-			               $self->{mergeinfo});
-	}
-	$self->rmdirs if $_rmdir;
-	if (@$mods == 0 && !defined($self->{mergeinfo})) {
-		$self->abort_edit;
-	} else {
-		$self->close_edit;
-	}
-	return scalar @$mods;
-}
-
 package Git::SVN::Ra;
 use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/;
 use strict;
diff --git a/perl/Git/SVN/Editor.pm b/perl/Git/SVN/Editor.pm
new file mode 100644
index 00000000..755092fd
--- /dev/null
+++ b/perl/Git/SVN/Editor.pm
@@ -0,0 +1,536 @@
+package Git::SVN::Editor;
+use vars qw/@ISA $_rmdir $_cp_similarity $_find_copies_harder $_rename_limit/;
+use strict;
+use warnings;
+use SVN::Core;
+use SVN::Delta;
+use Carp qw/croak/;
+use IO::File;
+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);
+}
+
+sub new {
+	my ($class, $opts) = @_;
+	foreach (qw/svn_path r ra tree_a tree_b log editor_cb/) {
+		die "$_ required!\n" unless (defined $opts->{$_});
+	}
+
+	my $pool = SVN::Pool->new;
+	my $mods = generate_diff($opts->{tree_a}, $opts->{tree_b});
+	my $types = check_diff_paths($opts->{ra}, $opts->{svn_path},
+	                             $opts->{r}, $mods);
+
+	# $opts->{ra} functions should not be used after this:
+	my @ce  = $opts->{ra}->get_commit_editor($opts->{log},
+	                                        $opts->{editor_cb}, $pool);
+	my $self = SVN::Delta::Editor->new(@ce, $pool);
+	bless $self, $class;
+	foreach (qw/svn_path r tree_a tree_b/) {
+		$self->{$_} = $opts->{$_};
+	}
+	$self->{url} = $opts->{ra}->{url};
+	$self->{mods} = $mods;
+	$self->{types} = $types;
+	$self->{pool} = $pool;
+	$self->{bat} = { '' => $self->open_root($self->{r}, $self->{pool}) };
+	$self->{rm} = { };
+	$self->{path_prefix} = length $self->{svn_path} ?
+	                       "$self->{svn_path}/" : '';
+	$self->{config} = $opts->{config};
+	$self->{mergeinfo} = $opts->{mergeinfo};
+	return $self;
+}
+
+sub generate_diff {
+	my ($tree_a, $tree_b) = @_;
+	my @diff_tree = qw(diff-tree -z -r);
+	if ($_cp_similarity) {
+		push @diff_tree, "-C$_cp_similarity";
+	} else {
+		push @diff_tree, '-C';
+	}
+	push @diff_tree, '--find-copies-harder' if $_find_copies_harder;
+	push @diff_tree, "-l$_rename_limit" if defined $_rename_limit;
+	push @diff_tree, $tree_a, $tree_b;
+	my ($diff_fh, $ctx) = command_output_pipe(@diff_tree);
+	local $/ = "\0";
+	my $state = 'meta';
+	my @mods;
+	while (<$diff_fh>) {
+		chomp $_; # this gets rid of the trailing "\0"
+		if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s
+					($::sha1)\s($::sha1)\s
+					([MTCRAD])\d*$/xo) {
+			push @mods, {	mode_a => $1, mode_b => $2,
+					sha1_a => $3, sha1_b => $4,
+					chg => $5 };
+			if ($5 =~ /^(?:C|R)$/) {
+				$state = 'file_a';
+			} else {
+				$state = 'file_b';
+			}
+		} elsif ($state eq 'file_a') {
+			my $x = $mods[$#mods] or croak "Empty array\n";
+			if ($x->{chg} !~ /^(?:C|R)$/) {
+				croak "Error parsing $_, $x->{chg}\n";
+			}
+			$x->{file_a} = $_;
+			$state = 'file_b';
+		} elsif ($state eq 'file_b') {
+			my $x = $mods[$#mods] or croak "Empty array\n";
+			if (exists $x->{file_a} && $x->{chg} !~ /^(?:C|R)$/) {
+				croak "Error parsing $_, $x->{chg}\n";
+			}
+			if (!exists $x->{file_a} && $x->{chg} =~ /^(?:C|R)$/) {
+				croak "Error parsing $_, $x->{chg}\n";
+			}
+			$x->{file_b} = $_;
+			$state = 'meta';
+		} else {
+			croak "Error parsing $_\n";
+		}
+	}
+	command_close_pipe($diff_fh, $ctx);
+	\@mods;
+}
+
+sub check_diff_paths {
+	my ($ra, $pfx, $rev, $mods) = @_;
+	my %types;
+	$pfx .= '/' if length $pfx;
+
+	sub type_diff_paths {
+		my ($ra, $types, $path, $rev) = @_;
+		my @p = split m#/+#, $path;
+		my $c = shift @p;
+		unless (defined $types->{$c}) {
+			$types->{$c} = $ra->check_path($c, $rev);
+		}
+		while (@p) {
+			$c .= '/' . shift @p;
+			next if defined $types->{$c};
+			$types->{$c} = $ra->check_path($c, $rev);
+		}
+	}
+
+	foreach my $m (@$mods) {
+		foreach my $f (qw/file_a file_b/) {
+			next unless defined $m->{$f};
+			my ($dir) = ($m->{$f} =~ m#^(.*?)/?(?:[^/]+)$#);
+			if (length $pfx.$dir && ! defined $types{$dir}) {
+				type_diff_paths($ra, \%types, $pfx.$dir, $rev);
+			}
+		}
+	}
+	\%types;
+}
+
+sub split_path {
+	return ($_[0] =~ m#^(.*?)/?([^/]+)$#);
+}
+
+sub repo_path {
+	my ($self, $path) = @_;
+	if (my $enc = $self->{pathnameencoding}) {
+		require Encode;
+		Encode::from_to($path, $enc, 'UTF-8');
+	}
+	$self->{path_prefix}.(defined $path ? $path : '');
+}
+
+sub url_path {
+	my ($self, $path) = @_;
+	if ($self->{url} =~ m#^https?://#) {
+		$path =~ s!([^~a-zA-Z0-9_./-])!uc sprintf("%%%02x",ord($1))!eg;
+	}
+	$self->{url} . '/' . $self->repo_path($path);
+}
+
+sub rmdirs {
+	my ($self) = @_;
+	my $rm = $self->{rm};
+	delete $rm->{''}; # we never delete the url we're tracking
+	return unless %$rm;
+
+	foreach (keys %$rm) {
+		my @d = split m#/#, $_;
+		my $c = shift @d;
+		$rm->{$c} = 1;
+		while (@d) {
+			$c .= '/' . shift @d;
+			$rm->{$c} = 1;
+		}
+	}
+	delete $rm->{$self->{svn_path}};
+	delete $rm->{''}; # we never delete the url we're tracking
+	return unless %$rm;
+
+	my ($fh, $ctx) = command_output_pipe(qw/ls-tree --name-only -r -z/,
+	                                     $self->{tree_b});
+	local $/ = "\0";
+	while (<$fh>) {
+		chomp;
+		my @dn = split m#/#, $_;
+		while (pop @dn) {
+			delete $rm->{join '/', @dn};
+		}
+		unless (%$rm) {
+			close $fh;
+			return;
+		}
+	}
+	command_close_pipe($fh, $ctx);
+
+	my ($r, $p, $bat) = ($self->{r}, $self->{pool}, $self->{bat});
+	foreach my $d (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$rm) {
+		$self->close_directory($bat->{$d}, $p);
+		my ($dn) = ($d =~ m#^(.*?)/?(?:[^/]+)$#);
+		print "\tD+\t$d/\n" unless $::_q;
+		$self->SUPER::delete_entry($d, $r, $bat->{$dn}, $p);
+		delete $bat->{$d};
+	}
+}
+
+sub open_or_add_dir {
+	my ($self, $full_path, $baton, $deletions) = @_;
+	my $t = $self->{types}->{$full_path};
+	if (!defined $t) {
+		die "$full_path not known in r$self->{r} or we have a bug!\n";
+	}
+	{
+		no warnings 'once';
+		# SVN::Node::none and SVN::Node::file are used only once,
+		# so we're shutting up Perl's warnings about them.
+		if ($t == $SVN::Node::none || defined($deletions->{$full_path})) {
+			return $self->add_directory($full_path, $baton,
+			    undef, -1, $self->{pool});
+		} elsif ($t == $SVN::Node::dir) {
+			return $self->open_directory($full_path, $baton,
+			    $self->{r}, $self->{pool});
+		} # no warnings 'once'
+		print STDERR "$full_path already exists in repository at ",
+		    "r$self->{r} and it is not a directory (",
+		    ($t == $SVN::Node::file ? 'file' : 'unknown'),"/$t)\n";
+	} # no warnings 'once'
+	exit 1;
+}
+
+sub ensure_path {
+	my ($self, $path, $deletions) = @_;
+	my $bat = $self->{bat};
+	my $repo_path = $self->repo_path($path);
+	return $bat->{''} unless (length $repo_path);
+
+	my @p = split m#/+#, $repo_path;
+	my $c = shift @p;
+	$bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''}, $deletions);
+	while (@p) {
+		my $c0 = $c;
+		$c .= '/' . shift @p;
+		$bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0}, $deletions);
+	}
+	return $bat->{$c};
+}
+
+# Subroutine to convert a globbing pattern to a regular expression.
+# From perl cookbook.
+sub glob2pat {
+	my $globstr = shift;
+	my %patmap = ('*' => '.*', '?' => '.', '[' => '[', ']' => ']');
+	$globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;
+	return '^' . $globstr . '$';
+}
+
+sub check_autoprop {
+	my ($self, $pattern, $properties, $file, $fbat) = @_;
+	# Convert the globbing pattern to a regular expression.
+	my $regex = glob2pat($pattern);
+	# Check if the pattern matches the file name.
+	if($file =~ m/($regex)/) {
+		# Parse the list of properties to set.
+		my @props = split(/;/, $properties);
+		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+$//;
+				}
+				$self->change_file_prop($fbat, $n, $v);
+			}
+		}
+	}
+}
+
+sub apply_autoprops {
+	my ($self, $file, $fbat) = @_;
+	my $conf_t = ${$self->{config}}{'config'};
+	no warnings 'once';
+	# Check [miscellany]/enable-auto-props in svn configuration.
+	if (SVN::_Core::svn_config_get_bool(
+		$conf_t,
+		$SVN::_Core::SVN_CONFIG_SECTION_MISCELLANY,
+		$SVN::_Core::SVN_CONFIG_OPTION_ENABLE_AUTO_PROPS,
+		0)) {
+		# Auto-props are enabled.  Enumerate them to look for matches.
+		my $callback = sub {
+			$self->check_autoprop($_[0], $_[1], $file, $fbat);
+		};
+		SVN::_Core::svn_config_enumerate(
+			$conf_t,
+			$SVN::_Core::SVN_CONFIG_SECTION_AUTO_PROPS,
+			$callback);
+	}
+}
+
+sub A {
+	my ($self, $m, $deletions) = @_;
+	my ($dir, $file) = split_path($m->{file_b});
+	my $pbat = $self->ensure_path($dir, $deletions);
+	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
+					undef, -1);
+	print "\tA\t$m->{file_b}\n" unless $::_q;
+	$self->apply_autoprops($file, $fbat);
+	$self->chg_file($fbat, $m);
+	$self->close_file($fbat,undef,$self->{pool});
+}
+
+sub C {
+	my ($self, $m, $deletions) = @_;
+	my ($dir, $file) = split_path($m->{file_b});
+	my $pbat = $self->ensure_path($dir, $deletions);
+	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
+				$self->url_path($m->{file_a}), $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});
+}
+
+sub delete_entry {
+	my ($self, $path, $pbat) = @_;
+	my $rpath = $self->repo_path($path);
+	my ($dir, $file) = split_path($rpath);
+	$self->{rm}->{$dir} = 1;
+	$self->SUPER::delete_entry($rpath, $self->{r}, $pbat, $self->{pool});
+}
+
+sub R {
+	my ($self, $m, $deletions) = @_;
+	my ($dir, $file) = split_path($m->{file_b});
+	my $pbat = $self->ensure_path($dir, $deletions);
+	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
+				$self->url_path($m->{file_a}), $self->{r});
+	print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
+	$self->apply_autoprops($file, $fbat);
+	$self->chg_file($fbat, $m);
+	$self->close_file($fbat,undef,$self->{pool});
+
+	($dir, $file) = split_path($m->{file_a});
+	$pbat = $self->ensure_path($dir, $deletions);
+	$self->delete_entry($m->{file_a}, $pbat);
+}
+
+sub M {
+	my ($self, $m, $deletions) = @_;
+	my ($dir, $file) = split_path($m->{file_b});
+	my $pbat = $self->ensure_path($dir, $deletions);
+	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->chg_file($fbat, $m);
+	$self->close_file($fbat,undef,$self->{pool});
+}
+
+sub T { shift->M(@_) }
+
+sub change_file_prop {
+	my ($self, $fbat, $pname, $pval) = @_;
+	$self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool});
+}
+
+sub change_dir_prop {
+	my ($self, $pbat, $pname, $pval) = @_;
+	$self->SUPER::change_dir_prop($pbat, $pname, $pval, $self->{pool});
+}
+
+sub _chg_file_get_blob ($$$$) {
+	my ($self, $fbat, $m, $which) = @_;
+	my $fh = $::_repository->temp_acquire("git_blob_$which");
+	if ($m->{"mode_$which"} =~ /^120/) {
+		print $fh 'link ' or croak $!;
+		$self->change_file_prop($fbat,'svn:special','*');
+	} elsif ($m->{mode_a} =~ /^120/ && $m->{"mode_$which"} !~ /^120/) {
+		$self->change_file_prop($fbat,'svn:special',undef);
+	}
+	my $blob = $m->{"sha1_$which"};
+	return ($fh,) if ($blob =~ /^0{40}$/);
+	my $size = $::_repository->cat_blob($blob, $fh);
+	croak "Failed to read object $blob" if ($size < 0);
+	$fh->flush == 0 or croak $!;
+	seek $fh, 0, 0 or croak $!;
+
+	my $exp = ::md5sum($fh);
+	seek $fh, 0, 0 or croak $!;
+	return ($fh, $exp);
+}
+
+sub chg_file {
+	my ($self, $fbat, $m) = @_;
+	if ($m->{mode_b} =~ /755$/ && $m->{mode_a} !~ /755$/) {
+		$self->change_file_prop($fbat,'svn:executable','*');
+	} elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
+		$self->change_file_prop($fbat,'svn:executable',undef);
+	}
+	my ($fh_a, $exp_a) = _chg_file_get_blob $self, $fbat, $m, 'a';
+	my ($fh_b, $exp_b) = _chg_file_get_blob $self, $fbat, $m, 'b';
+	my $pool = SVN::Pool->new;
+	my $atd = $self->apply_textdelta($fbat, $exp_a, $pool);
+	if (-s $fh_a) {
+		my $txstream = SVN::TxDelta::new ($fh_a, $fh_b, $pool);
+		my $res = SVN::TxDelta::send_txstream($txstream, @$atd, $pool);
+		if (defined $res) {
+			die "Unexpected result from send_txstream: $res\n",
+			    "(SVN::Core::VERSION: $SVN::Core::VERSION)\n";
+		}
+	} else {
+		my $got = SVN::TxDelta::send_stream($fh_b, @$atd, $pool);
+		die "Checksum mismatch\nexpected: $exp_b\ngot: $got\n"
+		    if ($got ne $exp_b);
+	}
+	Git::temp_release($fh_b, 1);
+	Git::temp_release($fh_a, 1);
+	$pool->clear;
+}
+
+sub D {
+	my ($self, $m, $deletions) = @_;
+	my ($dir, $file) = split_path($m->{file_b});
+	my $pbat = $self->ensure_path($dir, $deletions);
+	print "\tD\t$m->{file_b}\n" unless $::_q;
+	$self->delete_entry($m->{file_b}, $pbat);
+}
+
+sub close_edit {
+	my ($self) = @_;
+	my ($p,$bat) = ($self->{pool}, $self->{bat});
+	foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) {
+		next if $_ eq '';
+		$self->close_directory($bat->{$_}, $p);
+	}
+	$self->close_directory($bat->{''}, $p);
+	$self->SUPER::close_edit($p);
+	$p->clear;
+}
+
+sub abort_edit {
+	my ($self) = @_;
+	$self->SUPER::abort_edit($self->{pool});
+}
+
+sub DESTROY {
+	my $self = shift;
+	$self->SUPER::DESTROY(@_);
+	$self->{pool}->clear;
+}
+
+# this drives the editor
+sub apply_diff {
+	my ($self) = @_;
+	my $mods = $self->{mods};
+	my %o = ( D => 0, C => 1, R => 2, A => 3, M => 4, T => 5 );
+	my %deletions;
+
+	foreach my $m (@$mods) {
+		if ($m->{chg} eq "D") {
+			$deletions{$m->{file_b}} = 1;
+		}
+	}
+
+	foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
+		my $f = $m->{chg};
+		if (defined $o{$f}) {
+			$self->$f($m, \%deletions);
+		} else {
+			fatal("Invalid change type: $f");
+		}
+	}
+
+	if (defined($self->{mergeinfo})) {
+		$self->change_dir_prop($self->{bat}{''}, "svn:mergeinfo",
+			               $self->{mergeinfo});
+	}
+	$self->rmdirs if $_rmdir;
+	if (@$mods == 0 && !defined($self->{mergeinfo})) {
+		$self->abort_edit;
+	} else {
+		$self->close_edit;
+	}
+	return scalar @$mods;
+}
+
+1;
+__END__
+
+Git::SVN::Editor - commit driver for "git svn set-tree" and dcommit
+
+=head1 SYNOPSIS
+
+	use Git::SVN::Editor;
+	use Git::SVN::Ra;
+
+	my $ra = Git::SVN::Ra->new($url);
+	my %opts = (
+		r => 19,
+		log => "log message",
+		ra => $ra,
+		config => SVN::Core::config_get_config($svn_config_dir),
+		tree_a => "$commit^",
+		tree_b => "$commit",
+		editor_cb => sub { print "Committed r$_[0]\n"; },
+		mergeinfo => "/branches/foo:1-10",
+		svn_path => "trunk"
+	);
+	Git::SVN::Editor->new(\%opts)->apply_diff or print "No changes\n";
+
+	my $re = Git::SVN::Editor::glob2pat("trunk/*");
+	if ($branchname =~ /$re/) {
+		print "matched!\n";
+	}
+
+=head1 DESCRIPTION
+
+This module is an implementation detail of the "git svn" command.
+Do not use it unless you are developing git-svn.
+
+This module adapts the C<SVN::Delta::Editor> object returned by
+C<SVN::Delta::get_commit_editor> and drives it to convey the
+difference between two git tree objects to a remote Subversion
+repository.
+
+The interface will change as git-svn evolves.
+
+=head1 DEPENDENCIES
+
+Subversion perl bindings,
+the core L<Carp> and L<IO::File> modules,
+and git's L<Git> helper module.
+
+C<Git::SVN::Editor> has not been tested using callers other than
+B<git-svn> itself.
+
+=head1 SEE ALSO
+
+L<SVN::Delta>,
+L<Git::SVN::Fetcher>.
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+=head1 BUGS
+
+None.
diff --git a/perl/Git/SVN/Fetcher.pm b/perl/Git/SVN/Fetcher.pm
index 4e9c77d7..ef8e9ed2 100644
--- a/perl/Git/SVN/Fetcher.pm
+++ b/perl/Git/SVN/Fetcher.pm
@@ -591,7 +591,8 @@ B<git-svn> itself.
 
 =head1 SEE ALSO
 
-L<SVN::Delta>.
+L<SVN::Delta>,
+L<Git::SVN::Editor>.
 
 =head1 INCOMPATIBILITIES
 
diff --git a/perl/Makefile.PL b/perl/Makefile.PL
index 424890a1..32caf214 100644
--- a/perl/Makefile.PL
+++ b/perl/Makefile.PL
@@ -28,6 +28,7 @@ my %pm = (
 	'Git.pm' => '$(INST_LIBDIR)/Git.pm',
 	'Git/I18N.pm' => '$(INST_LIBDIR)/Git/I18N.pm',
 	'Git/SVN/Fetcher.pm' => '$(INST_LIBDIR)/Git/SVN/Fetcher.pm',
+	'Git/SVN/Editor.pm' => '$(INST_LIBDIR)/Git/SVN/Editor.pm',
 	'Git/SVN/Prompt.pm' => '$(INST_LIBDIR)/Git/SVN/Prompt.pm',
 );
 
-- 
1.7.10

  reply	other threads:[~2012-06-09 22:26 UTC|newest]

Thread overview: 26+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2011-08-22  2:17 [PATCH] git-svn: Destroy the cache when we fail to read it Jason Gross
2011-08-22  4:04 ` Jason Gross
2011-08-22  4:10 ` [PATCH] Add tests for handling corrupted caches Jason Gross
2011-08-23  2:27 ` [PATCH] git-svn: Destroy the cache when we fail to read it Jonathan Nieder
2011-08-23  2:36   ` Jonathan Nieder
2011-08-23  5:51   ` Jason Gross
2011-08-23  8:15 ` Eric Wong
2011-08-23 17:05   ` Junio C Hamano
2011-08-23 19:58     ` Eric Wong
2012-05-27 19:25     ` [RFC/PATCH] git-svn: use YAML format for mergeinfo cache when possible Jonathan Nieder
2012-05-27 19:48       ` [RFC/PATCH 2/1] fixup! " Jonathan Nieder
2012-05-27 20:14       ` [RFC/PATCH] " Eric Wong
2012-05-28  0:39         ` Jonathan Nieder
2012-05-28  6:57           ` [RFC/PATCH 0/2] git-svn: give SVN::Git::Fetcher its own file Jonathan Nieder
2012-05-28  7:00             ` [PATCH 1/2] git-svn: rename SVN::Git::* packages to Git::SVN::* Jonathan Nieder
2012-05-28  7:03             ` [PATCH 2/2] git-svn: make Git::SVN::Fetcher a separate file Jonathan Nieder
2012-05-29  0:25           ` [RFC/PATCH] git-svn: use YAML format for mergeinfo cache when possible Eric Wong
2012-05-29 20:48             ` Junio C Hamano
2012-06-09 22:20         ` [PATCH v2 0/3] " Jonathan Nieder
2012-06-09 22:25           ` Jonathan Nieder [this message]
2012-06-09 22:28           ` [PATCH 2/3] git-svn: make Git::SVN::RA a separate file Jonathan Nieder
2012-06-09 22:35           ` [PATCH 3/3] git-svn: use YAML format for mergeinfo cache when possible Jonathan Nieder
2012-06-13  1:34             ` Jonathan Nieder
2012-06-10  9:00           ` [PATCH v2 0/3] " Eric Wong
2012-06-10 10:04             ` Jonathan Nieder
2012-06-11 15:06               ` Junio C Hamano

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: http://vger.kernel.org/majordomo-info.html

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20120609222556.GE28412@burratino \
    --to=jrnieder@gmail.com \
    --cc=git@vger.kernel.org \
    --cc=gitster@pobox.com \
    --cc=jgross@MIT.EDU \
    --cc=normalperson@yhbt.net \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://80x24.org/mirrors/git.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).