]>
Commit | Line | Data |
---|---|---|
8f9facfe JN |
1 | package Git::SVN::Editor; |
2 | use vars qw/@ISA $_rmdir $_cp_similarity $_find_copies_harder $_rename_limit/; | |
3 | use strict; | |
5338ed2b | 4 | use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); |
8f9facfe JN |
5 | use SVN::Core; |
6 | use SVN::Delta; | |
7 | use Carp qw/croak/; | |
8f9facfe JN |
8 | use Git qw/command command_oneline command_noisy command_output_pipe |
9 | command_input_pipe command_close_pipe | |
b26098fc EW |
10 | command_bidi_pipe command_close_bidi_pipe |
11 | get_record/; | |
12 | ||
8f9facfe JN |
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}; | |
40f47448 | 46 | $self->{pathnameencoding} = Git::config('svn.pathnameencoding'); |
8f9facfe JN |
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); | |
8f9facfe JN |
62 | my $state = 'meta'; |
63 | my @mods; | |
b26098fc | 64 | while (defined($_ = get_record($diff_fh, "\0"))) { |
8f9facfe | 65 | if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s |
9ab33150 | 66 | ($::oid)\s($::oid)\s |
8f9facfe JN |
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) = @_; | |
1b42f452 | 147 | $path = $self->repo_path($path); |
8f9facfe | 148 | if ($self->{url} =~ m#^https?://#) { |
cc304627 | 149 | # characters are taken from subversion/libsvn_subr/path.c |
1b67bef2 | 150 | $path =~ s#([^~a-zA-Z0-9_./!$&'()*+,-])#sprintf("%%%02X",ord($1))#eg; |
8f9facfe | 151 | } |
1b42f452 | 152 | $self->{url} . '/' . $path; |
8f9facfe JN |
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}); | |
b26098fc | 176 | while (defined($_ = get_record($fh, "\0"))) { |
8f9facfe JN |
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 | ||
83c9433e AP |
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 | ||
8f9facfe JN |
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); | |
83c9433e | 332 | $self->apply_manualprops($m->{file_b}, $fbat); |
8f9facfe JN |
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); | |
2394e94e RK |
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}); | |
8f9facfe | 345 | my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat, |
2394e94e | 346 | $upa, $self->{r}); |
8f9facfe | 347 | print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q; |
83c9433e | 348 | $self->apply_manualprops($m->{file_b}, $fbat); |
8f9facfe JN |
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); | |
2394e94e RK |
365 | # workaround for a bug in svn serf backend, see comment in C() above |
366 | my $upa = $self->url_path($m->{file_a}); | |
8f9facfe | 367 | my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat, |
2394e94e | 368 | $upa, $self->{r}); |
8f9facfe JN |
369 | print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q; |
370 | $self->apply_autoprops($file, $fbat); | |
83c9433e | 371 | $self->apply_manualprops($m->{file_b}, $fbat); |
8f9facfe JN |
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; | |
83c9433e | 387 | $self->apply_manualprops($m->{file_b}, $fbat); |
8f9facfe JN |
388 | $self->chg_file($fbat, $m); |
389 | $self->close_file($fbat,undef,$self->{pool}); | |
390 | } | |
391 | ||
b8c78e2a JN |
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', | |
94b2ee1a | 403 | sha1_a => $m->{sha1_a}, sha1_b => '0' x $::oid_length, |
b8c78e2a | 404 | chg => 'D', file_b => $m->{file_b} |
47263f58 | 405 | }, $deletions); |
b8c78e2a JN |
406 | $self->A({ |
407 | mode_a => '000000', mode_b => $m->{mode_b}, | |
94b2ee1a | 408 | sha1_a => '0' x $::oid_length, sha1_b => $m->{sha1_b}, |
b8c78e2a | 409 | chg => 'A', file_b => $m->{file_b} |
47263f58 | 410 | }, $deletions); |
b8c78e2a JN |
411 | return; |
412 | } | |
413 | ||
414 | $self->M($m, $deletions); | |
415 | } | |
8f9facfe JN |
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"}; | |
94b2ee1a | 437 | return ($fh,) if ($blob =~ /^0+$/); |
8f9facfe JN |
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 | ||
d301f181 JN |
545 | =head1 NAME |
546 | ||
8f9facfe JN |
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, | |
47092c10 | 588 | the core L<Carp> module, |
8f9facfe JN |
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. |