| 1 | package Git::SVN::Editor; |
| 2 | use vars qw/@ISA $_rmdir $_cp_similarity $_find_copies_harder $_rename_limit/; |
| 3 | use strict; |
| 4 | use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); |
| 5 | use SVN::Core; |
| 6 | use SVN::Delta; |
| 7 | use Carp qw/croak/; |
| 8 | use 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 | |
| 13 | BEGIN { |
| 14 | @ISA = qw(SVN::Delta::Editor); |
| 15 | } |
| 16 | |
| 17 | sub 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 | |
| 50 | sub 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 | |
| 101 | sub 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 | |
| 132 | sub split_path { |
| 133 | return ($_[0] =~ m#^(.*?)/?([^/]+)$#); |
| 134 | } |
| 135 | |
| 136 | sub 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 | |
| 145 | sub 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 | |
| 155 | sub 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 | |
| 198 | sub 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 | |
| 222 | sub 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. |
| 241 | sub glob2pat { |
| 242 | my $globstr = shift; |
| 243 | my %patmap = ('*' => '.*', '?' => '.', '[' => '[', ']' => ']'); |
| 244 | $globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge; |
| 245 | return '^' . $globstr . '$'; |
| 246 | } |
| 247 | |
| 248 | sub 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 | |
| 269 | sub 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 | |
| 290 | sub 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 | |
| 297 | sub 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 | |
| 324 | sub 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 | |
| 337 | sub 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 | |
| 353 | sub 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 | |
| 361 | sub 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 | |
| 380 | sub 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 | |
| 392 | sub 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 | |
| 417 | sub change_file_prop { |
| 418 | my ($self, $fbat, $pname, $pval) = @_; |
| 419 | $self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool}); |
| 420 | } |
| 421 | |
| 422 | sub change_dir_prop { |
| 423 | my ($self, $pbat, $pname, $pval) = @_; |
| 424 | $self->SUPER::change_dir_prop($pbat, $pname, $pval, $self->{pool}); |
| 425 | } |
| 426 | |
| 427 | sub _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 | |
| 448 | sub 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 | |
| 476 | sub 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 | |
| 484 | sub 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 | |
| 496 | sub abort_edit { |
| 497 | my ($self) = @_; |
| 498 | $self->SUPER::abort_edit($self->{pool}); |
| 499 | } |
| 500 | |
| 501 | sub DESTROY { |
| 502 | my $self = shift; |
| 503 | $self->SUPER::DESTROY(@_); |
| 504 | $self->{pool}->clear; |
| 505 | } |
| 506 | |
| 507 | # this drives the editor |
| 508 | sub 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 | |
| 542 | 1; |
| 543 | __END__ |
| 544 | |
| 545 | =head1 NAME |
| 546 | |
| 547 | Git::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 | |
| 575 | This module is an implementation detail of the "git svn" command. |
| 576 | Do not use it unless you are developing git-svn. |
| 577 | |
| 578 | This module adapts the C<SVN::Delta::Editor> object returned by |
| 579 | C<SVN::Delta::get_commit_editor> and drives it to convey the |
| 580 | difference between two git tree objects to a remote Subversion |
| 581 | repository. |
| 582 | |
| 583 | The interface will change as git-svn evolves. |
| 584 | |
| 585 | =head1 DEPENDENCIES |
| 586 | |
| 587 | Subversion perl bindings, |
| 588 | the core L<Carp> module, |
| 589 | and git's L<Git> helper module. |
| 590 | |
| 591 | C<Git::SVN::Editor> has not been tested using callers other than |
| 592 | B<git-svn> itself. |
| 593 | |
| 594 | =head1 SEE ALSO |
| 595 | |
| 596 | L<SVN::Delta>, |
| 597 | L<Git::SVN::Fetcher>. |
| 598 | |
| 599 | =head1 INCOMPATIBILITIES |
| 600 | |
| 601 | None reported. |
| 602 | |
| 603 | =head1 BUGS |
| 604 | |
| 605 | None. |