File Coverage

blib/lib/Text/ParagraphDiff.pm
Criterion Covered Total %
statement 156 178 87.6
branch 50 82 60.9
condition 12 12 100.0
subroutine 17 20 85.0
pod 0 4 0.0
total 235 296 79.3


line stmt bran cond sub pod time code
1             package Text::ParagraphDiff;
2              
3 1     1   13528 use strict;
  1         3  
  1         44  
4 1     1   5 use warnings 'all';
  1         1  
  1         41  
5              
6 1     1   1408 use Algorithm::Diff qw(diff);
  1         6700  
  1         79  
7 1     1   8 use Carp qw(croak);
  1         2  
  1         71  
8 1     1   1043 use HTML::Entities ();
  1         10393  
  1         45  
9 1     1   1143 use POSIX qw(strftime);
  1         11863  
  1         11  
10              
11 1     1   1401 use vars qw(@EXPORT @EXPORT_OK @ISA $VERSION);
  1         2  
  1         2287  
12             require Exporter;
13             @EXPORT = qw(text_diff);
14             @EXPORT_OK = qw(create_diff html_header html_footer);
15             @ISA = qw(Exporter);
16             $VERSION = "2.70";
17              
18              
19              
20             # XXX: Can't use pod here because it messes up the doc on CPAN. :(
21              
22             # text_diff( old, new, [options hashref] )
23              
24             # C binds together C, C, and
25             # C to create a single document that is the "paragraph
26             # diff" of the 2 records.
27              
28             sub text_diff {
29 0     0 0 0 return ((html_header(@_)).(create_diff(@_)).(html_footer(@_)));
30             }
31              
32              
33              
34             # create_diff ( old, new, [options hashref] )
35              
36             # C creates the actual paragraph diff.
37              
38             sub create_diff {
39              
40 20     20 0 817 my($old,$new) = (shift,shift);
41 20 100       48 my $opt=shift if (@_);
42              
43 20         35 my $old_orig = _get_lines($old, $opt);
44 20         32 my $new_orig = _get_lines($new, $opt);
45 20 100       40 $new_orig = [''] unless @$new_orig;
46              
47 20         24 my %highlight;
48 20 100       36 if ($opt->{plain}) {
49 1         2 $highlight{minus} = qq( );
50 1         2 $highlight{plus} = qq( );
51 1         2 $highlight{end} = "";
52             }
53             else {
54 19         31 $highlight{minus} = qq( );
55 19         24 $highlight{plus} = qq( );
56 19         27 $highlight{end} = qq();
57             }
58              
59 20 50       54 $opt->{plus_order} = 0 unless $opt->{plus_order};
60              
61 20         15 my (@old,@old_count);
62 20         37 foreach (@$old_orig)
63             {
64 21 50       77 $_ = HTML::Entities::encode($_) unless exists $opt->{escape};
65 21         292 my @words = (/\S+/g);
66 21         45 push @old, @words;
67 21         60 push @old_count, scalar(@words);
68              
69             }
70              
71              
72 20         25 my ($total_diff, @new, @leading_space, @count);
73 20         29 foreach (@$new_orig)
74             {
75 21         60 my ($leading_white) = /^( *)/;
76 21         33 push @leading_space, $leading_white;
77              
78 21 50       76 $_ = HTML::Entities::encode($_) unless exists $opt->{escape};
79 21         248 my @words = (/\S+/g);
80              
81 21         38 push @$total_diff, map { [' ',$_] } @words;
  59         119  
82 21         40 push @new, @words;
83 21         60 push @count, scalar(@words);
84             }
85              
86 20 100       53 $opt->{sep} = ['

','

'] unless exists $opt->{sep};
87 20         51 my ($plus,$minus) = _get_diffs(\@old, \@new, \@old_count, $opt->{sep});
88              
89 20 100       52 _merge_plus ($total_diff, $plus) if @$plus;
90 20 100       79 _merge_minus ($total_diff, $minus, $opt->{minus_first}) if @$minus;
91 20         51 _merge_white ($total_diff, \@leading_space);
92              
93 20         90 $total_diff = _merge_lines ($total_diff, \@old_count, \@count);
94              
95 20         45 _fold ($total_diff);
96              
97 20         52 my $output = _format ($total_diff, \%highlight, $opt->{sep});
98 20         132 return $output;
99             }
100              
101             #########
102             # Utility
103              
104             # turns potential files into recordsets
105             sub _get_lines {
106 40     40   45 my ($file, $opt) = @_;
107 40         38 my @lines;
108 40 100       67 if (!ref $file) {
109 2 50       6 if ($opt->{string}) {
110 2         14 return [split /\r\n|\r|\n/,$file];
111             }
112             else {
113 0 0       0 open (FILE, "< $file") or croak "Can't open file $file: $!";
114 0         0 @lines = ;
115 0         0 close(FILE);
116 0         0 return \@lines;
117             }
118             }
119             else {
120 38         69 return $file;
121             }
122             }
123              
124             sub _fold {
125 20     20   25 my ($diff) = @_;
126              
127 20         54 foreach (@$diff) {
128 23         21 my $i = 0;
129 23         52 while ($i+1 < @$_) {
130 60 100       129 if ($_->[$i][0] eq $_->[$i+1][0]) {
131 36         49 my $item = splice @$_, $i+1, 1;
132 36         77 $_->[$i][1] .= (" ".$item->[1]);
133 36         113 next;
134             }
135 24         52 $i++;
136             }
137             }
138             }
139              
140             # diffs the files and splits into "plusses and "minuses"
141             sub _get_diffs {
142 20     20   26 my ($old,$new,$count,$sep) = @_;
143 20         51 my @diffs = diff($old, $new);
144 20         2294 my ($plus,$minus) = ([],[]);
145 20         36 foreach my $hunk (@diffs) {
146 20         31 foreach (@$hunk) {
147 44 100       87 push @$plus, $_ if $_->[0] eq '+';
148 44 100       119 push @$minus, $_ if $_->[0] eq '-';
149             }
150             }
151 20         43 _fix_minus ($minus, $count, $sep);
152 20         50 return ($plus,$minus);
153             }
154              
155             # re-adjusts the minus's position to correspond with the positve,
156             # and adds paragraph markers where necessary
157             sub _fix_minus {
158 20     20   23 my ($d,$count,$sep) = @_;
159 20         25 my ($i,$x) = (0,0);
160 20         39 foreach my $break (@$count) {
161 21         22 $i += $break;
162 21   100     89 while ( ($x < @$d) && ($i > $d->[$x][1]) ) {
163 22         60 ++$x
164             }
165 21 100       73 last unless @$d > $x;
166 2 50       8 $d->[$x-1][2] .= $sep->[1].$sep->[0] if ($i-1) == $d->[$x-1][1];
167 2         3 ++$x
168             }
169             }
170              
171             #########
172             # Merging
173              
174             # integrate the "plus" into the main document
175             sub _merge_plus {
176 13     13   15 my ($total_diff, $plus_diff) = @_;
177              
178 13         29 while ( my $cur = shift @$plus_diff ) {
179 20         67 $total_diff->[$cur->[1]][0] = '+';
180             }
181             }
182              
183             # integrate the minus into the main document, making sure not
184             # to split up any plusses
185             sub _merge_minus {
186 15     15   85 my ($total_diff, $min_diff, $minus_first) = @_;
187 15         21 my ($pos,$offset) = (0,0);
188              
189 15         32 while ( my $cur = shift @$min_diff ) {
190 16         37 while ($pos < ($cur->[1]+$offset)) {
191 24 100       50 ++$offset if $total_diff->[$pos][0] eq '+';
192 24         106 ++$pos;
193             }
194 16 100       15 if ($pos >= $#{$total_diff}) {
  16         34  
195 9         23 push @$total_diff, ['-',$cur->[2]];
196 9         13 last;
197             }
198 7   100     35 while ($pos < @$total_diff && $total_diff->[$pos][0] eq '+') {
199 7         7 ++$offset;
200 7         23 ++$pos;
201             }
202 7         8 my $current = 0;
203 7 50       14 $current = $offset if $minus_first;
204 7         35 splice @$total_diff, $pos-$current, 0, ['-',$cur->[2]];
205             }
206              
207 15 100       41 push @$total_diff, map { ['-',$_->[2]] } @$min_diff if @$min_diff;
  8         20  
208             }
209              
210             # merge in whitespace.
211             sub _merge_white {
212 20     20   22 my ($total_diff, $whitespace) = @_;
213 20         22 my $pos = 0;
214              
215 20         40 while ( @$whitespace ) {
216 21         24 my $cur = shift @$whitespace;
217 21   100     111 while ( ($pos < @$total_diff)
218             && ($total_diff->[$pos][0] ne '-')
219 49         160 ) { $pos++ }
220 21 100       55 $total_diff->[$pos][1] = $cur . $total_diff->[$pos][1]
221             if $total_diff->[$pos][1];
222 21         55 ++$pos;
223             }
224             }
225              
226             sub _merge_lines {
227 20     20   25 my ($total_diff, $old_count, $new_count) = @_;
228 20         28 my $new = [];
229 20         33 my @old_count_orig = @$old_count;
230              
231 20         30 foreach my $words_in_line ( @$new_count ) {
232 21 100       63 if ($words_in_line > 0) {
233 19         29 push @$new, [];
234 19         24 my ($pos,$total) = (0,0);
235 19         35 while ($pos < $words_in_line ) {
236 65         116 until ($old_count->[0]) {
237 9 100       16 last unless @$old_count;
238 2         2 shift @$old_count;
239 2         3 shift @old_count_orig;
240             }
241 65 100       124 ++$pos if $total_diff->[$total][0] ne '-';
242 65 100       124 $old_count->[0] = $old_count->[0] - 1 if $total_diff->[$total][0] ne '+';
243 65         107 ++$total;
244             }
245 19         70 $new->[-1] = [splice @$total_diff,0,$total];
246             }
247             }
248              
249 20 100 100     84 if (@$old_count && $old_count->[0] < $old_count_orig[0]) {
250 15         15 push @{$new->[-1]}, splice(@$total_diff, 0, $old_count->[0]);
  15         30  
251 15         20 shift @old_count_orig;
252             }
253 20         69 while (@old_count_orig) {
254 4         15 push @$new, [splice @$total_diff, 0, shift(@old_count_orig)]
255             }
256              
257 20         40 return $new;
258             }
259              
260             #########
261             # Output
262              
263             sub _format {
264 20     20   27 my ($diff,$highlight,$sep) = @_;
265 20         23 my $output;
266              
267 20         29 foreach my $hunk (@$diff) {
268 23         44 $output .= "\n$sep->[0]\n";
269 23         24 foreach my $sect (@$hunk) {
270 47 100       95 if ($sect->[0] eq ' ') {
    100          
271 19         36 $output .= "$sect->[1] ";
272             }
273             elsif ($sect->[0] eq '+') {
274 13         38 $output .= " $highlight->{plus}$sect->[1]$highlight->{end} ";
275             }
276             else {
277             # $sect->[1] = '' unless $sect->[1];
278 15         42 $output .= " $highlight->{minus}$sect->[1]$highlight->{end} ";
279             }
280             }
281 23         68 $output .= "\n$sep->[1]\n";
282             }
283 20         43 return $output;
284             }
285              
286             sub html_header {
287 0     0 0   my ($old,$new,$opt) = @_;
288              
289 0 0         my $old_time = strftime( "%A, %B %d, %Y @ %H:%M:%S",
290             (ref $old) ? time : (stat $old)[9]
291             , 0, 0, 0, 0, 70, 0 );
292 0 0         my $new_time = strftime( "%A, %B %d, %Y @ %H:%M:%S",
293             (ref $new) ? time : (stat $new)[9]
294             , 0, 0, 0, 0, 70, 0 );
295              
296 0 0         $old = (!ref $old) ? $old : "old";
297 0 0         $new = (!ref $new) ? $new : "new";
298              
299 0 0         if ($opt->{plain}) {
300 0           return "Difference of $old, $new"
301             }
302              
303 0 0         my $header = (exists $opt->{header}) ? $opt->{header} : qq(
304            
305             Difference of:
306            
307            
---$old$old_time
308            
+++$new$new_time
309            
310             );
311              
312 0 0         my $script = ($opt->{functionality}) ? "" : qq(
313            
367             );
368              
369 0 0         my $style = (exists $opt->{style}) ? $opt->{style} : qq(
370            
389             );
390              
391 0 0         my $functionality = ($opt->{functionality}) ? "" : qq(
392            
393            
394            
395              
396              
397            
398            
399            
400             );
401              
402 0           return qq(
403            
404             PUBLIC "-//W3C//DTD XHMTL 1.0 Transitional//EN"
405             "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
406            
407             Difference of $old, $new
408             $script
409             $style
410            
411             $header
412             $functionality
413            
414             );
415             }
416              
417             sub html_footer {
418 0     0 0   my $div = "";
419              
420 0 0         if (@_ == 3) {
421 0 0         return $_[2]->{footer} if exists $_[2]->{footer};
422 0 0         $div = "" unless $_[2]->{plain}
423             }
424              
425 0           return $div.""
426             }
427              
428             1;
429              
430             __END__