PageRenderTime 74ms CodeModel.GetById 25ms RepoModel.GetById 0ms app.codeStats 0ms

/SVK-v2.2.3/lib/SVK/Editor/Merge.pm

#
Perl | 1045 lines | 782 code | 169 blank | 94 comment | 132 complexity | dc6de0a9b0bae3ad021ed72e43ad6447 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0
  1. # BEGIN BPS TAGGED BLOCK {{{
  2. # COPYRIGHT:
  3. #
  4. # This software is Copyright (c) 2003-2008 Best Practical Solutions, LLC
  5. # <clkao@bestpractical.com>
  6. #
  7. # (Except where explicitly superseded by other copyright notices)
  8. #
  9. #
  10. # LICENSE:
  11. #
  12. #
  13. # This program is free software; you can redistribute it and/or
  14. # modify it under the terms of either:
  15. #
  16. # a) Version 2 of the GNU General Public License. You should have
  17. # received a copy of the GNU General Public License along with this
  18. # program. If not, write to the Free Software Foundation, Inc., 51
  19. # Franklin Street, Fifth Floor, Boston, MA 02110-1301 or visit
  20. # their web page on the internet at
  21. # http://www.gnu.org/copyleft/gpl.html.
  22. #
  23. # b) Version 1 of Perl's "Artistic License". You should have received
  24. # a copy of the Artistic License with this package, in the file
  25. # named "ARTISTIC". The license is also available at
  26. # http://opensource.org/licenses/artistic-license.php.
  27. #
  28. # This work is distributed in the hope that it will be useful, but
  29. # WITHOUT ANY WARRANTY; without even the implied warranty of
  30. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  31. # General Public License for more details.
  32. #
  33. # CONTRIBUTION SUBMISSION POLICY:
  34. #
  35. # (The following paragraph is not intended to limit the rights granted
  36. # to you to modify and distribute this software under the terms of the
  37. # GNU General Public License and is only of importance to you if you
  38. # choose to contribute your changes and enhancements to the community
  39. # by submitting them to Best Practical Solutions, LLC.)
  40. #
  41. # By intentionally submitting any modifications, corrections or
  42. # derivatives to this work, or any other work intended for use with SVK,
  43. # to Best Practical Solutions, LLC, you confirm that you are the
  44. # copyright holder for those contributions and you grant Best Practical
  45. # Solutions, LLC a nonexclusive, worldwide, irrevocable, royalty-free,
  46. # perpetual, license to use, copy, create derivative works based on
  47. # those contributions, and sublicense and distribute those contributions
  48. # and any derivatives thereof.
  49. #
  50. # END BPS TAGGED BLOCK }}}
  51. package SVK::Editor::Merge;
  52. use strict;
  53. use SVK::Version; our $VERSION = $SVK::VERSION;
  54. use base 'SVK::Editor';
  55. use SVK::I18N;
  56. use SVK::Logger;
  57. use autouse 'SVK::Util'
  58. => qw( slurp_fh md5_fh tmpfile devnull abs2rel );
  59. __PACKAGE__->mk_accessors(qw(inspector static_inspector notify storage ticket cb_merged));
  60. use Class::Autouse qw(SVK::Inspector::Root SVK::Notify
  61. Data::Hierarchy IO::Digest);
  62. use constant FH => 0;
  63. use constant FILENAME => 1;
  64. use constant CHECKSUM => 2;
  65. =head1 NAME
  66. SVK::Editor::Merge - An editor that does merges for the storage editor
  67. =head1 SYNOPSIS
  68. $editor = SVK::Editor::Merge->new
  69. ( anchor => $anchor,
  70. base_anchor => $base_anchor,
  71. base_root => $fs->revision_root ($arg{fromrev}),
  72. target => $target,
  73. storage => $storage_editor,
  74. %cb,
  75. );
  76. =head1 DESCRIPTION
  77. Given the base root and callbacks for local tree, SVK::Editor::Merge
  78. forwards the incoming editor calls to the storage editor for modifying
  79. the local tree, and merges the tree delta and text delta
  80. transparently.
  81. =head1 PARAMETERS
  82. =head2 options for base and target tree
  83. =over
  84. =item anchor
  85. The anchor of the target tree.
  86. =item target
  87. The target path component of the target tree.
  88. =item base_anchor
  89. The anchor of the base tree.
  90. =item base_root
  91. The root object of the base tree.
  92. =item storage
  93. The editor that will receive the merged callbacks.
  94. =item allow_conflicts
  95. Close the editor instead of abort when there are conflicts.
  96. =item open_nonexist
  97. open the directory even if cb_exist failed. This is for use in
  98. conjunction with L<SVK::Editor::Rename> for the case that a descendent
  99. exists but its parent does not.
  100. =item inspector
  101. The inspector reflecting the target of the merge.
  102. =back
  103. =head2 callbacks for local tree
  104. Since the merger needs to have information about the local tree, some
  105. callbacks must be supplied.
  106. =over
  107. =item cb_rev
  108. Check the revision of the given path.
  109. =item cb_conflict
  110. When a conflict is detected called with path and conflict
  111. type as argument. At this point type can be either 'node' or
  112. 'prop'.
  113. =item cb_prop_merged
  114. Called when properties are merged without changes, that is, the C<g>
  115. status.
  116. =item cb_merged
  117. Called right before closing the target with changes flag, node type and
  118. ticket.
  119. =item cb_closed
  120. Called after each file close call.
  121. =back
  122. =cut
  123. use Digest::MD5 qw(md5_hex);
  124. use File::Compare ();
  125. sub new {
  126. my $class = shift;
  127. my $self = $class->SUPER::new(ref $_[0] ? @_ :{@_});
  128. if ($self->storage->can('rename_check')) {
  129. my $editor = $self->storage;
  130. $self->inspector_translate
  131. (sub { $_[0] = $editor->rename_check($_[0])});
  132. my $flush = $self->notify->{cb_flush};
  133. $self->notify->{cb_flush} = sub {
  134. my ($path, $st) = @_;
  135. my $newpath = $self->storage->rename_check($path);
  136. $flush->($path, $st, $path eq $newpath ? undef : $newpath) };
  137. }
  138. return $self;
  139. }
  140. sub cb_for_root {
  141. my ($class, $root, $anchor, $base_rev) = @_;
  142. # XXX $root and $anchor are actually SVK::Path
  143. my $inspector = SVK::Inspector::Root->new({
  144. root => $root,
  145. anchor => $anchor,
  146. });
  147. return (
  148. inspector => $inspector,
  149. cb_rev => sub { $base_rev },
  150. );
  151. }
  152. sub inspector_translate {
  153. my ($self, $translate) = @_;
  154. # XXX: should do a real clone and then push
  155. $self->inspector($self->inspector->new($self->inspector));
  156. $self->inspector->path_translations([]);
  157. $self->inspector->push_translation($translate);
  158. for (qw/cb_conflict/) {
  159. my $sub = $self->{$_};
  160. next unless $sub;
  161. $self->{$_} = sub { my $path = shift; $translate->($path);
  162. unshift @_, $path; goto &$sub };
  163. }
  164. }
  165. sub copy_info {
  166. my ($self, $src_from, $src_fromrev, $dst_from, $dst_fromrev) = @_;
  167. $self->{copy_info}{$src_from}{$src_fromrev} = [$dst_from, $dst_fromrev];
  168. }
  169. sub set_target_revision {
  170. my ($self, $revision) = @_;
  171. $self->{revision} = $revision;
  172. $self->{storage}->set_target_revision ($revision);
  173. }
  174. sub set_ticket {
  175. my ($self, $baton, $type, $pool) = @_;
  176. my $func = "change_${type}_prop";
  177. $self->{storage}->$func( $baton, 'svk:merge', $self->ticket->as_string, $pool );
  178. }
  179. sub open_root {
  180. my ($self, $baserev, $pool) = @_;
  181. $self->{baserev} = $baserev;
  182. $self->{notify} ||= SVK::Notify->new_with_report ($self->{report}, $self->{target});
  183. $self->{storage_baton}{''} =
  184. $self->{storage}->open_root ($self->{cb_rev}->($self->{target}||''));
  185. $self->{notify}->node_status ('', '');
  186. $self->{dh} = Data::Hierarchy->new;
  187. $self->set_ticket($self->{storage_baton}{''}, 'dir', $pool)
  188. if !length $self->{target} && $self->ticket;
  189. return '';
  190. }
  191. sub add_file {
  192. my ($self, $path, $pdir, @arg) = @_;
  193. unless ( defined $pdir ) {
  194. ++$self->{skipped};
  195. $self->{notify}->flush ($path);
  196. return undef;
  197. }
  198. return unless defined $pdir;
  199. my $pool = pop @arg;
  200. # a replaced node shouldn't be checked with cb_exist
  201. my $spool = SVN::Pool->new_default($pool);
  202. my $touched = $self->{notify}->node_status($path);
  203. if (!$self->{added}{$pdir} && !$touched &&
  204. (my $kind = $self->inspector->exist($path, $spool))) {
  205. unless ($kind == $SVN::Node::file) {
  206. $self->{notify}->flush ($path) ;
  207. return undef;
  208. }
  209. $self->{info}{$path}{addmerge} = 1;
  210. $self->{info}{$path}{open} = [$pdir, -1];
  211. $self->{info}{$path}{fpool} = $pool;
  212. if (defined $arg[0]) {
  213. warn "===> add merge with history... very bad";
  214. }
  215. $self->{cb_add_merged}->($path) if $self->{cb_add_merged};
  216. }
  217. else {
  218. ++$self->{changes};
  219. $self->{added}{$path} = 1;
  220. $self->{notify}->node_status ($path, $touched ? 'R' : 'A');
  221. if (defined $arg[0]) {
  222. $self->{notify}->hist_status ($path, '+');
  223. @arg = $self->resolve_copy($path, @arg);
  224. $self->{info}{$path}{baseinfo} = [$self->resolve_base($path, 0, $pool)];
  225. $self->{info}{$path}{fpool} = $pool;
  226. }
  227. $self->{storage_baton}{$path} =
  228. $self->{storage}->add_file ($path, $self->{storage_baton}{$pdir}, @arg, $pool);
  229. # XXX: Why was this here? All tests pass without it.
  230. #$pool->default if $pool && $pool->can ('default');
  231. # XXX: fpool is used for testing if the file is open rather than add,
  232. # so use another field to hold it.
  233. $self->{info}{$path}{hold_pool} = $pool;
  234. }
  235. return $path;
  236. }
  237. sub _resolve_base {
  238. my ($self, $path, $orig) = @_;
  239. my ($entry) = $self->{dh}->get("/$path");
  240. return unless $entry->{copyanchor};
  241. $entry = $self->{dh}->get($entry->{copyanchor})
  242. unless $entry->{copyanchor} eq "/$path";
  243. my $key = $orig ? 'orig_copyfrom' : 'copyfrom';
  244. return (abs2rel("/$path",
  245. $entry->{copyanchor} => $entry->{".$key"}, '/'),
  246. $entry->{".${key}_rev"});
  247. }
  248. sub resolve_base {
  249. my ($self, $path, $orig, $pool) = @_;
  250. my ($basepath, $fromrev) = $self->_resolve_base($path, $orig);
  251. if ($basepath) {
  252. # if the inspector is involving copy base, we can't use
  253. # $self->inspector, as it represent the current txn
  254. return ($basepath, $fromrev, $self->static_inspector);
  255. }
  256. return ($path, undef, $self->inspector)
  257. }
  258. sub open_file {
  259. my ($self, $path, $pdir, $rev, $pool) = @_;
  260. # modified but rm locally - tag for conflict?
  261. my ($basepath, $fromrev, $inspector) = $self->resolve_base($path);
  262. if (defined $pdir && $inspector->exist($basepath, $pool) == $SVN::Node::file) {
  263. $self->{info}{$path}{baseinfo} = [$basepath, $fromrev, $inspector]
  264. if defined $fromrev;
  265. $self->{info}{$path}{open} = [$pdir, $rev];
  266. $self->{info}{$path}{fpool} = $pool;
  267. $self->{notify}->node_status ($path, '');
  268. $pool->default if $pool && $pool->can ('default');
  269. return $path;
  270. }
  271. ++$self->{skipped};
  272. $self->{notify}->flush ($path);
  273. return undef;
  274. }
  275. sub ensure_open {
  276. my ($self, $path) = @_;
  277. return unless $self->{info}{$path}{open};
  278. my ($pdir, $rev, $pool) = (@{$self->{info}{$path}{open}},
  279. $self->{info}{$path}{fpool});
  280. $self->{storage_baton}{$path} ||=
  281. $self->{storage}->open_file ($path, $self->{storage_baton}{$pdir},
  282. $self->{cb_rev}->($path), $pool);
  283. ++$self->{changes};
  284. delete $self->{info}{$path}{open}; #
  285. $self->set_ticket( $self->{storage_baton}{$path}, 'file', $pool )
  286. if $path eq $self->{target} && $self->ticket;
  287. }
  288. sub ensure_close {
  289. my ($self, $path, $checksum, $pool) = @_;
  290. $self->cleanup_fh ($self->{info}{$path}{fh});
  291. $self->{notify}->flush ($path, 1);
  292. $self->{cb_closed}->($path, $checksum, $pool)
  293. if $self->{cb_closed};
  294. if ($path eq $self->{target} && $self->cb_merged) {
  295. $self->ensure_open ($path);
  296. $self->cb_merged->($self->{changes},'file', $self->{ticket});
  297. }
  298. if (my $baton = $self->{storage_baton}{$path}) {
  299. $self->{storage}->close_file ($baton, $checksum, $pool);
  300. delete $self->{storage_baton}{$path};
  301. }
  302. delete $self->{info}{$path};
  303. }
  304. sub node_conflict {
  305. my ($self, $path) = @_;
  306. $self->{cb_conflict}->($path, 'node') if $self->{cb_conflict};
  307. ++$self->{conflicts};
  308. $self->{notify}->node_status ($path, 'C');
  309. }
  310. sub cleanup_fh {
  311. my ($self, $fh) = @_;
  312. for (qw/base new local/) {
  313. close $fh->{$_}[FH]
  314. if $fh->{$_}[FH];
  315. }
  316. }
  317. sub prepare_fh {
  318. my ($self, $fh, $eol) = @_;
  319. for my $name (qw/base new local/) {
  320. my $entry = $fh->{$name};
  321. next unless $entry->[FH];
  322. # if there's eol translation required, we can't use the
  323. # prepared tmp files.
  324. if ($entry->[FILENAME]) {
  325. next unless $eol;
  326. # reopen the tmp file, since apply_textdelta closes it
  327. open $entry->[FH], $entry->[FILENAME];
  328. }
  329. my $tmp = [tmpfile("$name-"), $entry->[CHECKSUM]];
  330. binmode $tmp->[FH], $eol if $eol;
  331. slurp_fh ($entry->[FH], $tmp->[FH]);
  332. close $entry->[FH];
  333. $entry = $fh->{$name} = $tmp;
  334. seek $entry->[FH], 0, 0;
  335. }
  336. }
  337. sub _retrieve_base
  338. {
  339. my ($self, $path, $pool) = @_;
  340. my @base = tmpfile('base-');
  341. my ($basepath, $fromrev) = $self->{info}{$path}{baseinfo} ?
  342. $self->_resolve_base($path, 1)
  343. : ($path);
  344. my $root = $fromrev ? $self->{base_root}->fs->revision_root($fromrev, $pool)
  345. : $self->{base_root};
  346. $basepath = "$self->{base_anchor}/$path"
  347. if $basepath !~ m{^/} && $self->{base_anchor};
  348. slurp_fh ($root->file_contents ($basepath, $pool), $base[FH]);
  349. seek $base[FH], 0, 0;
  350. return @base;
  351. }
  352. sub apply_textdelta {
  353. my ($self, $path, $checksum, $ppool) = @_;
  354. return unless $path;
  355. my $info = $self->{info}{$path};
  356. my ($basepath, $fromrev, $inspector) = $info->{baseinfo} ? @{$info->{baseinfo}} : ($path, undef, $self->inspector);
  357. my $fh = $info->{fh} = {};
  358. my $pool = $info->{fpool};
  359. if ($pool && ($fh->{local} = $inspector->localmod($basepath, $checksum || '', $pool))) {
  360. # retrieve base
  361. unless ($info->{addmerge}) {
  362. $fh->{base} = [$self->_retrieve_base($path, $pool)];
  363. }
  364. # get new
  365. $fh->{new} = [tmpfile('new-')];
  366. return [SVN::TxDelta::apply ($fh->{base}[FH], $fh->{new}[FH], undef, undef, $pool)];
  367. }
  368. $self->{notify}->node_status ($path, 'U')
  369. unless $self->{notify}->node_status ($path);
  370. $self->ensure_open ($path);
  371. my $handle = $self->{storage}->apply_textdelta ($self->{storage_baton}{$path},
  372. $checksum, $ppool);
  373. if ($self->{storage_has_unwritable} && !$handle) {
  374. delete $self->{notify}{status}{$path};
  375. $self->{notify}->flush ($path);
  376. }
  377. return $handle;
  378. }
  379. sub _merge_text_change {
  380. my ($self, $fh, $label, $pool) = @_;
  381. my $diff = SVN::Core::diff_file_diff3
  382. (map {$fh->{$_}[FILENAME]} qw/base local new/);
  383. my $mfh = tmpfile ('merged-');
  384. my $marker = time.int(rand(100000));
  385. my $ylabel
  386. = ref($self->{inspector}) eq 'SVK::Inspector::Compat'
  387. ? $label
  388. : $label . ' (' . $self->{inspector}->{anchor}.')'
  389. ;
  390. my $tlabel = $label . ' (' . $self->{anchor}.')';
  391. SVN::Core::diff_file_output_merge
  392. ( $mfh, $diff,
  393. (map {
  394. $fh->{$_}[FILENAME]
  395. } qw/base local new/),
  396. "==== ORIGINAL VERSION $label $marker",
  397. ">>>> YOUR VERSION $ylabel $marker",
  398. "<<<< $marker",
  399. "==== THEIR VERSION $tlabel $marker",
  400. 1, 0, $pool);
  401. my $conflict = SVN::Core::diff_contains_conflicts ($diff);
  402. $conflict ||= $self->{tree_conflict};
  403. if (my $resolve = $self->{resolve}) {
  404. $resolve->run
  405. ( fh => $fh,
  406. mfh => $mfh,
  407. path => $label,
  408. marker => $marker,
  409. # Do not run resolve for diffs with no conflicts
  410. ($conflict ? (has_conflict => 1) : ()),
  411. );
  412. $conflict = 0 if $resolve->{merged};
  413. my $mfn = $resolve->{merged} || $resolve->{conflict};
  414. open $mfh, '<:raw', $mfn or die "Cannot read $mfn: $!" if $mfn;
  415. }
  416. seek $mfh, 0, 0; # for skipped
  417. return ($conflict, $mfh);
  418. }
  419. sub _overwrite_local_file {
  420. my ($self, $fh, $path, $nfh, $pool) = @_;
  421. # XXX: document why this is like this
  422. my $storagebase = $fh->{local};
  423. my $info = $self->{info}{$path};
  424. my ($basepath, $fromrev) = $info->{baseinfo} ? @{$info->{baseinfo}} : ($path);
  425. if ($fromrev) {
  426. my $sbroot = $self->{base_root}->fs->revision_root($fromrev, $pool);
  427. $storagebase->[FH] = $sbroot->file_contents($basepath, $pool);
  428. $storagebase->[CHECKSUM] = $sbroot->file_md5_checksum($basepath, $pool);
  429. }
  430. my $handle = $self->{storage}->
  431. apply_textdelta ($self->{storage_baton}{$path},
  432. $storagebase->[CHECKSUM], $pool);
  433. if ($handle && $#{$handle} >= 0) {
  434. if ($self->{send_fulltext}) {
  435. SVN::TxDelta::send_stream ($nfh, @$handle, $pool);
  436. }
  437. else {
  438. seek $storagebase->[FH], 0, 0 unless $fromrev; # don't seek for sb
  439. my $txstream = SVN::TxDelta::new($fh->{local}[FH], $nfh, $pool);
  440. SVN::TxDelta::send_txstream ($txstream, @$handle, $pool);
  441. }
  442. return 1;
  443. }
  444. if ($self->{storage_has_unwritable}) {
  445. delete $self->{notify}{status}{$path};
  446. $self->{notify}->flush ($path);
  447. return 0;
  448. }
  449. return 1;
  450. }
  451. sub _merge_file_unchanged {
  452. my ($self, $path, $checksum, $pool) = @_;
  453. ++$self->{changes} unless $self->{g_merge_no_a_change};
  454. $self->{notify}->node_status ($path, 'g');
  455. $self->ensure_close ($path, $checksum, $pool);
  456. return;
  457. }
  458. sub close_file {
  459. my ($self, $path, $checksum, $pool) = @_;
  460. return unless $path;
  461. my $info = $self->{info}{$path};
  462. my $fh = $info->{fh};
  463. my $iod;
  464. my ($basepath, $fromrev, $inspector) = $info->{baseinfo} ? @{$info->{baseinfo}} : ($path, undef, $self->inspector);
  465. no warnings 'uninitialized';
  466. my $storagebase_checksum = $fh->{local}[CHECKSUM];
  467. if ($fromrev) {
  468. $storagebase_checksum = $self->{base_root}->fs->revision_root
  469. ($fromrev, $pool)->file_md5_checksum($basepath, $pool);
  470. }
  471. # let close_directory reports about its children
  472. if ($info->{fh}{new}) {
  473. $self->_merge_file_unchanged ($path, $checksum, $pool), return
  474. if $checksum eq $storagebase_checksum;
  475. my $eol = $inspector->localprop($basepath, 'svn:eol-style', $pool);
  476. my $eol_layer = SVK::XD::get_eol_layer({'svn:eol-style' => $eol}, '>');
  477. $eol_layer = '' if $eol_layer eq ':raw';
  478. $self->prepare_fh ($fh, $eol_layer);
  479. # XXX: There used be a case that this explicit comparison is
  480. # needed, but i'm not sure anymore.
  481. $self->_merge_file_unchanged ($path, $checksum, $pool), return
  482. if File::Compare::compare ($fh->{new}[FILENAME], $fh->{local}->[FILENAME]) == 0;
  483. $self->ensure_open ($path);
  484. if ($info->{addmerge}) {
  485. $fh->{base}[FILENAME] = devnull;
  486. open $fh->{base}[FH], '<', $fh->{base}[FILENAME];
  487. }
  488. my ($conflict, $mfh) = $self->_merge_text_change ($fh, $path, $pool);
  489. $self->{notify}->node_status ($path, $conflict ? 'C' : 'G');
  490. $eol_layer = SVK::XD::get_eol_layer({'svn:eol-style' => $eol}, '<');
  491. binmode $mfh, $eol_layer or die $! if $eol_layer;
  492. $iod = IO::Digest->new ($mfh, 'MD5');
  493. if ($self->_overwrite_local_file ($fh, $path, $mfh, $pool)) {
  494. undef $fh->{base}[FILENAME] if $info->{addmerge};
  495. $self->node_conflict ($path) if $conflict;
  496. }
  497. $self->cleanup_fh ($fh);
  498. }
  499. elsif ($info->{fpool}) {
  500. if (!$self->{notify}->node_status($path) || !exists $fh->{local} ) {
  501. # open but without text edit, load local checksum
  502. if ($basepath ne $path) {
  503. $checksum = $self->{base_root}->fs->revision_root($fromrev, $pool)->file_md5_checksum($basepath, $pool);
  504. }
  505. elsif (my $local = $inspector->localmod($basepath, $checksum, $pool)) {
  506. $checksum = $local->[CHECKSUM];
  507. close $local->[FH];
  508. }
  509. }
  510. }
  511. $checksum = $iod->hexdigest if $iod;
  512. $self->ensure_close ($path, $checksum, $pool);
  513. }
  514. sub add_directory {
  515. my ($self, $path, $pdir, @arg) = @_;
  516. unless ( defined $pdir ) {
  517. ++$self->{skipped};
  518. $self->{notify}->flush ($path);
  519. return undef;
  520. }
  521. my $pool = pop @arg;
  522. my $touched = $self->{notify}->node_status($path);
  523. # This comes from R (D+A) where the D has conflict
  524. if ($touched && $touched eq 'C') {
  525. return undef;
  526. }
  527. # Don't bother calling cb_exist (which might be expensive if the parent is
  528. # already added.
  529. if (!$self->{added}{$pdir} && !$touched &&
  530. (my $kind = $self->inspector->exist($path, $pool))) {
  531. unless ($kind == $SVN::Node::dir) {
  532. $self->{notify}->flush ($path) ;
  533. return undef;
  534. }
  535. $self->{storage_baton}{$path} =
  536. $self->{storage}->open_directory ($path, $self->{storage_baton}{$pdir},
  537. $self->{cb_rev}->($path), $pool);
  538. $self->{notify}->node_status ($path, 'G');
  539. $self->{cb_add_merged}->($path) if $self->{cb_add_merged};
  540. }
  541. else {
  542. if (defined $arg[0]) {
  543. @arg = $self->resolve_copy($path, @arg);
  544. }
  545. my $baton =
  546. $self->{storage}->add_directory ($path, $self->{storage_baton}{$pdir},
  547. @arg, $pool);
  548. unless (defined $baton) {
  549. $self->{notify}->flush ($path);
  550. return undef;
  551. }
  552. $self->{storage_baton}{$path} = $baton;
  553. $self->{added}{$path} = 1;
  554. $self->{notify}->hist_status ($path, '+')
  555. if defined $arg[0];
  556. $self->{notify}->node_status ($path, $touched ? 'R' : 'A');
  557. $self->{notify}->flush ($path, 1);
  558. }
  559. ++$self->{changes};
  560. return $path;
  561. }
  562. sub resolve_copy {
  563. my ($self, $path, $from, $rev) = @_;
  564. die "unknown copy $from $rev for $path"
  565. unless exists $self->{copy_info}{$from}{$rev};
  566. my ($dstfrom, $dstrev) = @{$self->{copy_info}{$from}{$rev}};
  567. $self->{dh}->store("/$path", { copyanchor => "/$path",
  568. '.copyfrom' => $dstfrom,
  569. '.copyfrom_rev' => $dstrev,
  570. '.orig_copyfrom' => $from,
  571. '.orig_copyfrom_rev' => $rev,
  572. });
  573. return $self->{cb_copyfrom}->($dstfrom, $dstrev)
  574. if $self->{cb_copyfrom};
  575. return ($dstfrom, $dstrev);
  576. }
  577. sub open_directory {
  578. my ($self, $path, $pdir, $rev, @arg) = @_;
  579. my $pool = $arg[-1];
  580. unless ($self->{open_nonexist}) {
  581. return undef unless defined $pdir;
  582. my ($basepath, $fromrev, $inspector) = $self->resolve_base($path);
  583. unless ($inspector->exist($basepath, $pool) || $self->{open_nonexist}) {
  584. ++$self->{skipped};
  585. $self->{notify}->flush ($path);
  586. return undef;
  587. }
  588. }
  589. $self->{notify}->node_status ($path, '');
  590. my $baton = $self->{storage_baton}{$path} =
  591. $self->{storage}->open_directory ($path, $self->{storage_baton}{$pdir},
  592. $self->{cb_rev}->($path), @arg);
  593. $self->set_ticket($baton, 'dir', $pool)
  594. if $path eq $self->{target} && $self->ticket;
  595. return $path;
  596. }
  597. sub close_directory {
  598. my ($self, $path, $pool) = @_;
  599. return unless defined $path;
  600. no warnings 'uninitialized';
  601. delete $self->{added}{$path};
  602. $self->{notify}->flush_dir ($path);
  603. my $baton = $self->{storage_baton}{$path};
  604. $self->cb_merged->( $self->{changes}, 'dir', $self->{ticket})
  605. if $path eq $self->{target} && $self->cb_merged;
  606. $self->{storage}->close_directory ($baton, $pool);
  607. delete $self->{storage_baton}{$path}
  608. unless $path eq '';
  609. }
  610. sub _merge_file_delete {
  611. my ($self, $path, $rpath, $pdir, $pool) = @_;
  612. my ($basepath, $fromrev, $inspector) = $self->resolve_base($path);
  613. my $no_base;
  614. my $md5 = $self->{base_root}->check_path ($rpath, $pool)?
  615. $self->{base_root}->file_md5_checksum ($rpath, $pool)
  616. : do { $no_base = 1; require Digest::MD5; Digest::MD5::md5_hex('') };
  617. return undef unless $inspector->localmod ($basepath, $md5, $pool);
  618. return {} unless $self->{resolve};
  619. my $fh = $self->{info}{$path}->{fh} || {};
  620. $fh->{base} ||= [$no_base? (tmpfile('base-')): ($self->_retrieve_base($path, $pool))];
  621. $fh->{new} = [tmpfile('new-')];
  622. $fh->{local} = [tmpfile('local-')];
  623. my ($tmp) = $inspector->localmod($basepath, '', $pool);
  624. slurp_fh ( $tmp->[FH], $fh->{local}[FH]);
  625. seek $fh->{local}[FH], 0, 0;
  626. $fh->{local}[CHECKSUM] = $tmp->[CHECKSUM];
  627. my ($conflict, $mfh) = $self->_merge_text_change( $fh, $path, $pool);
  628. if( $conflict ) {
  629. $self->clean_up($fh);
  630. return {};
  631. } elsif( !(stat($mfh))[7] ) {
  632. #delete file if merged size is 0
  633. $self->clean_up($fh);
  634. return undef;
  635. }
  636. seek $mfh, 0, 0;
  637. my $iod = IO::Digest->new ($mfh, 'MD5');
  638. $self->{info}{$path}{open} = [$pdir, -1];
  639. $self->{info}{$path}{fpool} = $pool;
  640. $self->ensure_open ($path);
  641. $self->_overwrite_local_file ($fh, $path, $mfh, $pool);
  642. ++$self->{changes};
  643. $self->ensure_close ($path, $iod->hexdigest, $pool);
  644. return 1;
  645. }
  646. # return a hash for partial delete
  647. # returns undef for deleting this
  648. # returns 1 for merged delete (user changed content and we leave node)
  649. # Note that empty hash means don't delete - conflict.
  650. sub _check_delete_conflict {
  651. my ($self, $path, $rpath, $kind, $pdir, $pool) = @_;
  652. my $localkind = $self->inspector->exist ($path, $pool);
  653. # node doesn't exist in dst
  654. return undef unless $localkind;
  655. # deleting, but local node is of different type already
  656. # original node could be moved to different place
  657. # Editor::Rename should track the latter case
  658. # XXX: prompt for resolution
  659. return {} if $kind && $kind != $localkind;
  660. return $self->_merge_file_delete ($path, $rpath, $pdir, $pool) if $localkind == $SVN::Node::file;
  661. # TODO: checkouts may have unversioned files/dirs under the dir we are going to delete
  662. # we still has no interactive resolver for this
  663. return {} unless $localkind == $SVN::Node::dir;
  664. # it's dir...
  665. my $dirmodified = $self->inspector->dirdelta ($path, $self->{base_root}, $rpath, $pool);
  666. my $entries = $self->{base_root}->dir_entries ($rpath, $pool);
  667. my $baton = $self->{storage_baton}{$path} = $self->{storage}->open_directory (
  668. $path, $self->{storage_baton}{$pdir}, $self->{cb_rev}->($path), $pool
  669. );
  670. my $torm;
  671. for my $name (sort keys %$entries) {
  672. my ($cpath, $crpath) = ("$path/$name", "$rpath/$name");
  673. my $entry = $entries->{$name};
  674. if (my $mod = $dirmodified->{$name}) {
  675. if ($mod eq 'D') {
  676. $torm->{$name} = undef;
  677. }
  678. else {
  679. $torm->{$name} = $self->_check_delete_conflict ($cpath, $crpath, $entry->kind, $path, SVN::Pool->new_default($pool));
  680. }
  681. delete $dirmodified->{$name};
  682. }
  683. else { # dir or unmodified file
  684. $torm->{$name} = $self->_check_delete_conflict
  685. ($cpath, $crpath, $entry->kind, $path, SVN::Pool->new_default($pool));
  686. }
  687. }
  688. foreach my $node (keys %$dirmodified) {
  689. local $self->{tree_conflict} = 1;
  690. my ($cpath, $crpath) = ("$path/$node", "$rpath/$node");
  691. my $kind = $self->{base_root}->check_path ($crpath);
  692. $torm->{$node} = $self->_check_delete_conflict ($cpath, $crpath, $kind, $path, SVN::Pool->new_default($pool));
  693. }
  694. $self->{storage}->close_directory ($baton, $pool);
  695. return $torm;
  696. }
  697. sub _partial_delete {
  698. my ($self, $torm, $path, $pbaton, $pool, $no_status) = @_;
  699. unless (ref $torm) {
  700. my $s;
  701. if ($torm && $torm == 1) {
  702. $s = 'G';
  703. } else {
  704. if ($self->inspector->exist($path, $pool)) {
  705. $self->{storage}->delete_entry (
  706. $path, $self->{cb_rev}->($path), $pbaton, $pool
  707. );
  708. }
  709. $s = 'D';
  710. }
  711. $self->{notify}->node_status($path, $s) unless $no_status;
  712. return $s;
  713. } elsif (!keys %$torm) {
  714. $self->node_conflict($path) unless $no_status;
  715. return 'C';
  716. }
  717. # it's dir...
  718. my $baton = $self->{storage}->open_directory ($path, $pbaton, $self->{cb_rev}->($path), $pool);
  719. my $summary = '';
  720. my @children_stats;
  721. my $skip_children = 1;
  722. for (sort keys %$torm) {
  723. my $cpath = "$path/$_";
  724. # check that out
  725. my $status = $self->_partial_delete ($torm->{$_}, $cpath, $baton, SVN::Pool->new_default($pool), 1);
  726. push @children_stats, [$cpath, $status];
  727. $skip_children = 0 unless $status eq 'D';
  728. $summary = 'C' if $status eq 'C';
  729. $summary = 'G' if !$summary && $status eq 'G';
  730. }
  731. $summary ||= 'D';
  732. $self->{storage}->close_directory ($baton, $pool);
  733. if ($summary eq 'D') {
  734. if ($self->inspector->exist($path, $pool)) {
  735. $self->{storage}->delete_entry ($path, $self->{cb_rev}->($path), $pbaton, $pool);
  736. }
  737. $self->{notify}->node_status ($path, 'D') unless $no_status;
  738. }
  739. elsif ($summary eq 'C') {
  740. $self->node_conflict ($path) unless $no_status;
  741. }
  742. elsif ($summary eq 'G') {
  743. $self->{notify}->node_status ($path, 'G') unless $no_status;
  744. }
  745. else { # really should be assert
  746. $self->node_conflict ($path) unless $no_status;
  747. $summary = 'C';
  748. }
  749. unless ($skip_children) {
  750. foreach (@children_stats) {
  751. if ($_->[1] ne 'C') {
  752. $self->{notify}->node_status (@$_);
  753. } else {
  754. $self->node_conflict ($_->[0]);
  755. }
  756. }
  757. }
  758. return $summary;
  759. }
  760. sub delete_entry {
  761. my ($self, $path, $revision, $pdir, $pool) = @_;
  762. no warnings 'uninitialized';
  763. $pool = SVN::Pool->new_default($pool);
  764. my ($basepath, $fromrev, $inspector) = $self->resolve_base($path);
  765. return unless defined $pdir && $inspector->exist($basepath);
  766. my $rpath = $basepath =~ m{^/} ? $basepath :
  767. $self->{base_anchor} eq '/' ? "/$basepath" : "$self->{base_anchor}/$basepath";
  768. my $torm;
  769. # XXX: need txn-aware cb_*! for the case current path is from a
  770. # copy and to be deleted - Note this might have been done, exam it.
  771. {
  772. # XXX: this is too evil
  773. local $self->{base_root} = $self->{base_root}->fs->revision_root($fromrev) if $basepath ne $path;
  774. my $kind = $self->{base_root}->check_path ($rpath);
  775. $torm = $self->_check_delete_conflict ($path, $rpath, $kind, $pdir, $pool);
  776. }
  777. $self->_partial_delete ($torm, $path, $self->{storage_baton}{$pdir}, $pool);
  778. ++$self->{changes};
  779. }
  780. sub _prop_eq {
  781. my ($prop1, $prop2) = @_;
  782. return 0 if defined $prop1 xor defined $prop2;
  783. return defined $prop1 ? ($prop1 eq $prop2) : 1;
  784. }
  785. sub _merge_prop_content {
  786. my ($self, $path, $propname, $prop, $pool) = @_;
  787. if (my $resolver = $self->{prop_resolver}{$propname}) {
  788. return $resolver->($path, $prop, $pool);
  789. }
  790. if (_prop_eq (@{$prop}{qw/base local/})) {
  791. return ('U', $prop->{new});
  792. }
  793. elsif (_prop_eq (@{$prop}{qw/new local/})) {
  794. return ('g', $prop->{local});
  795. }
  796. my $fh = { map {
  797. my $tgt = defined $prop->{$_} ? \$prop->{$_} : devnull;
  798. open my $f, '<', $tgt;
  799. ($_ => [$f, ref ($tgt) ? undef : $tgt]);
  800. } qw/base new local/ };
  801. $self->prepare_fh ($fh);
  802. my ($conflict, $mfh) = $self->_merge_text_change ($fh, loc ("Property %1 of %2", $propname, $path), $pool);
  803. return ($conflict ? 'C' : 'G', do { local $/; <$mfh> });
  804. }
  805. sub _merge_prop_change {
  806. my $self = shift;
  807. my $path = shift;
  808. my $pool;
  809. return unless defined $path;
  810. return if $_[0] =~ m/^svm:/;
  811. # special case the the root node that was actually been added
  812. if ($self->{added}{$path} or
  813. (!length ($path) and $self->{base_root}->is_revision_root
  814. and $self->{base_root}->revision_root_revision == 0)) {
  815. $self->{notify}->prop_status ($path, 'U') unless $self->{added}{$path};
  816. return 1;
  817. }
  818. my $rpath = $self->{base_anchor} eq '/' ? "/$path" : "$self->{base_anchor}/$path";
  819. my $prop;
  820. $prop->{new} = $_[1];
  821. my ($basepath, $fromrev) = $self->{info}{$path}{baseinfo} ? @{$self->{info}{$path}{baseinfo}} : ($path);
  822. {
  823. local $@;
  824. $prop->{base} = eval { $self->{base_root}->node_prop ($rpath, $_[0], $pool) };
  825. $prop->{local} = $self->inspector->exist($basepath, $pool)
  826. ? $self->inspector->localprop($basepath, $_[0], $pool) : undef;
  827. }
  828. # XXX: only known props should be auto-merged with default resolver
  829. $pool = pop @_ if ref ($_[-1]) =~ m/^(?:SVN::Pool|_p_apr_pool_t)$/;
  830. my ($status, $merged, $skipped) =
  831. $self->_merge_prop_content ($path, $_[0], $prop, $pool);
  832. return if $skipped;
  833. if ($status eq 'g') {
  834. $self->{cb_prop_merged}->($path, $_[0])
  835. if $self->{cb_prop_merged};
  836. }
  837. else {
  838. if ($status eq 'C') {
  839. $self->{cb_conflict}->($path, 'prop') if $self->{cb_conflict};
  840. ++$self->{conflicts};
  841. }
  842. $_[1] = $merged;
  843. }
  844. $self->{notify}->prop_status ($path, $status);
  845. ++$self->{changes};
  846. return $status eq 'g' ? 0 : 1;
  847. }
  848. sub change_file_prop {
  849. my ($self, $path, @arg) = @_;
  850. $self->_merge_prop_change ($path, @arg) or return;
  851. $self->ensure_open ($path);
  852. $self->{storage}->change_file_prop ($self->{storage_baton}{$path}, @arg);
  853. }
  854. sub change_dir_prop {
  855. my ($self, $path, @arg) = @_;
  856. $self->_merge_prop_change ($path, @arg) or return;
  857. $self->{storage}->change_dir_prop ($self->{storage_baton}{$path}, @arg);
  858. }
  859. sub close_edit {
  860. my ($self, @arg) = @_;
  861. if ($self->{allow_conflicts} ||
  862. (defined $self->{storage_baton}{''} && !$self->{conflicts}) && $self->{changes}) {
  863. $self->{storage}->close_edit(@arg);
  864. }
  865. else {
  866. $logger->warn(loc("Empty merge.")) unless $self->{notify}{quiet};
  867. $self->{storage}->abort_edit(@arg);
  868. }
  869. }
  870. =head1 BUGS
  871. =over
  872. =item Tree merge
  873. still very primitive, have to handle lots of cases
  874. =back
  875. =cut
  876. 1;