1package Git::SVN::Editor;
2use vars qw/@ISA $_rmdir $_cp_similarity $_find_copies_harder $_rename_limit/;
3use strict;
4use warnings;
5use SVN::Core;
6use SVN::Delta;
7use Carp qw/croak/;
8use IO::File;
9use Git qw/command command_oneline command_noisy command_output_pipe
10 command_input_pipe command_close_pipe
11 command_bidi_pipe command_close_bidi_pipe/;
12BEGIN {
13 @ISA = qw(SVN::Delta::Editor);
14}
15
16sub new {
17 my ($class, $opts) = @_;
18 foreach (qw/svn_path r ra tree_a tree_b log editor_cb/) {
19 die "$_ required!\n" unless (defined $opts->{$_});
20 }
21
22 my $pool = SVN::Pool->new;
23 my $mods = generate_diff($opts->{tree_a}, $opts->{tree_b});
24 my $types = check_diff_paths($opts->{ra}, $opts->{svn_path},
25 $opts->{r}, $mods);
26
27 # $opts->{ra} functions should not be used after this:
28 my @ce = $opts->{ra}->get_commit_editor($opts->{log},
29 $opts->{editor_cb}, $pool);
30 my $self = SVN::Delta::Editor->new(@ce, $pool);
31 bless $self, $class;
32 foreach (qw/svn_path r tree_a tree_b/) {
33 $self->{$_} = $opts->{$_};
34 }
35 $self->{url} = $opts->{ra}->{url};
36 $self->{mods} = $mods;
37 $self->{types} = $types;
38 $self->{pool} = $pool;
39 $self->{bat} = { '' => $self->open_root($self->{r}, $self->{pool}) };
40 $self->{rm} = { };
41 $self->{path_prefix} = length $self->{svn_path} ?
42 "$self->{svn_path}/" : '';
43 $self->{config} = $opts->{config};
44 $self->{mergeinfo} = $opts->{mergeinfo};
45 return $self;
46}
47
48sub generate_diff {
49 my ($tree_a, $tree_b) = @_;
50 my @diff_tree = qw(diff-tree -z -r);
51 if ($_cp_similarity) {
52 push @diff_tree, "-C$_cp_similarity";
53 } else {
54 push @diff_tree, '-C';
55 }
56 push @diff_tree, '--find-copies-harder' if $_find_copies_harder;
57 push @diff_tree, "-l$_rename_limit" if defined $_rename_limit;
58 push @diff_tree, $tree_a, $tree_b;
59 my ($diff_fh, $ctx) = command_output_pipe(@diff_tree);
60 local $/ = "\0";
61 my $state = 'meta';
62 my @mods;
63 while (<$diff_fh>) {
64 chomp $_; # this gets rid of the trailing "\0"
65 if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s
66 ($::sha1)\s($::sha1)\s
67 ([MTCRAD])\d*$/xo) {
68 push @mods, { mode_a => $1, mode_b => $2,
69 sha1_a => $3, sha1_b => $4,
70 chg => $5 };
71 if ($5 =~ /^(?:C|R)$/) {
72 $state = 'file_a';
73 } else {
74 $state = 'file_b';
75 }
76 } elsif ($state eq 'file_a') {
77 my $x = $mods[$#mods] or croak "Empty array\n";
78 if ($x->{chg} !~ /^(?:C|R)$/) {
79 croak "Error parsing $_, $x->{chg}\n";
80 }
81 $x->{file_a} = $_;
82 $state = 'file_b';
83 } elsif ($state eq 'file_b') {
84 my $x = $mods[$#mods] or croak "Empty array\n";
85 if (exists $x->{file_a} && $x->{chg} !~ /^(?:C|R)$/) {
86 croak "Error parsing $_, $x->{chg}\n";
87 }
88 if (!exists $x->{file_a} && $x->{chg} =~ /^(?:C|R)$/) {
89 croak "Error parsing $_, $x->{chg}\n";
90 }
91 $x->{file_b} = $_;
92 $state = 'meta';
93 } else {
94 croak "Error parsing $_\n";
95 }
96 }
97 command_close_pipe($diff_fh, $ctx);
98 \@mods;
99}
100
101sub check_diff_paths {
102 my ($ra, $pfx, $rev, $mods) = @_;
103 my %types;
104 $pfx .= '/' if length $pfx;
105
106 sub type_diff_paths {
107 my ($ra, $types, $path, $rev) = @_;
108 my @p = split m#/+#, $path;
109 my $c = shift @p;
110 unless (defined $types->{$c}) {
111 $types->{$c} = $ra->check_path($c, $rev);
112 }
113 while (@p) {
114 $c .= '/' . shift @p;
115 next if defined $types->{$c};
116 $types->{$c} = $ra->check_path($c, $rev);
117 }
118 }
119
120 foreach my $m (@$mods) {
121 foreach my $f (qw/file_a file_b/) {
122 next unless defined $m->{$f};
123 my ($dir) = ($m->{$f} =~ m#^(.*?)/?(?:[^/]+)$#);
124 if (length $pfx.$dir && ! defined $types{$dir}) {
125 type_diff_paths($ra, \%types, $pfx.$dir, $rev);
126 }
127 }
128 }
129 \%types;
130}
131
132sub split_path {
133 return ($_[0] =~ m#^(.*?)/?([^/]+)$#);
134}
135
136sub repo_path {
137 my ($self, $path) = @_;
138 if (my $enc = $self->{pathnameencoding}) {
139 require Encode;
140 Encode::from_to($path, $enc, 'UTF-8');
141 }
142 $self->{path_prefix}.(defined $path ? $path : '');
143}
144
145sub url_path {
146 my ($self, $path) = @_;
147 if ($self->{url} =~ m#^https?://#) {
148 $path =~ s!([^~a-zA-Z0-9_./-])!uc sprintf("%%%02x",ord($1))!eg;
149 }
150 $self->{url} . '/' . $self->repo_path($path);
151}
152
153sub rmdirs {
154 my ($self) = @_;
155 my $rm = $self->{rm};
156 delete $rm->{''}; # we never delete the url we're tracking
157 return unless %$rm;
158
159 foreach (keys %$rm) {
160 my @d = split m#/#, $_;
161 my $c = shift @d;
162 $rm->{$c} = 1;
163 while (@d) {
164 $c .= '/' . shift @d;
165 $rm->{$c} = 1;
166 }
167 }
168 delete $rm->{$self->{svn_path}};
169 delete $rm->{''}; # we never delete the url we're tracking
170 return unless %$rm;
171
172 my ($fh, $ctx) = command_output_pipe(qw/ls-tree --name-only -r -z/,
173 $self->{tree_b});
174 local $/ = "\0";
175 while (<$fh>) {
176 chomp;
177 my @dn = split m#/#, $_;
178 while (pop @dn) {
179 delete $rm->{join '/', @dn};
180 }
181 unless (%$rm) {
182 close $fh;
183 return;
184 }
185 }
186 command_close_pipe($fh, $ctx);
187
188 my ($r, $p, $bat) = ($self->{r}, $self->{pool}, $self->{bat});
189 foreach my $d (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$rm) {
190 $self->close_directory($bat->{$d}, $p);
191 my ($dn) = ($d =~ m#^(.*?)/?(?:[^/]+)$#);
192 print "\tD+\t$d/\n" unless $::_q;
193 $self->SUPER::delete_entry($d, $r, $bat->{$dn}, $p);
194 delete $bat->{$d};
195 }
196}
197
198sub open_or_add_dir {
199 my ($self, $full_path, $baton, $deletions) = @_;
200 my $t = $self->{types}->{$full_path};
201 if (!defined $t) {
202 die "$full_path not known in r$self->{r} or we have a bug!\n";
203 }
204 {
205 no warnings 'once';
206 # SVN::Node::none and SVN::Node::file are used only once,
207 # so we're shutting up Perl's warnings about them.
208 if ($t == $SVN::Node::none || defined($deletions->{$full_path})) {
209 return $self->add_directory($full_path, $baton,
210 undef, -1, $self->{pool});
211 } elsif ($t == $SVN::Node::dir) {
212 return $self->open_directory($full_path, $baton,
213 $self->{r}, $self->{pool});
214 } # no warnings 'once'
215 print STDERR "$full_path already exists in repository at ",
216 "r$self->{r} and it is not a directory (",
217 ($t == $SVN::Node::file ? 'file' : 'unknown'),"/$t)\n";
218 } # no warnings 'once'
219 exit 1;
220}
221
222sub ensure_path {
223 my ($self, $path, $deletions) = @_;
224 my $bat = $self->{bat};
225 my $repo_path = $self->repo_path($path);
226 return $bat->{''} unless (length $repo_path);
227
228 my @p = split m#/+#, $repo_path;
229 my $c = shift @p;
230 $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''}, $deletions);
231 while (@p) {
232 my $c0 = $c;
233 $c .= '/' . shift @p;
234 $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0}, $deletions);
235 }
236 return $bat->{$c};
237}
238
239# Subroutine to convert a globbing pattern to a regular expression.
240# From perl cookbook.
241sub glob2pat {
242 my $globstr = shift;
243 my %patmap = ('*' => '.*', '?' => '.', '[' => '[', ']' => ']');
244 $globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;
245 return '^' . $globstr . '$';
246}
247
248sub check_autoprop {
249 my ($self, $pattern, $properties, $file, $fbat) = @_;
250 # Convert the globbing pattern to a regular expression.
251 my $regex = glob2pat($pattern);
252 # Check if the pattern matches the file name.
253 if($file =~ m/($regex)/) {
254 # Parse the list of properties to set.
255 my @props = split(/;/, $properties);
256 foreach my $prop (@props) {
257 # Parse 'name=value' syntax and set the property.
258 if ($prop =~ /([^=]+)=(.*)/) {
259 my ($n,$v) = ($1,$2);
260 for ($n, $v) {
261 s/^\s+//; s/\s+$//;
262 }
263 $self->change_file_prop($fbat, $n, $v);
264 }
265 }
266 }
267}
268
269sub apply_autoprops {
270 my ($self, $file, $fbat) = @_;
271 my $conf_t = ${$self->{config}}{'config'};
272 no warnings 'once';
273 # Check [miscellany]/enable-auto-props in svn configuration.
274 if (SVN::_Core::svn_config_get_bool(
275 $conf_t,
276 $SVN::_Core::SVN_CONFIG_SECTION_MISCELLANY,
277 $SVN::_Core::SVN_CONFIG_OPTION_ENABLE_AUTO_PROPS,
278 0)) {
279 # Auto-props are enabled. Enumerate them to look for matches.
280 my $callback = sub {
281 $self->check_autoprop($_[0], $_[1], $file, $fbat);
282 };
283 SVN::_Core::svn_config_enumerate(
284 $conf_t,
285 $SVN::_Core::SVN_CONFIG_SECTION_AUTO_PROPS,
286 $callback);
287 }
288}
289
290sub A {
291 my ($self, $m, $deletions) = @_;
292 my ($dir, $file) = split_path($m->{file_b});
293 my $pbat = $self->ensure_path($dir, $deletions);
294 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
295 undef, -1);
296 print "\tA\t$m->{file_b}\n" unless $::_q;
297 $self->apply_autoprops($file, $fbat);
298 $self->chg_file($fbat, $m);
299 $self->close_file($fbat,undef,$self->{pool});
300}
301
302sub C {
303 my ($self, $m, $deletions) = @_;
304 my ($dir, $file) = split_path($m->{file_b});
305 my $pbat = $self->ensure_path($dir, $deletions);
306 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
307 $self->url_path($m->{file_a}), $self->{r});
308 print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
309 $self->chg_file($fbat, $m);
310 $self->close_file($fbat,undef,$self->{pool});
311}
312
313sub delete_entry {
314 my ($self, $path, $pbat) = @_;
315 my $rpath = $self->repo_path($path);
316 my ($dir, $file) = split_path($rpath);
317 $self->{rm}->{$dir} = 1;
318 $self->SUPER::delete_entry($rpath, $self->{r}, $pbat, $self->{pool});
319}
320
321sub R {
322 my ($self, $m, $deletions) = @_;
323 my ($dir, $file) = split_path($m->{file_b});
324 my $pbat = $self->ensure_path($dir, $deletions);
325 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
326 $self->url_path($m->{file_a}), $self->{r});
327 print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
328 $self->apply_autoprops($file, $fbat);
329 $self->chg_file($fbat, $m);
330 $self->close_file($fbat,undef,$self->{pool});
331
332 ($dir, $file) = split_path($m->{file_a});
333 $pbat = $self->ensure_path($dir, $deletions);
334 $self->delete_entry($m->{file_a}, $pbat);
335}
336
337sub M {
338 my ($self, $m, $deletions) = @_;
339 my ($dir, $file) = split_path($m->{file_b});
340 my $pbat = $self->ensure_path($dir, $deletions);
341 my $fbat = $self->open_file($self->repo_path($m->{file_b}),
342 $pbat,$self->{r},$self->{pool});
343 print "\t$m->{chg}\t$m->{file_b}\n" unless $::_q;
344 $self->chg_file($fbat, $m);
345 $self->close_file($fbat,undef,$self->{pool});
346}
347
348sub T {
349 my ($self, $m, $deletions) = @_;
350
351 # Work around subversion issue 4091: toggling the "is a
352 # symlink" property requires removing and re-adding a
353 # file or else "svn up" on affected clients trips an
354 # assertion and aborts.
355 if (($m->{mode_b} =~ /^120/ && $m->{mode_a} !~ /^120/) ||
356 ($m->{mode_b} !~ /^120/ && $m->{mode_a} =~ /^120/)) {
357 $self->D({
358 mode_a => $m->{mode_a}, mode_b => '000000',
359 sha1_a => $m->{sha1_a}, sha1_b => '0' x 40,
360 chg => 'D', file_b => $m->{file_b}
361 });
362 $self->A({
363 mode_a => '000000', mode_b => $m->{mode_b},
364 sha1_a => '0' x 40, sha1_b => $m->{sha1_b},
365 chg => 'A', file_b => $m->{file_b}
366 });
367 return;
368 }
369
370 $self->M($m, $deletions);
371}
372
373sub change_file_prop {
374 my ($self, $fbat, $pname, $pval) = @_;
375 $self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool});
376}
377
378sub change_dir_prop {
379 my ($self, $pbat, $pname, $pval) = @_;
380 $self->SUPER::change_dir_prop($pbat, $pname, $pval, $self->{pool});
381}
382
383sub _chg_file_get_blob ($$$$) {
384 my ($self, $fbat, $m, $which) = @_;
385 my $fh = $::_repository->temp_acquire("git_blob_$which");
386 if ($m->{"mode_$which"} =~ /^120/) {
387 print $fh 'link ' or croak $!;
388 $self->change_file_prop($fbat,'svn:special','*');
389 } elsif ($m->{mode_a} =~ /^120/ && $m->{"mode_$which"} !~ /^120/) {
390 $self->change_file_prop($fbat,'svn:special',undef);
391 }
392 my $blob = $m->{"sha1_$which"};
393 return ($fh,) if ($blob =~ /^0{40}$/);
394 my $size = $::_repository->cat_blob($blob, $fh);
395 croak "Failed to read object $blob" if ($size < 0);
396 $fh->flush == 0 or croak $!;
397 seek $fh, 0, 0 or croak $!;
398
399 my $exp = ::md5sum($fh);
400 seek $fh, 0, 0 or croak $!;
401 return ($fh, $exp);
402}
403
404sub chg_file {
405 my ($self, $fbat, $m) = @_;
406 if ($m->{mode_b} =~ /755$/ && $m->{mode_a} !~ /755$/) {
407 $self->change_file_prop($fbat,'svn:executable','*');
408 } elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
409 $self->change_file_prop($fbat,'svn:executable',undef);
410 }
411 my ($fh_a, $exp_a) = _chg_file_get_blob $self, $fbat, $m, 'a';
412 my ($fh_b, $exp_b) = _chg_file_get_blob $self, $fbat, $m, 'b';
413 my $pool = SVN::Pool->new;
414 my $atd = $self->apply_textdelta($fbat, $exp_a, $pool);
415 if (-s $fh_a) {
416 my $txstream = SVN::TxDelta::new ($fh_a, $fh_b, $pool);
417 my $res = SVN::TxDelta::send_txstream($txstream, @$atd, $pool);
418 if (defined $res) {
419 die "Unexpected result from send_txstream: $res\n",
420 "(SVN::Core::VERSION: $SVN::Core::VERSION)\n";
421 }
422 } else {
423 my $got = SVN::TxDelta::send_stream($fh_b, @$atd, $pool);
424 die "Checksum mismatch\nexpected: $exp_b\ngot: $got\n"
425 if ($got ne $exp_b);
426 }
427 Git::temp_release($fh_b, 1);
428 Git::temp_release($fh_a, 1);
429 $pool->clear;
430}
431
432sub D {
433 my ($self, $m, $deletions) = @_;
434 my ($dir, $file) = split_path($m->{file_b});
435 my $pbat = $self->ensure_path($dir, $deletions);
436 print "\tD\t$m->{file_b}\n" unless $::_q;
437 $self->delete_entry($m->{file_b}, $pbat);
438}
439
440sub close_edit {
441 my ($self) = @_;
442 my ($p,$bat) = ($self->{pool}, $self->{bat});
443 foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) {
444 next if $_ eq '';
445 $self->close_directory($bat->{$_}, $p);
446 }
447 $self->close_directory($bat->{''}, $p);
448 $self->SUPER::close_edit($p);
449 $p->clear;
450}
451
452sub abort_edit {
453 my ($self) = @_;
454 $self->SUPER::abort_edit($self->{pool});
455}
456
457sub DESTROY {
458 my $self = shift;
459 $self->SUPER::DESTROY(@_);
460 $self->{pool}->clear;
461}
462
463# this drives the editor
464sub apply_diff {
465 my ($self) = @_;
466 my $mods = $self->{mods};
467 my %o = ( D => 0, C => 1, R => 2, A => 3, M => 4, T => 5 );
468 my %deletions;
469
470 foreach my $m (@$mods) {
471 if ($m->{chg} eq "D") {
472 $deletions{$m->{file_b}} = 1;
473 }
474 }
475
476 foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
477 my $f = $m->{chg};
478 if (defined $o{$f}) {
479 $self->$f($m, \%deletions);
480 } else {
481 fatal("Invalid change type: $f");
482 }
483 }
484
485 if (defined($self->{mergeinfo})) {
486 $self->change_dir_prop($self->{bat}{''}, "svn:mergeinfo",
487 $self->{mergeinfo});
488 }
489 $self->rmdirs if $_rmdir;
490 if (@$mods == 0 && !defined($self->{mergeinfo})) {
491 $self->abort_edit;
492 } else {
493 $self->close_edit;
494 }
495 return scalar @$mods;
496}
497
4981;
499__END__
500
501Git::SVN::Editor - commit driver for "git svn set-tree" and dcommit
502
503=head1 SYNOPSIS
504
505 use Git::SVN::Editor;
506 use Git::SVN::Ra;
507
508 my $ra = Git::SVN::Ra->new($url);
509 my %opts = (
510 r => 19,
511 log => "log message",
512 ra => $ra,
513 config => SVN::Core::config_get_config($svn_config_dir),
514 tree_a => "$commit^",
515 tree_b => "$commit",
516 editor_cb => sub { print "Committed r$_[0]\n"; },
517 mergeinfo => "/branches/foo:1-10",
518 svn_path => "trunk"
519 );
520 Git::SVN::Editor->new(\%opts)->apply_diff or print "No changes\n";
521
522 my $re = Git::SVN::Editor::glob2pat("trunk/*");
523 if ($branchname =~ /$re/) {
524 print "matched!\n";
525 }
526
527=head1 DESCRIPTION
528
529This module is an implementation detail of the "git svn" command.
530Do not use it unless you are developing git-svn.
531
532This module adapts the C<SVN::Delta::Editor> object returned by
533C<SVN::Delta::get_commit_editor> and drives it to convey the
534difference between two git tree objects to a remote Subversion
535repository.
536
537The interface will change as git-svn evolves.
538
539=head1 DEPENDENCIES
540
541Subversion perl bindings,
542the core L<Carp> and L<IO::File> modules,
543and git's L<Git> helper module.
544
545C<Git::SVN::Editor> has not been tested using callers other than
546B<git-svn> itself.
547
548=head1 SEE ALSO
549
550L<SVN::Delta>,
551L<Git::SVN::Fetcher>.
552
553=head1 INCOMPATIBILITIES
554
555None reported.
556
557=head1 BUGS
558
559None.