rundiff (4:7805f2ade389) rundiff (196:fd06d955c1c5)
1#!/usr/bin/perl
1#! /usr/bin/env perl
2
2
3# Copyright (c) 2001 Nathan L. Binkert
3# Copyright (c) 2003 The Regents of The University of Michigan
4# All rights reserved.
5#
4# All rights reserved.
5#
6# Permission to redistribute, use, copy, and modify this software
7# without fee is hereby granted, provided that the following
8# conditions are met:
6# Redistribution and use in source and binary forms, with or without
7# modification, are permitted provided that the following conditions are
8# met: redistributions of source code must retain the above copyright
9# notice, this list of conditions and the following disclaimer;
10# redistributions in binary form must reproduce the above copyright
11# notice, this list of conditions and the following disclaimer in the
12# documentation and/or other materials provided with the distribution;
13# neither the name of the copyright holders nor the names of its
14# contributors may be used to endorse or promote products derived from
15# this software without specific prior written permission.
9#
16#
10# 1. This entire notice is included in all source code copies of any
11# software which is or includes a copy or modification of this
12# software.
13# 2. The name of the author may not be used to endorse or promote
14# products derived from this software without specific prior
15# written permission.
17# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
18# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
19# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
20# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
21# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
22# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
23# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
24# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
25# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
26# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
27# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28
29# Diff two streams.
16#
30#
17# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
18# OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
19# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
21# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
23# GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
25# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
26# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
27# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31# Unlike regular diff, this script does not read in the entire input
32# before doing a diff, so it can be used on lengthy outputs piped from
33# other programs (e.g., M5 traces). The best way to do this is to
34# take advantage of the power of Perl's open function, which will
35# automatically fork a subprocess if the last character in the
36# "filename" is a pipe (|). Thus to compare the instruction traces
37# from two versions of m5 (m5a and m5b), you can do this:
28#
38#
39# rundiff 'm5a --trace:flags=InstExec |' 'm5b --trace:flags=InstExec |'
40#
29
41
30use Algorithm::Diff qw(diff);
31use vars qw ($opt_C $opt_c $opt_u $opt_U);
42use strict;
32
43
33$opt_u = "";
34$opt_c = undef;
44#
45# For the highest-quality (minimal) diffs, we can use the
46# Algorithm::Diff package. If you don't have this installed, or want
47# the script to run faster (like 3-4x faster, based on informal
48# observation), set $use_complexdiff to 0; then a built-in, simple,
49# and generally quite adequate algorithm will be used instead.
50my $use_complexdiff = 0;
35
51
36$diffsize = 2000;
37# After we've read up to a certain point in each file, the number of items
38# we've read from each file will differ by $FLD (could be 0)
39my $File_Length_Difference = 0;
40my $Context_Lines = 9;
52if ($use_complexdiff) {
53 use Algorithm::Diff qw(traverse_sequences);
54};
41
55
42$progname = $0;
43if (scalar(@ARGV) != 2) {
44 usage();
45}
56my $lookahead_lines = 200;
57my $precontext_lines = 3;
58my $postcontext_lines = 3;
46
59
47my ($filename1, $filename2);
48($filename1, $start1) = parse_filearg($ARGV[0]);
49($filename2, $start2) = parse_filearg($ARGV[1]);
60my $file1 = $ARGV[0];
61my $file2 = $ARGV[1];
50
62
51if ($filename1 eq "-" && $filename2 eq "-") {
52 die "Only one of the inputs may be standard in\n";
53}
63die "Need two args." if (!(defined($file1) && defined($file2)));
54
64
55my ($file1, $file2);
56if ($filename1 eq "-") {
57 $file1 = STDIN;
58} else {
59 open(FILE1, $filename1) || die "can't open $file1: $!\n";
60 $file1 = FILE1;
61}
65my ($fh1, $fh2);
66open($fh1, $file1) or die "Can't open $file1";
67open($fh2, $file2) or die "Can't open $file2";
62
68
63if ($filename2 eq "-") {
64 $file2 = STDIN;
65} else {
66 open(FILE2, $filename2) || die "can't open $file2: $!\n";
67 $file2 = FILE2;
68}
69# buffer of matching lines for pre-diff context
70my @precontext = ();
71# number of post-diff matching lines remaining to print
72my $postcontext = 0;
69
73
70my $file_offset1 = ffw($file1, $start1);
71my $file_offset2 = ffw($file2, $start2);
74# lookahead buffers for $file1 and $file2 respectively
75my @lines1 = ();
76my @lines2 = ();
72
77
73$skip_first = 0;
74my (@buf1, @buf2, @printbuf1, @printbuf2);
78# Next line number available to print from each file. Generally this
79# corresponds to the oldest line in @precontext, or the oldest line in
80# @lines1 and @lines2 if @precontext is empty.
81my $lineno1 = 1;
82my $lineno2 = 1;
75
83
76$Compare_Ahead = 0;
84# Fill a lookahead buffer to $lookahead_lines lines (or until EOF).
85sub fill
86{
87 my ($fh, $array) = @_;
77
88
78while (!eof($file1) && !eof($file2)) {
79 my $line1 = <$file1>; chomp $line1;
80 my $line2 = <$file2>; chomp $line2;
81 my $printline1 = $line1;
82 my $printline2 = $line2;
89 while (@$array < $lookahead_lines) {
90 my $line = <$fh>;
91 last if (!defined($line));
92 push @$array, $line;
93 }
94}
83
95
84 push @buf1, $line1;
85 push @buf2, $line2;
86 push @printbuf1, $printline1;
87 push @printbuf2, $printline2;
96# Print and delete n lines from front of given array with given prefix.
97sub printlines
98{
99 my ($array, $n, $prefix) = @_;
88
100
89# while ($Compare_Ahead < $Context_Lines) {
90# $line1 = @buf1[$Compare_Ahead];
91# $line2 = @buf2[$Compare_Ahead];
92# $line2 =~ s/ *--.*$//;
93# if ($line1 ne $line2) { last; }
94# ++$Compare_Ahead;
95# }
96
97 $line1 = @buf1[$Compare_Ahead];
98 $line2 = @buf2[$Compare_Ahead];
99 $line2 =~ s/ *--.*$//;
100
101 if ($line1 ne $line2) {
102 while (!eof($file1) && scalar(@buf1) < $diffsize) {
103 $line = <$file1>; chomp $line;
104 my $printline = $line;
105
106 push @printbuf1, $printline;
107 push @buf1, $line;
101 while ($n--) {
102 my $line = shift @$array;
103 last if (!defined($line));
104 print $prefix, $line;
108 }
105 }
109
110 while (!eof($file2) && scalar(@buf2) < $diffsize) {
111 $line = <$file2>; chomp $line;
112 my $printline = $line;
113# $line =~ s/ *--.*$//;
106}
114
107
115 push @printbuf2, $printline;
116 push @buf2, $line;
117 }
108# Print a difference region where n1 lines of file1 were replaced by
109# n2 lines of file2 (where either n1 or n2 could be zero).
110sub printdiff
111{
112 my ($n1, $n2)= @_;
118
113
119 my $diffs = diff(\@buf1, \@buf2);
120
121 next unless @$diffs;
122
123 my @hunklist;
124 my ($hunk,$oldhunk);
125 # Loop over hunks. If a hunk overlaps with the last hunk, join them.
126 # Otherwise, print out the old one.
127 foreach my $piece (@$diffs) {
128 $hunk = new Hunk ($piece, $Context_Lines, scalar(@buf1));
129 next unless $oldhunk;
130
131 if ($hunk->does_overlap($oldhunk)) {
132 $hunk->prepend_hunk($oldhunk);
133 } else {
134 push @hunklist, $oldhunk;
135 }
136 } continue {
137 $oldhunk = $hunk;
114 # If the precontext buffer is full or we're at the beginning of a
115 # file, then this is a new diff region, so we should print a
116 # header indicating the current line numbers. If we're past the
117 # beginning and the precontext buffer isn't full, then whatever
118 # we're about to print is contiguous with the end of the last
119 # region we printed, so we just concatenate them on the output.
120 if (@precontext == $precontext_lines || ($lineno1 == 0 && $lineno2 == 0)) {
121 print "@@ -$lineno1 +$lineno2 @@\n";
138 }
122 }
139
140 my $change = 0;
141 while (scalar(@hunklist) && !$change) {
142 $hunk = pop @hunklist;
143 $change = $hunk->{"change"};
144 }
145 push @hunklist, $hunk;
146 $last_start1 = $hunk->{"start1"};
147 $last_start2 = $hunk->{"start2"};
148 $last_end1 = $hunk->{"end1"};
149 $last_end2 = $hunk->{"end2"};
150
123
151 while (scalar(@hunklist)) {
152 $hunk = shift @hunklist;
153# $hunk->output_diff(\@buf1, \@buf2);
154 $hunk->output_diff(\@printbuf1, \@printbuf2);
124 # Print and clear the precontext buffer.
125 if (@precontext) {
126 print ' ', join(' ', @precontext);
127 $lineno1 += scalar(@precontext);
128 $lineno2 += scalar(@precontext);
129 @precontext = ();
155 }
156
130 }
131
157 $last_end1 -= $Context_Lines - 1;
158 $last_end2 -= $Context_Lines - 1;
159 $file_offset1 += $last_end1;
160 $file_offset2 += $last_end2;
161 @printbuf1 = @printbuf1[$last_end1..$#printbuf1];
162 @printbuf2 = @printbuf2[$last_end2..$#printbuf2];
163 @buf1 = @buf1[$last_end1..$#buf1];
164 @buf2 = @buf2[$last_end2..$#buf2];
165 while (scalar(@buf1) > $Context_Lines &&
166 scalar(@buf2) > $Context_Lines) {
167 $foo1 = @buf1[$Context_Lines];
168 $foo2 = @buf2[$Context_Lines];
169 if (scalar($foo1) != scalar($foo2) || $foo1 ne $foo2) { last; }
170 $foo1 = shift @printbuf1;
171 $foo2 = shift @printbuf2;
172 $foo1 = shift @buf1;
173 $foo2 = shift @buf2;
174 ++$file_offset1;
175 ++$file_offset2;
176 }
177 } else {
178 ++$file_offset1;
179 ++$file_offset2;
180 $foo1 = shift @printbuf1;
181 $foo2 = shift @printbuf2;
182 $foo1 = shift @buf1;
183 $foo2 = shift @buf2;
184 }
185}
132 # Print the differing lines.
133 printlines(\@lines1, $n1, '-');
134 printlines(\@lines2, $n2, '+');
135 $lineno1 += $n1;
136 $lineno2 += $n2;
186
137
187close $file1;
188close $file2;
189
190sub ffw() {
191 if (scalar(@_) != 2) { die "improper usage of ffw\n"; }
192
193 my $FILE = $_[0];
194 my $start = $_[1];
195 my $count = 0;
196
197 while ($start-- > 0 && !eof($FILE)) {
198 <$FILE>;
199 $count++;
200 }
201
202 if ($start > 0) {die "File too short for ffw amount\n"; }
203 return $count;
138 # Set $postcontext to print the next $postcontext_lines matching lines.
139 $postcontext = $postcontext_lines;
204}
205
140}
141
206sub parse_filearg() {
207 $start = 0;
208 split /:/, @_[0];
209 if (scalar(@_) > 2) { usage(); }
210
142
211 $file = $_[0];
212 if (scalar(@_) > 1) { $start = $_[1]; }
213
214 return ($file, $start);
215}
216
217sub usage() {
218 printf "usage: $progname <file1>[:start] <file2>[:start]\n";
219 exit 1;
220}
221
222
223# Package Hunk. A Hunk is a group of Blocks which overlap because of the
224# context surrounding each block. (So if we're not using context, every
225# hunk will contain one block.)
226{
227package Hunk;
228
229sub new {
230# Arg1 is output from &LCS::diff (which corresponds to one Block)
231# Arg2 is the number of items (lines, e.g.,) of context around each block
143########################
232#
144#
233# This subroutine changes $File_Length_Difference
145# Complex diff algorithm
234#
146#
235# Fields in a Hunk:
236# blocks - a list of Block objects
237# start - index in file 1 where first block of the hunk starts
238# end - index in file 1 where last block of the hunk ends
239#
240# Variables:
241# before_diff - how much longer file 2 is than file 1 due to all hunks
242# until but NOT including this one
243# after_diff - difference due to all hunks including this one
244 my ($class, $piece, $context_items, $maxlen) = @_;
147########################
245
148
246 my $block = new Block ($piece); # this modifies $FLD!
149{
150 my $match_found;
151 my $discard_lines1;
152 my $discard_lines2;
247
153
248 my $before_diff = $File_Length_Difference; # BEFORE this hunk
249 my $after_diff = $before_diff + $block->{"length_diff"};
250 $File_Length_Difference += $block->{"length_diff"};
154 sub match { $match_found = 1; }
155 sub discard1 { $discard_lines1++ unless $match_found; }
156 sub discard2 { $discard_lines2++ unless $match_found; }
251
157
252 # @remove_array and @insert_array hold the items to insert and remove
253 # Save the start & beginning of each array. If the array doesn't exist
254 # though (e.g., we're only adding items in this block), then figure
255 # out the line number based on the line number of the other file and
256 # the current difference in file lenghts
257 my @remove_array = $block->remove;
258 my @insert_array = $block->insert;
259 my ($a1, $a2, $b1, $b2, $start1, $start2, $end1, $end2, $change);
260 $a1 = @remove_array ? $remove_array[0 ]->{"item_no"} : -1;
261 $a2 = @remove_array ? $remove_array[-1]->{"item_no"} : -1;
262 $b1 = @insert_array ? $insert_array[0 ]->{"item_no"} : -1;
263 $b2 = @insert_array ? $insert_array[-1]->{"item_no"} : -1;
158 sub complex_diff
159 {
160 $match_found = 0;
161 $discard_lines1 = 0;
162 $discard_lines2 = 0;
264
163
265 $start1 = $a1 == -1 ? $b1 - $before_diff : $a1;
266 $end1 = $a2 == -1 ? $b2 - $after_diff : $a2;
267 $start2 = $b1 == -1 ? $a1 + $before_diff : $b1;
268 $end2 = $b2 == -1 ? $a2 + $after_diff : $b2;
269 $change = scalar(@remove_array) && scalar(@insert_array);
164 # See Diff.pm. Note that even though this call generates a
165 # complete diff of both lookahead buffers, all we use it for
166 # is to figure out how many lines to discard off the front of
167 # each buffer to resync the streams.
168 traverse_sequences( \@lines1, \@lines2,
169 { MATCH => \&match,
170 DISCARD_A => \&discard1,
171 DISCARD_B => \&discard2 });
270
172
271 # At first, a hunk will have just one Block in it
272 my $hunk = {
273 "start1" => $start1,
274 "start2" => $start2,
275 "end1" => $end1,
276 "end2" => $end2,
277 "maxlen" => $maxlen,
278 "change" => $change,
279 "blocks" => [$block],
280 };
281 bless $hunk, $class;
173 die "Lost sync!" if (!$match_found);
282
174
283 $hunk->flag_context($context_items);
175 # Since we shouldn't get here unless the first lines of the
176 # buffers are different, then we must discard some lines off
177 # at least one of the buffers.
178 die if ($discard_lines1 == 0 && $discard_lines2 == 0);
284
179
285 return $hunk;
180 printdiff($discard_lines1, $discard_lines2);
181 }
286}
287
182}
183
288# Change the "start" and "end" fields to note that context should be added
289# to this hunk
290sub flag_context {
291 my ($hunk, $context_items) = @_;
292 return unless $context_items; # no context
184#######################
185#
186# Simple diff algorithm
187#
188#######################
293
189
294 # add context before
295 my $start1 = $hunk->{"start1"};
296 my $num_added = $context_items > $start1 ? $start1 : $context_items;
297 $hunk->{"start1"} -= $num_added;
298 $hunk->{"start2"} -= $num_added;
190# Check for a pair of matching lines; if found, generate appropriate
191# diff output.
192sub checkmatch
193{
194 my ($n1, $n2) = @_;
299
195
300 # context after
301 my $end1 = $hunk->{"end1"};
302 $num_added = ($end1+$context_items > $hunk->{"maxlen"}) ?
303 $hunk->{"maxlen"} - $end1 :
304 $context_items;
305 $hunk->{"end1"} += $num_added;
306 $hunk->{"end2"} += $num_added;
196 # Check if two adjacent lines match, to reduce false resyncs
197 # (particularly on unrelated blank lines). This generates
198 # larger-than-necessary diffs when a single line really should be
199 # treated as common; if that bugs you, use Algorithm::Diff.
200 if ($lines1[$n1] eq $lines2[$n2] && $lines1[$n1+1] eq $lines2[$n2+1]) {
201 printdiff($n1, $n2);
202 }
307}
308
203}
204
309# Is there an overlap between hunk arg0 and old hunk arg1?
310# Note: if end of old hunk is one less than beginning of second, they overlap
311sub does_overlap {
312 my ($hunk, $oldhunk) = @_;
313 return "" unless $oldhunk; # first time through, $oldhunk is empty
314
315 # Do I actually need to test both?
316 return ($hunk->{"start1"} - $oldhunk->{"end1"} <= 1 ||
317 $hunk->{"start2"} - $oldhunk->{"end2"} <= 1);
318}
319
320# Prepend hunk arg1 to hunk arg0
321# Note that arg1 isn't updated! Only arg0 is.
322sub prepend_hunk {
323 my ($hunk, $oldhunk) = @_;
324
325 $hunk->{"start1"} = $oldhunk->{"start1"};
326 $hunk->{"start2"} = $oldhunk->{"start2"};
327
328 unshift (@{$hunk->{"blocks"}}, @{$oldhunk->{"blocks"}});
329}
330
331
332# DIFF OUTPUT ROUTINES. THESE ROUTINES CONTAIN DIFF FORMATTING INFO...
333sub output_diff {
334 if (defined $main::opt_u) {&output_unified_diff(@_)}
335 elsif (defined $main::opt_c) {&output_context_diff(@_)}
336 else {die "unknown diff"}
337}
338
339sub output_unified_diff {
340 my ($hunk, $fileref1, $fileref2) = @_;
341 my @blocklist;
342
343 # Calculate item number range.
344 my $range1 = $hunk->unified_range(1, $file_offset1);
345 my $range2 = $hunk->unified_range(2, $file_offset2);
346 print "@@ -$range1 +$range2 @@\n";
347
348 # Outlist starts containing the hunk of file 1.
349 # Removing an item just means putting a '-' in front of it.
350 # Inserting an item requires getting it from file2 and splicing it in.
351 # We splice in $num_added items. Remove blocks use $num_added because
352 # splicing changed the length of outlist.
353 # We remove $num_removed items. Insert blocks use $num_removed because
354 # their item numbers---corresponding to positions in file *2*--- don't take
355 # removed items into account.
356 my $low = $hunk->{"start1"};
357 my $hi = $hunk->{"end1"};
358 my ($num_added, $num_removed) = (0,0);
359 my @outlist = @$fileref1[$low..$hi];
360 map {s/^/ /} @outlist; # assume it's just context
361
362 foreach my $block (@{$hunk->{"blocks"}}) {
363 foreach my $item ($block->remove) {
364 my $op = $item->{"sign"}; # -
365 my $offset = $item->{"item_no"} - $low + $num_added;
366 $outlist[$offset] =~ s/^ /$op/;
367 $num_removed++;
205sub simple_diff
206{
207 # Look for differences of $cnt lines to resync,
208 # increasing $cnt from 1 to $lookahead_lines until we find
209 # something.
210 for (my $cnt = 1; $cnt < $lookahead_lines-1; ++$cnt) {
211 # Check for n lines in one file being replaced by
212 # n lines in the other.
213 return if checkmatch($cnt, $cnt);
214 # Find differences where n lines in one file were
215 # replaced by m lines in the other. We let m = $cnt
216 # and iterate for n = 0 to $cnt-1.
217 for (my $n = 0; $n < $cnt; ++$n) {
218 return if checkmatch($n, $cnt);
219 return if checkmatch($cnt, $n);
368 }
220 }
369 foreach my $item ($block->insert) {
370 my $op = $item->{"sign"}; # +
371 my $i = $item->{"item_no"};
372 my $offset = $i - $hunk->{"start2"} + $num_removed;
373 splice(@outlist,$offset,0,"$op$$fileref2[$i]");
374 $num_added++;
375 }
376 }
221 }
377
378 map {s/$/\n/} @outlist; # add \n's
379 print @outlist;
380
222 die "Lost sync!";
381}
382
223}
224
383sub output_context_diff {
384 my ($hunk, $fileref1, $fileref2) = @_;
385 my @blocklist;
225# Set the pointer to the appropriate diff function.
226#
227# Note that in either case the function determines how many lines to
228# discard from the front of each lookahead buffer to resync the
229# streams, then prints the appropriate diff output and discards them.
230# After the function returns, it should always be the case that
231# $lines1[0] eq $lines2[0].
232my $find_diff = $use_complexdiff ? \&complex_diff : \&simple_diff;
386
233
387 print "***************\n";
388 # Calculate item number range.
389 my $range1 = $hunk->context_range(1, $file_offset1);
390 my $range2 = $hunk->context_range(2, $file_offset2);
234# The main loop.
235while (1) {
236 # keep lookahead buffers topped up
237 fill($fh1, \@lines1);
238 fill($fh2, \@lines2);
391
239
392 # Print out file 1 part for each block in context diff format if there are
393 # any blocks that remove items
394 print "*** $range1 ****\n";
395 my $low = $hunk->{"start1"};
396 my $hi = $hunk->{"end1"};
397 if (@blocklist = grep {$_->remove} @{$hunk->{"blocks"}}) {
398 my @outlist = @$fileref1[$low..$hi];
399 map {s/^/ /} @outlist; # assume it's just context
400 foreach my $block (@blocklist) {
401 my $op = $block->op; # - or !
402 foreach my $item ($block->remove) {
403 $outlist[$item->{"item_no"} - $low] =~ s/^ /$op/;
404 }
405 }
406 map {s/$/\n/} @outlist; # add \n's
407 print @outlist;
240 # peek at first line in each buffer
241 my $l1 = $lines1[0];
242 my $l2 = $lines2[0];
243
244 if (!defined($l1) && !defined($l2)) {
245 # reached EOF on both streams: exit
246 exit(1);
408 }
409
247 }
248
410 print "--- $range2 ----\n";
411 $low = $hunk->{"start2"};
412 $hi = $hunk->{"end2"};
413 if (@blocklist = grep {$_->insert} @{$hunk->{"blocks"}}) {
414 my @outlist = @$fileref2[$low..$hi];
415 map {s/^/ /} @outlist; # assume it's just context
416 foreach my $block (@blocklist) {
417 my $op = $block->op; # + or !
418 foreach my $item ($block->insert) {
419 $outlist[$item->{"item_no"} - $low] =~ s/^ /$op/;
249 if ($l1 eq $l2) {
250 # matching lines: delete from lookahead buffer
251 shift @lines1;
252 shift @lines2;
253 # figure out what to do with this line
254 if ($postcontext > 0) {
255 # we're in the post-context of a diff: print it
256 $postcontext--;
257 print ' ', $l1;
258 $lineno1++;
259 $lineno2++;
260 }
261 else {
262 # we're in the middle of a matching region... save this
263 # line for precontext in case we run into a difference.
264 push @precontext, $l1;
265 # don't let precontext buffer get bigger than needed
266 while (@precontext > $precontext_lines) {
267 shift @precontext;
268 $lineno1++;
269 $lineno2++;
420 }
421 }
270 }
271 }
422 map {s/$/\n/} @outlist; # add \n's
423 print @outlist;
424 }
272 }
425}
426
427sub context_range {
428# Generate a range of item numbers to print. Only print 1 number if the range
429# has only one item in it. Otherwise, it's 'start,end'
430 my ($hunk, $flag, $offset) = @_;
431 my ($start, $end) = ($hunk->{"start$flag"},$hunk->{"end$flag"});
432
433 # index from 1, not zero
434 $start += $offset + 1;
435 $end += $offset + 1;
436 my $range = ($start < $end) ? "$start,$end" : $end;
437 return $range;
438}
439
440sub unified_range {
441# Generate a range of item numbers to print for unified diff
442# Print number where block starts, followed by number of lines in the block
443# (don't print number of lines if it's 1)
444 my ($hunk, $flag, $offset) = @_;
445 my ($start, $end) = ($hunk->{"start$flag"},$hunk->{"end$flag"});
446
447 # index from 1, not zero
448 $start += $offset + 1;
449 $end += $offset + 1;
450 my $length = $end - $start + 1;
451 my $first = $length < 2 ? $end : $start; # strange, but correct...
452 my $range = $length== 1 ? $first : "$first,$length";
453 return $range;
454}
455} # end Package Hunk
456
457# Package Block. A block is an operation removing, adding, or changing
458# a group of items. Basically, this is just a list of changes, where each
459# change adds or deletes a single item.
460# (Change could be a separate class, but it didn't seem worth it)
461{
462package Block;
463sub new {
464# Input is a chunk from &Algorithm::LCS::diff
465# Fields in a block:
466# length_diff - how much longer file 2 is than file 1 due to this block
467# Each change has:
468# sign - '+' for insert, '-' for remove
469# item_no - number of the item in the file (e.g., line number)
470# We don't bother storing the text of the item
471#
472 my ($class,$chunk) = @_;
473 my @changes = ();
474
475# This just turns each change into a hash.
476 foreach my $item (@$chunk) {
477 my ($sign, $item_no, $text) = @$item;
478 my $hashref = {"sign" => $sign, "item_no" => $item_no};
479 push @changes, $hashref;
273 else {
274 # Mismatch. Deal with it.
275 &$find_diff();
480 }
276 }
481
482 my $block = { "changes" => \@changes };
483 bless $block, $class;
484
485 $block->{"length_diff"} = $block->insert - $block->remove;
486 return $block;
487}
277}
488
489
490# LOW LEVEL FUNCTIONS
491sub op {
492# what kind of block is this?
493 my $block = shift;
494 my $insert = $block->insert;
495 my $remove = $block->remove;
496
497 $remove && $insert and return '!';
498 $remove and return '-';
499 $insert and return '+';
500 warn "unknown block type";
501 return '^'; # context block
502}
503
504# Returns a list of the changes in this block that remove items
505# (or the number of removals if called in scalar context)
506sub remove { return grep {$_->{"sign"} eq '-'} @{shift->{"changes"}}; }
507
508# Returns a list of the changes in this block that insert items
509sub insert { return grep {$_->{"sign"} eq '+'} @{shift->{"changes"}}; }
510
511} # end of package Block