File Coverage

blib/lib/String/Diff.pm
Criterion Covered Total %
statement 152 155 98.0
branch 72 82 87.8
condition 21 27 77.7
subroutine 16 16 100.0
pod 4 4 100.0
total 265 284 93.3


line stmt bran cond sub pod time code
1             package String::Diff;
2              
3 13     13   874152 use strict;
  13         34  
  13         474  
4 13     13   70 use warnings;
  13         26  
  13         389  
5 13     13   69 use base qw(Exporter);
  13         29  
  13         764  
6             our @EXPORT_OK = qw( diff_fully diff diff_merge diff_regexp );
7              
8             BEGIN {
9 13     13   2450 local $@;
10 13 100       77 if ($ENV{STRING_DIFF_PP}) {
11 6         15 $@ = 1;
12             } else {
13 7     7   533 eval "use Algorithm::Diff::XS qw( sdiff );"; ## no critic
  7         3327  
  0            
  0            
14             }
15 13 50       199 if ($@) {
16 13     13   961 eval "use Algorithm::Diff qw( sdiff );"; ## no critic
  13         19298  
  13         91684  
  13         1163  
17 13 50       25943 die $@ if $@;
18             }
19             }
20              
21             our $VERSION = '0.06';
22              
23             our %DEFAULT_MARKS = (
24             remove_open => '[',
25             remove_close => ']',
26             append_open => '{',
27             append_close => '}',
28             separator => '', # for diff_merge
29             );
30              
31             sub diff_fully {
32 124     124 1 502729 my($old, $new, %opts) = @_;
33 124         305 my $old_diff = [];
34 124         250 my $new_diff = [];
35              
36 124 100       427 if ($opts{linebreak}) {
37 30         81 my @diff = sdiff( map{ my @l = map { ( $_, "\n") } split /\n/, $_; pop @l; [ @l ]} $old, $new);
  60         317  
  170         406  
  60         117  
  60         334  
38 30         9973 for my $line (@diff) {
39 166 100       577 if ($line->[0] eq 'c') {
    100          
    100          
40             # change
41 60         322 my($old_diff_tmp, $new_diff_tmp) = _fully($line->[1], $line->[2]);
42 60         103 push @{ $old_diff }, @{ $old_diff_tmp };
  60         99  
  60         158  
43 60         89 push @{ $new_diff }, @{ $new_diff_tmp };
  60         89  
  60         288  
44             } elsif ($line->[0] eq '-') {
45             # remove
46 32         42 push @{ $old_diff }, ['-', $line->[1]];
  32         120  
47             } elsif ($line->[0] eq '+') {
48             # append
49 20         28 push @{ $new_diff }, ['+', $line->[2]];
  20         117  
50             } else {
51             # unchage
52 54         75 push @{ $old_diff }, ['u', $line->[1]];
  54         148  
53 54         111 push @{ $new_diff }, ['u', $line->[2]];
  54         156  
54             }
55             }
56             } else {
57 94         299 ($old_diff, $new_diff) = _fully($old, $new);
58             }
59 124 100       807 wantarray ? ($old_diff, $new_diff) : [ $old_diff, $new_diff];
60             }
61              
62             sub _fully {
63 154     154   317 my($old, $new) = @_;
64 154 100 100     959 return ([], []) unless $old || $new;
65 152         289 my @old_diff = ();
66 152         229 my @new_diff = ();
67 152         226 my $old_str;
68             my $new_str;
69              
70 152 100       289 my @diff = sdiff( map{ $_ ? [ split //, $_ ] : [] } $old, $new);
  304         7225  
71 152         538048 my $last_mode = $diff[0]->[0];
72 152         376 for my $line (@diff) {
73 7668 100       14189 if ($last_mode ne $line->[0]) {
74 1030 50       3435 push @old_diff, [$last_mode, $old_str] if defined $old_str;
75 1030 50       3325 push @new_diff, [$last_mode, $new_str] if defined $new_str;
76              
77             # skip concut ## i forget s mark
78 1030 50       2179 push @old_diff, ['s', ''] unless defined $old_str;
79 1030 50       1897 push @new_diff, ['s', ''] unless defined $new_str;
80              
81 1030         1402 $old_str = $new_str = undef;
82             }
83            
84 7668         8985 $old_str .= $line->[1];
85 7668         8304 $new_str .= $line->[2];
86 7668         10094 $last_mode = $line->[0];
87             }
88 152 50       652 push @old_diff, [$last_mode, $old_str] if defined $old_str;
89 152 50       543 push @new_diff, [$last_mode, $new_str] if defined $new_str;
90              
91 152         507 @old_diff = _fully_filter('-', @old_diff);
92 152         417 @new_diff = _fully_filter('+', @new_diff);
93              
94 152         2623 return (\@old_diff, \@new_diff);
95             }
96              
97             sub _fully_filter {
98 304     304   771 my($c_mode, @diff) = @_;
99 304         421 my @filter = ();
100 304         708 my $last_line = ['', ''];
101              
102 304         488 for my $line (@diff) {
103 2364 100       4629 $line->[0] = $c_mode if $line->[0] eq 'c';
104 2364 100       4465 if ($last_line->[0] eq $line->[0]) {
105 112         220 $last_line->[1] .= $line->[1];
106 112         215 next;
107             }
108 2252 100       13610 push @filter, $last_line if length $last_line->[1];
109 2252         3442 $last_line = $line;
110             }
111 304 100       975 push @filter, $last_line if length $last_line->[1];
112            
113 304         1550 @filter;
114             }
115              
116             sub diff {
117 45     45 1 286842 my($old, $new, %opts) = @_;
118 45         170 my($old_diff, $new_diff) = diff_fully($old, $new, %opts);
119 45         427 %opts = (%DEFAULT_MARKS, %opts);
120              
121 45         253 my $old_str = _str($old_diff, %opts);
122 45         166 my $new_str = _str($new_diff, %opts);
123              
124 45 100       566 wantarray ? ($old_str, $new_str) : [ $old_str, $new_str];
125             }
126              
127             sub _str {
128 90     90   309 my($diff, %opts) = @_;
129 90         112 my $str = '';
130              
131 90         96 my $escape;
132 90 100 66     245 if ($opts{escape} && ref($opts{escape}) eq 'CODE') {
133 2         4 $escape = $opts{escape};
134             }
135 90         111 for my $parts (@{ $diff }) {
  90         201  
136 758 100       1407 my $word = $escape ? $escape->($parts->[1]) : $parts->[1];
137 758 100       1889 if ($parts->[0] eq '-') {
    100          
138 97         326 $str .= "$opts{remove_open}$word$opts{remove_close}";
139             } elsif ($parts->[0] eq '+') {
140 177         524 $str .= "$opts{append_open}$word$opts{append_close}";
141             } else {
142 484         929 $str .= $word;
143             }
144             }
145 90         309 $str;
146             }
147              
148             sub diff_merge {
149 53     53 1 259789 my($old, $new, %opts) = @_;
150 53         275 my($old_diff, $new_diff) = diff_fully($old, $new, %opts);
151 53         617 %opts = (%DEFAULT_MARKS, %opts);
152              
153 53         168 my $old_c = 0;
154 53         85 my $new_c = 0;
155 53         95 my $str = '';
156              
157 53         81 my $escape;
158 53 100 66     269 if ($opts{regexp}) {
    100          
159 20     380   95 $escape = sub { quotemeta($_[0]) };
  380         853  
160             } elsif ($opts{escape} && ref($opts{escape}) eq 'CODE') {
161 1         2 $escape = $opts{escape};
162             }
163             LOOP:
164 53   100     135 while (scalar(@{ $old_diff }) > $old_c && scalar(@{ $new_diff }) > $new_c) {
  554         1488  
  505         1766  
165 501 100       1395 my $old_str = $escape ? $escape->($old_diff->[$old_c]->[1]) : $old_diff->[$old_c]->[1];
166 501 100       1175 my $new_str = $escape ? $escape->($new_diff->[$new_c]->[1]) : $new_diff->[$new_c]->[1];
167              
168 501 100 100     3582 if ($old_diff->[$old_c]->[0] eq 'u' && $new_diff->[$new_c]->[0] eq 'u') {
    100 100        
    100 66        
    50 33        
169 274         401 $str .= $old_str;
170 274         271 $old_c++;
171 274         355 $new_c++;
172             } elsif ($old_diff->[$old_c]->[0] eq '-' && $new_diff->[$new_c]->[0] eq '+') {
173 67         181 $str .= "$opts{remove_open}$old_str";
174 67 100       242 $str .= "$opts{remove_close}$opts{separator}$opts{append_open}" unless $opts{regexp};
175 67 100       203 $str .= $opts{separator} if $opts{regexp};
176 67         345 $str .= "$new_str$opts{append_close}";
177 67         86 $old_c++;
178 67         100 $new_c++;
179             } elsif ($old_diff->[$old_c]->[0] eq 'u' && $new_diff->[$new_c]->[0] eq '+') {
180 114         312 $str .= "$opts{append_open}$new_str$opts{append_close}";
181 114         198 $new_c++;
182             } elsif ($old_diff->[$old_c]->[0] eq '-' && $new_diff->[$new_c]->[0] eq 'u') {
183 46         151 $str .= "$opts{remove_open}$old_str$opts{remove_close}";
184 46         86 $old_c++;
185             }
186             }
187              
188 53         270 $str .= _list_gc($old_diff, $old_c, %opts);
189 53         210 $str .= _list_gc($new_diff, $new_c, %opts);
190              
191 53         772 $str;
192             }
193              
194             sub _list_gc {
195 106     106   416 my($diff, $c, %opts) = @_;
196 106         155 my $str = '';
197              
198 106         113 my $escape;
199 106 100 66     461 if ($opts{regexp}) {
    100          
200 40     6   132 $escape = sub { quotemeta($_[0]) };
  6         17  
201             } elsif ($opts{escape} && ref($opts{escape}) eq 'CODE') {
202 2         3 $escape = $opts{escape};
203             }
204 106         135 while (scalar(@{ $diff }) > $c) {
  126         325  
205 20 100       70 my $_str = $opts{regexp} ? $escape->($diff->[$c]->[1]) : $diff->[$c]->[1];
206 20 100       76 if ($diff->[$c]->[0] eq '-') {
    50          
207 8         23 $str .= "$opts{remove_open}$_str$opts{remove_close}";
208             } elsif ($diff->[$c]->[0] eq '+') {
209 12         38 $str .= "$opts{append_open}$_str$opts{append_close}";
210             } else {
211 0         0 $str .= $_str;
212             }
213 20         33 $c++;
214             }
215 106         432 $str;
216             }
217              
218             my %regexp_opts = (
219             remove_open => '(?:',
220             remove_close => ')',
221             append_open => '(?:',
222             append_close => ')',
223             separator => '|',
224             regexp => 1,
225             escape => undef,
226             );
227              
228             sub diff_regexp {
229 20     20 1 175612 my($old, $new, %opts) = @_;
230 20         133 diff_merge($old, $new, %opts, %regexp_opts);
231             }
232              
233             1;
234             __END__