1package Git::SVN::Editor; 2use vars qw/@ISA $_rmdir $_cp_similarity $_find_copies_harder $_rename_limit/; 3use strict; 4use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); 5use SVN::Core; 6use SVN::Delta; 7use Carp qw/croak/; 8use Git qw/command command_oneline command_noisy command_output_pipe 9 command_input_pipe command_close_pipe 10 command_bidi_pipe command_close_bidi_pipe 11 get_record/; 12 13BEGIN { 14 @ISA = qw(SVN::Delta::Editor); 15} 16 17sub new { 18 my ($class, $opts) = @_; 19 foreach (qw/svn_path r ra tree_a tree_b log editor_cb/) { 20 die "$_ required!\n" unless (defined $opts->{$_}); 21 } 22 23 my $pool = SVN::Pool->new; 24 my $mods = generate_diff($opts->{tree_a}, $opts->{tree_b}); 25 my $types = check_diff_paths($opts->{ra}, $opts->{svn_path}, 26 $opts->{r}, $mods); 27 28 # $opts->{ra} functions should not be used after this: 29 my @ce = $opts->{ra}->get_commit_editor($opts->{log}, 30 $opts->{editor_cb}, $pool); 31 my $self = SVN::Delta::Editor->new(@ce, $pool); 32 bless $self, $class; 33 foreach (qw/svn_path r tree_a tree_b/) { 34 $self->{$_} = $opts->{$_}; 35 } 36 $self->{url} = $opts->{ra}->{url}; 37 $self->{mods} = $mods; 38 $self->{types} = $types; 39 $self->{pool} = $pool; 40 $self->{bat} = { '' => $self->open_root($self->{r}, $self->{pool}) }; 41 $self->{rm} = { }; 42 $self->{path_prefix} = length $self->{svn_path} ? 43 "$self->{svn_path}/" : ''; 44 $self->{config} = $opts->{config}; 45 $self->{mergeinfo} = $opts->{mergeinfo}; 46 $self->{pathnameencoding} = Git::config('svn.pathnameencoding'); 47 return $self; 48} 49 50sub generate_diff { 51 my ($tree_a, $tree_b) = @_; 52 my @diff_tree = qw(diff-tree -z -r); 53 if ($_cp_similarity) { 54 push @diff_tree, "-C$_cp_similarity"; 55 } else { 56 push @diff_tree, '-C'; 57 } 58 push @diff_tree, '--find-copies-harder' if $_find_copies_harder; 59 push @diff_tree, "-l$_rename_limit" if defined $_rename_limit; 60 push @diff_tree, $tree_a, $tree_b; 61 my ($diff_fh, $ctx) = command_output_pipe(@diff_tree); 62 my $state = 'meta'; 63 my @mods; 64 while (defined($_ = get_record($diff_fh, "\0"))) { 65 if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s 66 ($::oid)\s($::oid)\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 $path = $self->repo_path($path); 148 if ($self->{url} =~ m#^https?://#) { 149 # characters are taken from subversion/libsvn_subr/path.c 150 $path =~ s#([^~a-zA-Z0-9_./!$&'()*+,-])#sprintf("%%%02X",ord($1))#eg; 151 } 152 $self->{url} . '/' . $path; 153} 154 155sub rmdirs { 156 my ($self) = @_; 157 my $rm = $self->{rm}; 158 delete $rm->{''}; # we never delete the url we're tracking 159 return unless %$rm; 160 161 foreach (keys %$rm) { 162 my @d = split m#/#, $_; 163 my $c = shift @d; 164 $rm->{$c} = 1; 165 while (@d) { 166 $c .= '/' . shift @d; 167 $rm->{$c} = 1; 168 } 169 } 170 delete $rm->{$self->{svn_path}}; 171 delete $rm->{''}; # we never delete the url we're tracking 172 return unless %$rm; 173 174 my ($fh, $ctx) = command_output_pipe(qw/ls-tree --name-only -r -z/, 175 $self->{tree_b}); 176 while (defined($_ = get_record($fh, "\0"))) { 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 check_attr { 291 my ($attr,$path) = @_; 292 my $val = command_oneline("check-attr", $attr, "--", $path); 293 if ($val) { $val =~ s/^[^:]*:\s*[^:]*:\s*(.*)\s*$/$1/; } 294 return $val; 295} 296 297sub apply_manualprops { 298 my ($self, $file, $fbat) = @_; 299 my $pending_properties = check_attr( "svn-properties", $file ); 300 if ($pending_properties eq "") { return; } 301 # Parse the list of properties to set. 302 my @props = split(/;/, $pending_properties); 303 # TODO: get existing properties to compare to 304 # - this fails for add so currently not done 305 # my $existing_props = ::get_svnprops($file); 306 my $existing_props = {}; 307 # TODO: caching svn properties or storing them in .gitattributes 308 # would make that faster 309 foreach my $prop (@props) { 310 # Parse 'name=value' syntax and set the property. 311 if ($prop =~ /([^=]+)=(.*)/) { 312 my ($n,$v) = ($1,$2); 313 for ($n, $v) { 314 s/^\s+//; s/\s+$//; 315 } 316 my $existing = $existing_props->{$n}; 317 if (!defined($existing) || $existing ne $v) { 318 $self->change_file_prop($fbat, $n, $v); 319 } 320 } 321 } 322} 323 324sub A { 325 my ($self, $m, $deletions) = @_; 326 my ($dir, $file) = split_path($m->{file_b}); 327 my $pbat = $self->ensure_path($dir, $deletions); 328 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat, 329 undef, -1); 330 print "\tA\t$m->{file_b}\n" unless $::_q; 331 $self->apply_autoprops($file, $fbat); 332 $self->apply_manualprops($m->{file_b}, $fbat); 333 $self->chg_file($fbat, $m); 334 $self->close_file($fbat,undef,$self->{pool}); 335} 336 337sub C { 338 my ($self, $m, $deletions) = @_; 339 my ($dir, $file) = split_path($m->{file_b}); 340 my $pbat = $self->ensure_path($dir, $deletions); 341 # workaround for a bug in svn serf backend (v1.8.5 and below): 342 # store third argument to ->add_file() in a local variable, to make it 343 # have the same lifetime as $fbat 344 my $upa = $self->url_path($m->{file_a}); 345 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat, 346 $upa, $self->{r}); 347 print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q; 348 $self->apply_manualprops($m->{file_b}, $fbat); 349 $self->chg_file($fbat, $m); 350 $self->close_file($fbat,undef,$self->{pool}); 351} 352 353sub delete_entry { 354 my ($self, $path, $pbat) = @_; 355 my $rpath = $self->repo_path($path); 356 my ($dir, $file) = split_path($rpath); 357 $self->{rm}->{$dir} = 1; 358 $self->SUPER::delete_entry($rpath, $self->{r}, $pbat, $self->{pool}); 359} 360 361sub R { 362 my ($self, $m, $deletions) = @_; 363 my ($dir, $file) = split_path($m->{file_b}); 364 my $pbat = $self->ensure_path($dir, $deletions); 365 # workaround for a bug in svn serf backend, see comment in C() above 366 my $upa = $self->url_path($m->{file_a}); 367 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat, 368 $upa, $self->{r}); 369 print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q; 370 $self->apply_autoprops($file, $fbat); 371 $self->apply_manualprops($m->{file_b}, $fbat); 372 $self->chg_file($fbat, $m); 373 $self->close_file($fbat,undef,$self->{pool}); 374 375 ($dir, $file) = split_path($m->{file_a}); 376 $pbat = $self->ensure_path($dir, $deletions); 377 $self->delete_entry($m->{file_a}, $pbat); 378} 379 380sub M { 381 my ($self, $m, $deletions) = @_; 382 my ($dir, $file) = split_path($m->{file_b}); 383 my $pbat = $self->ensure_path($dir, $deletions); 384 my $fbat = $self->open_file($self->repo_path($m->{file_b}), 385 $pbat,$self->{r},$self->{pool}); 386 print "\t$m->{chg}\t$m->{file_b}\n" unless $::_q; 387 $self->apply_manualprops($m->{file_b}, $fbat); 388 $self->chg_file($fbat, $m); 389 $self->close_file($fbat,undef,$self->{pool}); 390} 391 392sub T { 393 my ($self, $m, $deletions) = @_; 394 395 # Work around subversion issue 4091: toggling the "is a 396 # symlink" property requires removing and re-adding a 397 # file or else "svn up" on affected clients trips an 398 # assertion and aborts. 399 if (($m->{mode_b} =~ /^120/ && $m->{mode_a} !~ /^120/) || 400 ($m->{mode_b} !~ /^120/ && $m->{mode_a} =~ /^120/)) { 401 $self->D({ 402 mode_a => $m->{mode_a}, mode_b => '000000', 403 sha1_a => $m->{sha1_a}, sha1_b => '0' x $::oid_length, 404 chg => 'D', file_b => $m->{file_b} 405 }, $deletions); 406 $self->A({ 407 mode_a => '000000', mode_b => $m->{mode_b}, 408 sha1_a => '0' x $::oid_length, sha1_b => $m->{sha1_b}, 409 chg => 'A', file_b => $m->{file_b} 410 }, $deletions); 411 return; 412 } 413 414 $self->M($m, $deletions); 415} 416 417sub change_file_prop { 418 my ($self, $fbat, $pname, $pval) = @_; 419 $self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool}); 420} 421 422sub change_dir_prop { 423 my ($self, $pbat, $pname, $pval) = @_; 424 $self->SUPER::change_dir_prop($pbat, $pname, $pval, $self->{pool}); 425} 426 427sub _chg_file_get_blob ($$$$) { 428 my ($self, $fbat, $m, $which) = @_; 429 my $fh = $::_repository->temp_acquire("git_blob_$which"); 430 if ($m->{"mode_$which"} =~ /^120/) { 431 print $fh 'link ' or croak $!; 432 $self->change_file_prop($fbat,'svn:special','*'); 433 } elsif ($m->{mode_a} =~ /^120/ && $m->{"mode_$which"} !~ /^120/) { 434 $self->change_file_prop($fbat,'svn:special',undef); 435 } 436 my $blob = $m->{"sha1_$which"}; 437 return ($fh,) if ($blob =~ /^0+$/); 438 my $size = $::_repository->cat_blob($blob, $fh); 439 croak "Failed to read object $blob" if ($size < 0); 440 $fh->flush == 0 or croak $!; 441 seek $fh, 0, 0 or croak $!; 442 443 my $exp = ::md5sum($fh); 444 seek $fh, 0, 0 or croak $!; 445 return ($fh, $exp); 446} 447 448sub chg_file { 449 my ($self, $fbat, $m) = @_; 450 if ($m->{mode_b} =~ /755$/ && $m->{mode_a} !~ /755$/) { 451 $self->change_file_prop($fbat,'svn:executable','*'); 452 } elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) { 453 $self->change_file_prop($fbat,'svn:executable',undef); 454 } 455 my ($fh_a, $exp_a) = _chg_file_get_blob $self, $fbat, $m, 'a'; 456 my ($fh_b, $exp_b) = _chg_file_get_blob $self, $fbat, $m, 'b'; 457 my $pool = SVN::Pool->new; 458 my $atd = $self->apply_textdelta($fbat, $exp_a, $pool); 459 if (-s $fh_a) { 460 my $txstream = SVN::TxDelta::new ($fh_a, $fh_b, $pool); 461 my $res = SVN::TxDelta::send_txstream($txstream, @$atd, $pool); 462 if (defined $res) { 463 die "Unexpected result from send_txstream: $res\n", 464 "(SVN::Core::VERSION: $SVN::Core::VERSION)\n"; 465 } 466 } else { 467 my $got = SVN::TxDelta::send_stream($fh_b, @$atd, $pool); 468 die "Checksum mismatch\nexpected: $exp_b\ngot: $got\n" 469 if ($got ne $exp_b); 470 } 471 Git::temp_release($fh_b, 1); 472 Git::temp_release($fh_a, 1); 473 $pool->clear; 474} 475 476sub D { 477 my ($self, $m, $deletions) = @_; 478 my ($dir, $file) = split_path($m->{file_b}); 479 my $pbat = $self->ensure_path($dir, $deletions); 480 print "\tD\t$m->{file_b}\n" unless $::_q; 481 $self->delete_entry($m->{file_b}, $pbat); 482} 483 484sub close_edit { 485 my ($self) = @_; 486 my ($p,$bat) = ($self->{pool}, $self->{bat}); 487 foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) { 488 next if $_ eq ''; 489 $self->close_directory($bat->{$_}, $p); 490 } 491 $self->close_directory($bat->{''}, $p); 492 $self->SUPER::close_edit($p); 493 $p->clear; 494} 495 496sub abort_edit { 497 my ($self) = @_; 498 $self->SUPER::abort_edit($self->{pool}); 499} 500 501sub DESTROY { 502 my $self = shift; 503 $self->SUPER::DESTROY(@_); 504 $self->{pool}->clear; 505} 506 507# this drives the editor 508sub apply_diff { 509 my ($self) = @_; 510 my $mods = $self->{mods}; 511 my %o = ( D => 0, C => 1, R => 2, A => 3, M => 4, T => 5 ); 512 my %deletions; 513 514 foreach my $m (@$mods) { 515 if ($m->{chg} eq "D") { 516 $deletions{$m->{file_b}} = 1; 517 } 518 } 519 520 foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) { 521 my $f = $m->{chg}; 522 if (defined $o{$f}) { 523 $self->$f($m, \%deletions); 524 } else { 525 fatal("Invalid change type: $f"); 526 } 527 } 528 529 if (defined($self->{mergeinfo})) { 530 $self->change_dir_prop($self->{bat}{''}, "svn:mergeinfo", 531 $self->{mergeinfo}); 532 } 533 $self->rmdirs if $_rmdir; 534 if (@$mods == 0 && !defined($self->{mergeinfo})) { 535 $self->abort_edit; 536 } else { 537 $self->close_edit; 538 } 539 return scalar @$mods; 540} 541 5421; 543__END__ 544 545=head1 NAME 546 547Git::SVN::Editor - commit driver for "git svn set-tree" and dcommit 548 549=head1 SYNOPSIS 550 551 use Git::SVN::Editor; 552 use Git::SVN::Ra; 553 554 my $ra = Git::SVN::Ra->new($url); 555 my %opts = ( 556 r => 19, 557 log => "log message", 558 ra => $ra, 559 config => SVN::Core::config_get_config($svn_config_dir), 560 tree_a => "$commit^", 561 tree_b => "$commit", 562 editor_cb => sub { print "Committed r$_[0]\n"; }, 563 mergeinfo => "/branches/foo:1-10", 564 svn_path => "trunk" 565 ); 566 Git::SVN::Editor->new(\%opts)->apply_diff or print "No changes\n"; 567 568 my $re = Git::SVN::Editor::glob2pat("trunk/*"); 569 if ($branchname =~ /$re/) { 570 print "matched!\n"; 571 } 572 573=head1 DESCRIPTION 574 575This module is an implementation detail of the "git svn" command. 576Do not use it unless you are developing git-svn. 577 578This module adapts the C<SVN::Delta::Editor> object returned by 579C<SVN::Delta::get_commit_editor> and drives it to convey the 580difference between two git tree objects to a remote Subversion 581repository. 582 583The interface will change as git-svn evolves. 584 585=head1 DEPENDENCIES 586 587Subversion perl bindings, 588the core L<Carp> module, 589and git's L<Git> helper module. 590 591C<Git::SVN::Editor> has not been tested using callers other than 592B<git-svn> itself. 593 594=head1 SEE ALSO 595 596L<SVN::Delta>, 597L<Git::SVN::Fetcher>. 598 599=head1 INCOMPATIBILITIES 600 601None reported. 602 603=head1 BUGS 604 605None. 606