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