PageRenderTime 50ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 0ms

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

#
Perl | 422 lines | 335 code | 33 blank | 54 comment | 18 complexity | f7737b2922e49b27de6a11d5f5cd2ed3 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::Diff;
  52. use strict;
  53. use SVK::Version; our $VERSION = $SVK::VERSION;
  54. require SVN::Delta;
  55. use base 'SVK::Editor';
  56. use SVK::I18N;
  57. use autouse 'SVK::Util' => qw( slurp_fh tmpfile mimetype_is_text catfile abs2rel from_native);
  58. =head1 NAME
  59. SVK::Editor::Diff - An editor for producing textual diffs
  60. =head1 SYNOPSIS
  61. $editor = SVK::Editor::Diff->new
  62. ( base_root => $root,
  63. base_target => $target,
  64. cb_llabel => sub { ... },
  65. # or llabel => 'revision <left>',
  66. cb_rlabel => sub { ... },
  67. # or rlabel => 'revision <left>',
  68. oldtarget => $target, oldroot => $root,
  69. );
  70. $xd->depot_delta ( editor => $editor, ... );
  71. =cut
  72. sub set_target_revision {
  73. my ($self, $revision) = @_;
  74. }
  75. sub open_root {
  76. my ($self, $baserev) = @_;
  77. $self->{dh} = Data::Hierarchy->new;
  78. return '';
  79. }
  80. # XXX maybe this needs to be done more methodically
  81. sub _copyfrom_uri_to_path {
  82. my ($self, $from_path) = @_;
  83. my $repospath_start = "file://" . $self->{base_target}->repospath;
  84. $from_path =~ s/^\Q$repospath_start//;
  85. return $from_path;
  86. }
  87. sub add_file {
  88. my ($self, $path, $pdir, $from_path, $from_rev, $pool) = @_;
  89. if (defined $from_path) {
  90. $from_path = $self->_copyfrom_uri_to_path($from_path);
  91. $self->{info}{$path}{baseinfo} = [$from_path, $from_rev];
  92. $self->{dh}->store("/$path", { copyanchor => "/$path",
  93. '.copyfrom' => $from_path,
  94. '.copyfrom_rev' => $from_rev,
  95. });
  96. }
  97. else {
  98. $self->{info}{$path}{added} = 1;
  99. }
  100. $self->{info}{$path}{fpool} = $pool;
  101. return $path;
  102. }
  103. sub open_file {
  104. my ($self, $path, $pdir, $rev, $pool) = @_;
  105. $self->{info}{$path}{fpool} = $pool;
  106. my ($basepath, $fromrev) = $self->_resolve_base($path);
  107. $self->{info}{$path}{baseinfo} = [$basepath, $fromrev]
  108. if defined $fromrev;
  109. return $path;
  110. }
  111. sub _resolve_base {
  112. my ($self, $path) = @_;
  113. my ($entry) = $self->{dh}->get("/$path");
  114. return unless $entry->{copyanchor};
  115. $entry = $self->{dh}->get($entry->{copyanchor})
  116. unless $entry->{copyanchor} eq "/$path";
  117. my $key = 'copyfrom';
  118. return (abs2rel("/$path",
  119. $entry->{copyanchor} => $entry->{".$key"}, '/'),
  120. $entry->{".${key}_rev"});
  121. }
  122. sub retrieve_base {
  123. my ($self, $path, $pool) = @_;
  124. my ($basepath, $fromrev) = $self->{info}{$path}{baseinfo} ?
  125. $self->_resolve_base($path) : ($path);
  126. my $root = $fromrev ? $self->{base_root}->fs->revision_root($fromrev, $pool)
  127. : $self->{base_root};
  128. $basepath = $self->{base_target}->path_anchor."/$path"
  129. if $basepath !~ m{^/};
  130. return $root->file_contents("$basepath", $pool);
  131. }
  132. # XXX: cleanup
  133. sub retrieve_base_prop {
  134. my ($self, $path, $prop, $pool) = @_;
  135. my ($basepath, $fromrev) = $self->_resolve_base($path);
  136. $basepath = $path unless defined $basepath;
  137. my $root = $fromrev ? $self->{base_root}->fs->revision_root($fromrev, $pool)
  138. : $self->{base_root};
  139. $basepath = $self->{base_target}->path_anchor."/$path"
  140. if $basepath !~ m{^/};
  141. return $root->check_path($basepath, $pool) == $SVN::Node::none ?
  142. undef : $root->node_prop($basepath, $prop, $pool);
  143. }
  144. sub apply_textdelta {
  145. my ($self, $path, $checksum, $pool) = @_;
  146. return unless $path;
  147. my $info = $self->{info}{$path};
  148. $info->{base} = $self->retrieve_base($path, $info->{fpool})
  149. unless $info->{added};
  150. unless ($self->{external}) {
  151. my $newtype = $info->{prop} && $info->{prop}{'svn:mime-type'};
  152. my $is_text = !$newtype || mimetype_is_text ($newtype);
  153. if ($is_text && !$info->{added}) {
  154. my $basetype = $self->retrieve_base_prop($path, 'svn:mime-type', $pool);
  155. $is_text = !$basetype || mimetype_is_text ($basetype);
  156. }
  157. unless ($is_text) {
  158. $self->output_diff_header ($self->_report_path ($path));
  159. $self->_print (
  160. loc("Cannot display: file marked as a binary type.\n")
  161. );
  162. return undef;
  163. }
  164. }
  165. my $new;
  166. if ($self->{external}) {
  167. my $tmp = tmpfile ('diff');
  168. slurp_fh ($info->{base}, $tmp)
  169. if $info->{base};
  170. seek $tmp, 0, 0;
  171. $info->{base} = $tmp;
  172. $info->{new} = $new = tmpfile ('diff');
  173. }
  174. else {
  175. $info->{new} = '';
  176. open $new, '>', \$info->{new};
  177. }
  178. return [SVN::TxDelta::apply ($info->{base}, $new,
  179. undef, undef, $pool)];
  180. }
  181. sub _report_path {
  182. my ($self, $path) = @_;
  183. return $path if !(defined $self->{report} && length $self->{report});
  184. my $report = $self->{report}; $report = "$report";
  185. from_native($report);
  186. return catfile($report, $path);
  187. }
  188. sub close_file {
  189. my ($self, $path, $checksum, $pool) = @_;
  190. return unless $path;
  191. if (exists $self->{info}{$path}{new}) {
  192. no warnings 'uninitialized';
  193. my $rpath = $self->_report_path ($path);
  194. my $base = $self->{info}{$path}{added} ?
  195. \'' : $self->retrieve_base($path, $self->{info}{$path}{fpool});
  196. my @label = map { $self->{$_} || $self->{"cb_$_"}->($path) } qw/llabel rlabel/;
  197. my $showpath = ($self->{lpath} ne $self->{rpath});
  198. my @showpath = map { $showpath ? $self->{$_} : undef } qw/lpath rpath/;
  199. if ($self->{external}) {
  200. # XXX: the 2nd file could be - and save some disk IO
  201. my @content = map { ($self->{info}{$path}{$_}->filename) } qw/base new/;
  202. @content = reverse @content if $self->{reverse};
  203. (system (split (/ /, $self->{external}),
  204. '-L', _full_label ($rpath, $showpath[0], $label[0]),
  205. $content[0],
  206. '-L', _full_label ($rpath, $showpath[1], $label[1]),
  207. $content[1]) >= 0) or die loc("Could not run %1: %2", $self->{external}, $?);
  208. }
  209. else {
  210. my @content = ($base, \$self->{info}{$path}{new});
  211. @content = reverse @content if $self->{reverse};
  212. $self->output_diff ($rpath, @label, @showpath, @content);
  213. }
  214. } elsif (exists $self->{dh}->get("/$path")->{'.copyfrom'}) {
  215. # File copied but not changed.
  216. $self->output_diff_header($path);
  217. }
  218. $self->output_prop_diff ($path, $pool);
  219. delete $self->{info}{$path};
  220. }
  221. sub _full_label {
  222. my ($path, $mypath, $label) = @_;
  223. my $full_label = "$path\t";
  224. if ($mypath) {
  225. $full_label .= "($mypath)\t";
  226. }
  227. $full_label .= "($label)";
  228. return $full_label;
  229. }
  230. sub output_diff_header {
  231. my ($self, $path, $is_newdir) = @_;
  232. my @notes;
  233. push @notes, ($self->{reverse} ? "deleted" : "new") . " directory" if $is_newdir;
  234. if (my ($where, $rev) = $self->_resolve_base($path)) {
  235. push @notes, "copied from $where\@$rev";
  236. }
  237. if (@notes) {
  238. $path = "$path\t(" . (join "; ", @notes) . ")";
  239. }
  240. $self->_print (
  241. "=== $path\n",
  242. '=' x 66, "\n",
  243. );
  244. }
  245. sub output_diff {
  246. my ($self, $path, $llabel, $rlabel, $lpath, $rpath) = splice(@_, 0, 6);
  247. my $fh = $self->_output_fh;
  248. $self->output_diff_header ($path);
  249. unshift @_, $self->_output_fh;
  250. push @_, _full_label ($path, $lpath, $llabel),
  251. _full_label ($path, $rpath, $rlabel);
  252. goto &{$self->can('_output_diff_content')};
  253. }
  254. # _output_diff_content($fh, $ltext, $rtext, $llabel, $rlabel)
  255. sub _output_diff_content {
  256. my $fh = shift;
  257. my ($lfh, $lfn) = tmpfile ('diff');
  258. my ($rfh, $rfn) = tmpfile ('diff');
  259. slurp_fh (shift(@_) => $lfh); close ($lfh);
  260. slurp_fh (shift(@_) => $rfh); close ($rfh);
  261. my $diff = SVN::Core::diff_file_diff( $lfn, $rfn );
  262. SVN::Core::diff_file_output_unified(
  263. $fh, $diff, $lfn, $rfn, @_,
  264. );
  265. unlink ($lfn, $rfn);
  266. }
  267. sub output_prop_diff {
  268. my ($self, $path, $pool) = @_;
  269. if ($self->{info}{$path}{prop}) {
  270. my $rpath = $self->_report_path ($path);
  271. $self->_print("\n", loc("Property changes on: %1\n", $rpath), ('_' x 67), "\n");
  272. for (sort keys %{$self->{info}{$path}{prop}}) {
  273. $self->_print(loc("Name: %1\n", $_));
  274. my $baseprop;
  275. $baseprop = $self->retrieve_base_prop($path, $_, $pool)
  276. unless $self->{info}{$path}{added};
  277. my @args =
  278. map \$_,
  279. map { (length || /\n$/) ? "$_\n" : $_ }
  280. ($baseprop||''), ($self->{info}{$path}{prop}{$_}||'');
  281. @args = reverse @args if $self->{reverse};
  282. my $diff = '';
  283. open my $fh, '>', \$diff;
  284. _output_diff_content($fh, @args, '', '');
  285. $diff =~ s/.*\n.*\n//;
  286. $diff =~ s/^\@.*\n//mg;
  287. $diff =~ s/^/ /mg;
  288. $self->_print($diff);
  289. }
  290. $self->_print("\n");
  291. }
  292. }
  293. sub add_directory {
  294. my ($self, $path, $pdir, $from_path, $from_rev, $pool) = @_;
  295. $self->{info}{$path}{added} = 1;
  296. if (defined $from_path) {
  297. $from_path = $self->_copyfrom_uri_to_path($from_path);
  298. # XXX: print some garbage about this copy
  299. $self->{dh}->store("/$path", { copyanchor => "/$path",
  300. '.copyfrom' => $from_path,
  301. '.copyfrom_rev' => $from_rev,
  302. });
  303. }
  304. $self->output_diff_header($self->_report_path( $path ), 1);
  305. return $path;
  306. }
  307. sub open_directory {
  308. my ($self, $path, $pdir, $rev, @arg) = @_;
  309. return $path;
  310. }
  311. sub close_directory {
  312. my ($self, $path, $pool) = @_;
  313. $self->output_prop_diff ($path, $pool);
  314. delete $self->{info}{$path};
  315. }
  316. sub delete_entry {
  317. my ($self, $path, $revision, $pdir, $pool) = @_;
  318. my $spool = SVN::Pool->new_default;
  319. # generate delta between empty root and oldroot of $path, then reverse in output
  320. SVK::XD->depot_delta
  321. ( oldroot => $self->{base_target}->repos->fs->revision_root (0),
  322. oldpath => [$self->{base_target}->path_anchor, $path],
  323. newroot => $self->{base_root},
  324. newpath => $self->{base_target}->path_anchor eq '/' ? "/$path" : $self->{base_target}->path_anchor."/$path",
  325. editor => __PACKAGE__->new (%$self, reverse => 1),
  326. );
  327. }
  328. sub change_file_prop {
  329. my ($self, $path, $name, $value) = @_;
  330. $self->{info}{$path}{prop}{$name} = $value;
  331. }
  332. sub change_dir_prop {
  333. my ($self, $path, $name, $value) = @_;
  334. $self->{info}{$path}{prop}{$name} = $value;
  335. }
  336. sub close_edit {
  337. my ($self, @arg) = @_;
  338. }
  339. sub _print {
  340. my $self = shift;
  341. $self->{output} or return print @_;
  342. ${ $self->{output} } .= $_ for @_;
  343. }
  344. sub _output_fh {
  345. my $self = shift;
  346. no strict 'refs';
  347. $self->{output} or return \*{select()};
  348. open my $fh, '>>', $self->{output};
  349. return $fh;
  350. }
  351. 1;