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