File Coverage

script/sdif
Criterion Covered Total %
statement 441 663 66.5
branch 145 294 49.3
condition 81 186 43.5
subroutine 38 66 57.5
pod n/a
total 705 1209 58.3


line stmt bran cond sub pod time code
1             #!/usr/bin/env perl
2              
3             ##
4             ## sdif: sdiff clone
5             ##
6             ## Copyright (c) 1992- Kazumasa Utashiro
7             ##
8             ## Original version on Jul 24 1991
9             ##
10              
11             =pod
12              
13             =head1 NAME
14              
15             sdif - side-by-side diff viewer for ANSI terminal
16              
17             =head1 VERSION
18              
19             Version 4.46
20              
21             =head1 SYNOPSIS
22              
23             sdif file_1 file_2
24              
25             diff ... | sdif
26              
27             OPTIONS:
28              
29             -i, --ignore-case
30             -b, --ignore-space-change
31             -w, --ignore-all-space
32             -B, --ignore-blank-lines
33              
34             --[no]number, -n print line number
35             --digit=# set the line number digits (default 4)
36             --truncate, -t truncate long line
37             --boundary=# line folding boundary (default word)
38             --context, -c, -C# context diff
39             --unified, -u, -U# unified diff
40              
41             --width=#, -W# width of output (default 80)
42             --margin=# margin column number (default 0)
43             --runin=# run-in column number (default --margin)
44             --runout=# run-out column number (default --margin)
45             --mark=position mark position (right, left, center, side) or no
46             --column=order column order (default ONM)
47             --view, -v viewer mode
48             --parallel[=#], -V treat unknown text as common part (default 2)
49             --ambiguous=s ambiguous character width (detect, wide, narrow)
50             --[no-]command print diff control command (default on)
51             --[no-]filename print diff filename (default on)
52             --[no-]prefix process git --graph output (default on)
53             --prefix-pattern prefix pattern
54              
55             --color=when 'always' (default), 'never' or 'auto'
56             --nocolor --color=never
57             --colormap, --cm specify color map
58             --colortable[=#] show color table (optional #: 6, 12, 24)
59             --[no-]256 on/off ANSI 256 color mode (default on)
60             --[no-]cc color command line (default true)
61             --[no-]fc file name (default true)
62             --[no-]lc line number (default true)
63             --[no-]mc diff mark (default true)
64             --[no-]tc normal text (default true)
65             --[no-]uc unknown text (default true)
66              
67             --man display manual page
68             --version show version
69             --diff=s set diff command
70             --diffopts=s set diff command options
71              
72             --[no-]lenience suppress unexpected input warning (default on)
73             --limit key=val set limit (line, length)
74             --visible xx=1 set visible chars
75             --tabhead=char set tabhead char
76             --tabspace=char set tabspace char
77             --tabstyle=style set tabstyle (dot, symbol, shade, bar, dash...)
78             --tabstop=# set tabstop width (default 8)
79              
80             --[no-]cdif use ``cdif'' as word context diff backend
81             --unit=s pass through to cdif (word, letter, char, mecab)
82             --cdifopts=s set cdif command options
83              
84             =cut
85              
86 10     10   38305 use v5.14;
  10         28  
87 10     10   39 use warnings;
  10         10  
  10         470  
88 10     10   3664 use utf8;
  10         2158  
  10         46  
89 10     10   4722 use Encode;
  10         138539  
  10         944  
90 10     10   4043 use open IO => ':utf8';
  10         9932  
  10         41  
91 10     10   909 use Carp;
  10         12  
  10         603  
92 10     10   4256 use charnames ':full';
  10         74466  
  10         60  
93 10     10   170028 use List::Util qw(min max reduce sum pairmap first);
  10         23  
  10         1420  
94 10     10   4360 use Pod::Usage;
  10         420274  
  10         1278  
95 10     10   4608 use Text::ParseWords qw(shellwords);
  10         13120  
  10         636  
96 10     10   5488 use Data::Dumper; {
  10         74469  
  10         968  
97 10         1365224 $Data::Dumper::Terse = 1;
  10         27  
98             }
99              
100 10     10   4180 use App::sdif;
  10         22  
  10         546  
101 10         29 my $version = $App::sdif::VERSION;
102              
103 10     10   3927 use App::sdif::Util;
  10         26  
  10         1177  
104 10     10   4101 use IO::Divert;
  10         6417  
  10         1208  
105              
106 10         22 my $default_cdif = 'cdif';
107 10         55 my @default_cdifopts = qw(--sdif);
108 10         22 my $default_lenience = 1;
109 10         20 my $default_256 = 1;
110 10         19 my $default_prefix = 1;
111 10         20 my $default_prefix_pattern = q/(?:\\| )*(?: )?/;
112 10         26 my @cdifopts;
113             my $read_stdin;
114              
115 10         14 our $screen_width;
116              
117 10 50       71 if (my $env = $ENV{'SDIFOPTS'}) {
118 0         0 unshift @ARGV, shellwords($env);
119             }
120              
121 10     10   54 use open IO => ':utf8', ':std';
  10         12  
  10         100  
122 10 50       24 map { $_ = decode 'utf8', $_ unless utf8::is_utf8($_) } @ARGV;
  41         710  
123              
124 10         154 my $app;
125              
126 10     10   6337 use Getopt::EX::Hashed; {
  10         67988  
  10         57  
127              
128 10         26 Getopt::EX::Hashed->configure( DEFAULT => [ is => 'rw' ] );
  10         124  
129              
130 10         339 has help => ' h ' ;
131 10         523 has version => ' ' ;
132 10         355 has man => ' ' ;
133 10         293 has debug => 'd + ' ;
134 10         294 has number => 'n ! ' ;
135 10         315 has digit => ' =i ' , default => 4 ;
136 10         331 has column => ' =s ' ;
137 10         295 has truncate => 't ! ' ;
138 10         316 has boundary => ' =s ' , default => 'word' ;
139 10         363 has onword => ' ! ' ;
140 10         392 has mark => ' =s ' , default => 'center' ;
141 10         363 has prefix => ' ! ' , default => $default_prefix ;
142 10         376 has prefix_pattern => ' =s ' , default => $default_prefix_pattern ;
143 10         355 has width => 'W =i ' ;
144 10         392 has margin => ' =i ' , default => 0 ;
145 10         437 has runin => ' =i ' ;
146 10         385 has runout => ' =i ' ;
147 10         412 has view => 'v ! ' ;
148 10         408 has parallel => 'V :2 ' , default => 0 ;
149 10         528 has ambiguous => ' =s ' , default => 'narrow' ;
150 10         499 has filename => ' ! ' , default => 1 ;
151 10         487 has command => ' ! ' , default => 1 ;
152 10         531 has diff => ' =s ' , default => 'diff' ;
153 10         449 has diffopts => ' =s@' , default => [] ;
154 10         469 has color => ' =s ' , default => 'always' ;
155 10         462 has colormap => 'cm=s@' , default => [] ;
156 10         428 has colordump => ' ' ;
157 10         430 has 256 => ' ! ' , default => $default_256 ;
158 10         462 has commandcolor => 'cc! ' , default => 1 ;
159 10         445 has filecolor => 'fc! ' , default => 1 ;
160 10         690 has linecolor => 'lc! ' , default => 1 ;
161 10         634 has markcolor => 'mc! ' , default => 1 ;
162 10         533 has textcolor => 'tc! ' , default => 1 ;
163 10         549 has unknowncolor => 'uc! ' , default => 1 ;
164 10         584 has cdif => ' :s ' , default => '' ;
165 10         529 has cdifopts => ' =s ' ;
166 10         572 has colortable => ' :s ' , any => qr/^(|6|12|24)$/ ;
167 10         638 has lenience => ' ! ' , default => $default_lenience ;
168 10         637 has limit => ' =s%' , default => { length => 10000 } ;
169 10         706 has visible => ' =i%' , default => {} ;
170 10         574 has tabstop => ' =i ' , default => 8 ;
171 10         537 has tabhead => ' =s ' ;
172 10         562 has tabstyle => 'ts=s ' ;
173 10         545 has tabspace => ' =s ' ;
174 10         561 has unit => 'by:s ' ;
175              
176 10         658 has ignore_case => 'i ' ;
177 10         665 has ignore_space_change => 'b ' ;
178 10         611 has ignore_all_space => 'w ' ;
179 10         586 has ignore_blank_lines => 'B ' ;
180 10         576 has context => 'C =i' ;
181 10         598 has unified => 'U =i' ;
182 10         661 has c => ' ' ;
183 10         679 has u => ' ' ;
184              
185             has '+onword'
186 10 0   0   704 => sub { $_->boundary = $_[1] ? 'word' : '' } ;
  0         0  
187              
188             has '+cdifopts'
189 10     0   425 => sub { push @cdifopts, shellwords $_[1] } ;
  0         0  
190              
191             has '+ignore_case'
192 10     0   558 => sub { push @{$app->diffopts}, '-i'; push @cdifopts, '-i' } ;
  0         0  
  0         0  
  0         0  
193             has '+ignore_space_change'
194 10     0   654 => sub { push @{$app->diffopts}, '-b'; push @cdifopts, '-w' } ;
  0         0  
  0         0  
  0         0  
195             has '+ignore_all_space'
196 10     0   567 => sub { push @{$app->diffopts}, '-w'; push @cdifopts, '-w' } ;
  0         0  
  0         0  
  0         0  
197             has '+ignore_blank_lines'
198 10     0   567 => sub { push @{$app->diffopts}, '-B' } ;
  0         0  
  0         0  
199              
200 10     0   586 has '+c' => sub { push @{$app->diffopts}, '-c' } ;
  0         0  
  0         0  
201 10     0   666 has '+u' => sub { push @{$app->diffopts}, '-u' } ;
  0         0  
  0         0  
202 10     0   621 has '+context' => sub { push @{$app->diffopts}, '-C' . $_[1] } ;
  0         0  
  0         0  
203 10     0   629 has '+unified' => sub { push @{$app->diffopts}, '-U' . $_[1] } ;
  0         0  
  0         0  
204              
205 10     5   573 has nocolor => 'no-color' , action => sub { $app->color = 'never' } ;
  5         3204  
206 10     5   672 has nocdif => 'no-cdif' , action => sub { $app->cdif = undef } ;
  5         71182  
207              
208 10 0   0   732 has mecab => '!' , action => sub { $app->unit = $_[1] ? 'mecab' : undef } ;
  0         0  
209              
210             has '+ambiguous' => sub {
211 0 0   0   0 if ($_[1] =~ /^(?:wide|full)/) {
212 0         0 $Text::VisualWidth::PP::EastAsian = 1;
213 0         0 Text::ANSI::Fold->configure(ambiguous => 'wide');
214             }
215 10         706 } ;
216              
217 10     0   417 has '+help' => sub { usage() } ;
  0         0  
218 10     0   252 has '+version' => sub { print "$version\n"; exit 0 } ;
  0         0  
  0         0  
219 10     0   273 has '+man' => sub { pod2usage {-verbose => 2} } ;
  0         0  
220              
221 10     10   12144 } no Getopt::EX::Hashed;
  10         14  
  10         40  
222              
223 10 50       292 $app = Getopt::EX::Hashed->new() or die;
224              
225 10         14529 my @SAVEDARGV = @ARGV;
226 10     10   5327 use Getopt::EX::Long qw(:DEFAULT Configure ExConfigure);
  10         711596  
  10         2068  
227 10         69 ExConfigure BASECLASS => [ "App::sdif", "Getopt::EX" ];
228 10         310 Configure "bundling";
229 10 50       349 $app->getopt or usage({status => 1});
230              
231 10 50       72027 warn "\@ARGV = (@SAVEDARGV)\n" if $app->debug;
232              
233 10         77 $App::sdif::Util::NO_WARNINGS = $app->lenience;
234              
235 10     10   4511 use Text::VisualWidth::PP qw(vwidth);
  10         28127  
  10         769  
236 10     10   4438 use Text::ANSI::Fold qw(ansi_fold :constants); {
  10         137068  
  10         6596  
237 10         41 Text::ANSI::Fold->configure(padding => 1,
  10         34  
238             expand => 1,
239             tabstop => $app->tabstop);
240             }
241              
242 10 50 0     672 $app->visible->{ht} //= 1 if $app->tabstyle;
243 10 50       62 if ($app->visible->{ht}) {
244             Text::ANSI::Fold->configure(
245             tabstyle => $app->tabstyle,
246 0         0 map { $_->[0] => unicode($_->[1]) }
247 0         0 grep { $_->[1] }
  0         0  
248             [ tabhead => $app->tabhead ],
249             [ tabspace => $app->tabspace ],
250             );
251             }
252              
253             sub unicode {
254 0 0   0   0 my $char = shift or return undef;
255 0 0       0 if ($char =~ /^\X$/) {
256 0         0 $char;
257             } else {
258 0 0       0 eval qq["\\N{$char}"] or die "$!";
259             }
260             }
261              
262 10 50       67 if ($app->margin > 0) {
263 0 0 0     0 if ($app->runin and $app->margin < $app->runin) {
264 0         0 die "margin must be >= runin\n";
265             }
266             Text::ANSI::Fold->configure(
267 0   0     0 linebreak => LINEBREAK_ALL,
      0        
268             margin => $app->margin,
269             runin => $app->runin // $app->margin,
270             runout => $app->runout // $app->margin,
271             );
272             }
273              
274 10         55 my %colormap = do {
275 10 50       37 my $col = $app->{256} ? 0 : 1;
276 200 100   200   417 pairmap { $a => (ref $b eq 'ARRAY') ? $b->[$col] : $b } (
277 10         211 UNKNOWN => "" ,
278             OCOMMAND => [ "555/010" , "GS" ],
279             NCOMMAND => [ "555/010" , "GS" ],
280             MCOMMAND => [ "555/010" , "GS" ],
281             OFILE => [ "551/010D" , "GDS" ],
282             NFILE => [ "551/010D" , "GDS" ],
283             MFILE => [ "551/010D" , "GDS" ],
284             OMARK => [ "010/444" , "G/W" ],
285             NMARK => [ "010/444" , "G/W" ],
286             MMARK => [ "010/444" , "G/W" ],
287             UMARK => "" ,
288             OLINE => [ "220" , "Y" ],
289             NLINE => [ "220" , "Y" ],
290             MLINE => [ "220" , "Y" ],
291             ULINE => "" ,
292             OTEXT => [ "K/454" , "G" ],
293             NTEXT => [ "K/454" , "G" ],
294             MTEXT => [ "K/454" , "G" ],
295             UTEXT => "" ,
296             NOTICE => "R" ,
297             );
298             };
299              
300 10     10   79 use Getopt::EX::Colormap;
  10         13  
  10         575  
301 10         45 $Getopt::EX::Colormap::NO_RESET_EL = 1;
302 10     10   36 use constant SGR_RESET => "\e[m";
  10         16  
  10         7673  
303             my $color_handler = Getopt::EX::Colormap
304             ->new(HASH => \%colormap)
305 10         96 ->load_params(@{$app->colormap});
  10         840  
306              
307 10   33     276 $colormap{OUMARK} ||= $colormap{UMARK} || $colormap{OMARK};
      33        
308 10   33     79 $colormap{NUMARK} ||= $colormap{UMARK} || $colormap{NMARK};
      33        
309 10   33     89 $colormap{OULINE} ||= $colormap{ULINE} || $colormap{OLINE};
      33        
310 10   33     67 $colormap{NULINE} ||= $colormap{ULINE} || $colormap{NLINE};
      33        
311              
312 10         29 for (
313             [ $app->unknowncolor => q/UNKNOWN/ ],
314             [ $app->commandcolor => q/COMMAND/ ],
315             [ $app->filecolor => q/FILE/ ],
316             [ $app->linecolor => q/LINE/ ],
317             [ $app->markcolor => q/MARK/ ],
318             [ $app->textcolor => q/TEXT/ ],
319             ) {
320 60         250 my($color, $label) = @$_;
321 60 50       98 $color and next;
322 0         0 for (grep /$label/, keys %colormap) {
323 0         0 $colormap{$_} = '';
324             }
325             }
326              
327 10 50       38 if ($app->colordump) {
328 0         0 print $color_handler->colormap(
329             name => '--changeme', option => '--colormap');
330 0         0 exit;
331             }
332              
333 10         46 my $painter = do {
334 10 100 33     28 if (($app->color eq 'always')
      66        
335             or (($app->color eq 'auto') and (-t STDOUT))) {
336 5     445   56 sub { $color_handler->color(@_) };
  445         862  
337             } else {
338 5     175   72 sub { $_[1] } ;
  175         273  
339             }
340             };
341              
342             ##
343             ## setup cdif command and option
344             ##
345 10 100 66     28 if (defined $app->cdif and $app->cdif eq '') {
346 5         47 $app->cdif = $default_cdif;
347             }
348              
349 10         86 for (
350             [ "unit" , "=" , $app->unit , undef ] ,
351             [ "256" , "!" , $app->{256} , $default_256 ] ,
352             [ "prefix" , "!" , $app->prefix , $default_prefix ] ,
353             [ "lenience" , "!" , $app->lenience , $default_lenience ] ,
354             )
355             {
356 40         184 my($name, $type, $var, $default) = @$_;
357 40 100       69 if ($type eq "!") {
    50          
358 30 50       45 next if not defined $var;
359 30 50       57 next if $var == $default;
360 0 0       0 unshift @cdifopts, sprintf("--%s%s", $var ? '' : 'no-', $name);
361             } elsif ($type eq "=") {
362 10 50       35 next if not defined $var;
363 0         0 unshift @cdifopts, sprintf("--%s=%s", $name, $var);
364             } else {
365 0         0 die;
366             }
367             }
368              
369 10         36 unshift @cdifopts, @default_cdifopts;
370              
371 10         20 my($OLD, $NEW, $DIFF);
372 10 50       47 if (@ARGV == 2) {
    50          
373 0         0 ($OLD, $NEW) = @ARGV;
374 0         0 $DIFF = "$app->{diff} @{$app->{diffopts}} $OLD $NEW |";
  0         0  
375             } elsif (@ARGV < 2) {
376 10   100     32 $DIFF = shift || '-';
377 10         18 $read_stdin++;
378             } else {
379 0         0 usage({status => 1}, "Unexpected arguments.\n\n");
380             }
381             my $readfile =
382 10   0     36 ($OLD and $NEW) && !$read_stdin && !(grep { /^-[cuCU]/ } @{$app->diffopts});
383              
384             use constant {
385 10         2691 RIGHT => 'right',
386             LEFT => 'left',
387             NO => 'no',
388 10     10   61 };
  10         15  
389 10         129 my %markpos = (
390             center => [ RIGHT , LEFT , LEFT ],
391             side => [ LEFT , RIGHT , LEFT ],
392             right => [ RIGHT , RIGHT , RIGHT ],
393             left => [ LEFT , LEFT , LEFT ],
394             no => [ NO , NO , NO ],
395             none => [ NO , NO , NO ],
396             );
397 10 50       27 unless ($markpos{$app->mark}) {
398 0         0 my @keys = sort keys %markpos;
399 0         0 usage "Use one from (@keys) for option --mark\n\n";
400             }
401 10         56 my @markpos = @{$markpos{$app->mark}};
  10         25  
402 10         54 my($omarkpos, $nmarkpos, $mmarkpos) = @markpos;
403              
404 10         28 my $num_format = sprintf '%%%dd', $app->digit;
405              
406 10   66     72 $screen_width = $app->width || &terminal_width;
407              
408             sub column_width {
409 156     156   222 my $column = shift;
410 156         193 state %column_width;
411 156   66     642 $column_width{$screen_width * 1000 + $column} //= do {
412 10     10   71 use integer;
  10         15  
  10         38  
413 9         26 my $w = $screen_width;
414 9 50       46 $w -= $column if $app->mark;
415 9         120 max 1, $w / $column;
416             };
417             }
418              
419             ##
420             ## --colortable
421             ##
422 10 100       91 if (defined(my $n = $app->colortable)) {
423 10     10   1059 no strict 'refs';
  10         13  
  10         94444  
424 1         5 &{"Getopt::EX::Colormap::colortable$n"}($screen_width);
  1         12  
425 1         0 exit;
426             }
427              
428             ##
429             ## Column order
430             ##
431 9 50       65 my @column = !$app->column ? () : do {
432 0         0 map { $_ - 1 }
433 0   0     0 map { { O=>1, N=>2, M=>3 }->{$_} // $_ }
  0         0  
434             $app->column =~ /[0-9ONM]/g;
435             };
436              
437             ##
438             ## Git --graph prefix pattern
439             ##
440 9         51 my $prefix_re = do {
441 9 50       20 if ($app->prefix) {
442 9         238 qr/$app->{prefix_pattern}/;
443             } else {
444 0         0 "";
445             }
446             };
447              
448 9 50       24 if ($app->debug) {
449 0   0     0 printf STDERR "\$OLD = %s\n", $OLD // "undef";
450 0   0     0 printf STDERR "\$NEW = %s\n", $NEW // "undef";
451 0   0     0 printf STDERR "\$DIFF = %s\n", $DIFF // "undef";
452             }
453              
454 9 100       66 if ($app->cdif) {
455 4         8615 my $pid = open DIFF, '-|';
456 4 50       518 if (not defined $pid) {
    50          
457 0 0       0 die "$!" if not defined $pid;
458             }
459             ## child
460             elsif ($pid == 0) {
461 0 0       0 if ($DIFF ne '-') {
462 0 0       0 open(STDIN, $DIFF) || die "cannot open diff: $!\n";
463             }
464 0         0 do { exec shellwords($app->cdif), @cdifopts } ;
  0         0  
465 0         0 warn "exec failed: $!";
466 0         0 print while <>;
467 0         0 exit;
468             }
469             ## parent
470             else {
471             ## nothing to do
472             }
473             } else {
474 5 50       235 open(DIFF, $DIFF) || die "cannot open diff: $!\n";
475             }
476              
477 9 50       208 if ($readfile) {
478              
479 0         0 binmode DIFF, ':raw';
480 0         0 my $DIFFOUT = do { local $/; };
  0         0  
  0         0  
481 0         0 close DIFF;
482 0 0       0 open DIFF, '<', \$DIFFOUT or die;
483              
484 0 0       0 open OLD, $OLD or die "$OLD: $!\n";
485 0 0       0 open NEW, $NEW or die "$NEW: $!\n";
486              
487             # For reading /dev/fd/*
488 0 0 0     0 seek OLD, 0, 0 or die unless -p OLD;
489 0 0 0     0 seek NEW, 0, 0 or die unless -p NEW;
490             }
491              
492 9         356 my @boundary = (boundary => $app->boundary);
493 9         337 my $color_re = qr{ \e \[ [\d;]* [mK] }x;
494              
495 9         113 our $oline = 1;
496 9         67 our $nline = 1;
497 9         51 our $mline = 1;
498              
499 9         2183412 while () {
500             #
501             # normal diff
502             #
503 50 100       1651 if (/^([\d,]+)([adc])([\d,]+)$/) {
    100          
    100          
    100          
    100          
    50          
    50          
    50          
    50          
504 5         11 my(@old, @new);
505 5         60 my($left, $ctrl, $right) = ($1, $2, $3);
506 5         51 my($l1, $l2) = range($left);
507 5         13 my($r1, $r2) = range($right);
508 5 50       29 if ($readfile) {
509 0         0 my $identical_line = $l1 - $oline + 1 - ($ctrl ne 'a');
510 0         0 print_identical($identical_line);
511             }
512 5 50 33     27 if ($app->debug || $read_stdin) {
513 5         140 print_command_n($_, $_);
514             }
515 5 100 100     30 if ($ctrl eq 'd' || $ctrl eq 'c') {
516 4         17 ($oline) = $left =~ /^(\d+)/;
517 4         11 my $n = $l2 - $l1 + 1;
518 4         17 @old = read_line(*DIFF, $n);
519 4 50       8 $readfile and read_line(*OLD, $n);
520             }
521 5 100       25 read_line(*DIFF, 1) if $ctrl eq 'c';
522 5 100 100     15 if ($ctrl eq 'a' || $ctrl eq 'c') {
523 4         11 ($nline) = $right =~ /^(\d+)/;
524 4         6 my $n = $r2 - $r1 + 1;
525 4         6 @new = read_line(*DIFF, $n);
526 4 50       7 $readfile and read_line(*NEW, $n);
527             }
528             map {
529 5         7 s/^([<>])\s?/{'<' => '-', '>' => '+'}->{$1}/e
  12         30  
  12         50  
530             } @old, @new;
531 5         17 flush_buffer([], \@old, \@new);
532             }
533             #
534             # context diff
535             #
536             elsif (/^\*\*\* /) {
537 1         23 my $next = ;
538 1         56 print_command_n({ type => 'FILE' }, $_, $next);
539             }
540             elsif ($_ eq "***************\n") {
541 1         1 my(@old, @new);
542 1         9180 my $ohead = $_ = ;
543 1         5 my($left, $right);
544 1 50       25 unless (($left) = /^\*\*\* ([\d,]+) \*\*\*\*$/) {
545 0         0 print;
546 0         0 next;
547             }
548 1         15 my $oline = range($left);
549 1         2 my $dline = 0;
550 1         2 my $cline = 0;
551 1         4 my $nhead = $_ = ;
552 1 50       3 unless (($right) = /^--- ([\d,]+) ----$/) {
553 1         14 @old = read_line(*DIFF, $oline - 1, $nhead);
554 1         3 $nhead = $_ = ;
555 1 50       17 unless (($right) = /^--- ([\d,]+) ----$/) {
556 0         0 print $ohead, @old, $_;
557 0         0 next;
558             }
559 1         4 for (@old) {
560 14 100       31 /^-/ and ++$dline;
561 14 100       52 /^!/ and ++$cline;
562             }
563             }
564 1         5 my $nline = range($right);
565 1 50 33     13 if (@old == 0 or $cline != 0 or ($oline - $dline != $nline)) {
      33        
566 1         3 @new = read_line(*DIFF, $nline);
567             }
568 1         4 print_command_n($ohead, $nhead);
569 1         29 ($oline) = $left =~ /^(\d+)/;
570 1         10 ($nline) = $right =~ /^(\d+)/;
571              
572 1         17 my @buf = merge_diffc(\@old, \@new);
573 1         6 flush_buffer(@buf);
574             }
575             #
576             # unified diff
577             #
578             elsif (/^($prefix_re)(--- (?s:.*))/) {
579 10         74 my($prefix, $left) = ($1, $2);
580 10         34 my $right = ;
581 10         34 local $screen_width = $screen_width;
582 10 100       122 if ($prefix) {
583 4         49 $right =~ s/^\Q$prefix//;
584 4         24 print $prefix;
585 4         7 $screen_width -= length $prefix;
586             }
587 10         86 print_command_n({ type => 'FILE' }, $left, $right);
588             }
589             elsif (m{^
590             (?$prefix_re)
591             (?
592             \@\@ [ ]
593             \-(?\d+) (?:,(?\d+))? [ ]
594             \+(?\d+) (?:,(?\d+))? [ ]
595             \@\@
596             (?s:.*)
597             )
598             }x) {
599 10         115 ($oline, $nline) = @+{qw(oline nline)};
600 10   50     99 my($o, $n) = ($+{o}//1, $+{n}//1);
      100        
601 10         66 my($prefix, $command) = @+{qw(prefix command)};
602              
603 10         26 local $screen_width = $screen_width;
604 10         71 my($divert, %read_opt);
605 10 100       32 if ($prefix) {
606 4         7 $screen_width -= length $prefix;
607 4         14 $read_opt{prefix} = $prefix;
608 4     4   42 $divert = IO::Divert->new(FINAL => sub { s/^/$prefix/mg });
  4         231  
609             }
610              
611 10         2461 print_command_n({ type => 'COMMAND' }, $command, $command);
612 10         76 my @buf = read_unified_2 \%read_opt, *DIFF, $o, $n;
613              
614 10         120 flush_buffer(@buf);
615             }
616             #
617             # diff --combined (only support 3 files)
618             #
619             elsif (/^diff --(?:cc|combined)/) {
620 0         0 my @lines = ($_);
621 0     0   0 push @lines, read_until { /^\+\+\+/ } *DIFF;
  0         0  
622 0 0       0 if (not defined $lines[-1]) {
623 0         0 pop @lines;
624 0         0 print @lines;
625 0         0 next;
626             }
627 0         0 print @lines;
628             }
629             elsif (/^\@{3} -(\d+)(?:,(\d+))? -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? \@{3}/) {
630 0         0 print_command_n({ type => 'COMMAND' }, $_, $_, $_);
631              
632 0         0 ($oline, $nline, $mline) = ($1, $3, $5);
633 0         0 state $read_unified_3 = read_unified_sub(3);
634 0   0     0 my @buf = $read_unified_3->(*DIFF, $2 // 1, $4 // 1, $6 // 1);
      0        
      0        
635 0         0 flush_buffer_3(@buf);
636             }
637             #
638             # conflict marker
639             #
640             elsif (/^<<<<<<<\h*+(.*)/) {
641             CONFLICT:
642             {
643 0         0 my %name = (o => $_);
  0         0  
644 0         0 my($c1, $c2, $c3, $c4);
645 0         0 $c1 = $_;
646              
647 0     0   0 my @old = read_until { /^=======$/ } *DIFF;
  0         0  
648 0   0     0 $c2 = pop @old // do {
649 0         0 flush_unknown($c1, @old);
650 0         0 last;
651             };
652              
653 0     0   0 my @new = read_until { /^>>>>>>>\h*+(.*)/ } *DIFF;
  0         0  
654 0   0     0 $c4 = pop @new // do {
655 0         0 flush_unknown($c1, @old, $c2, @new);
656 0         0 last;
657             };
658 0         0 $name{n} = $c4;
659              
660 0         0 my @mrg;
661 0     0   0 my $mrg = first { $old[$_] =~ /^\Q|||||||\E\h*+(.*)/ } keys @old;
  0         0  
662 0 0 0     0 if (defined $mrg or $app->parallel > 2) {
663 0 0       0 if (defined $mrg) {
664 0         0 $name{m} = $old[$mrg];
665 0         0 ($c3, @mrg) = splice @old, $mrg;
666             } else {
667 0         0 $name{m} = $name{o};
668 0         0 $name{o} = $name{n};
669 0         0 @mrg = @old;
670 0         0 @old = @new;
671             }
672 0         0 s/^/--/ for @old, @mrg;
673 0         0 s/^/++/ for @new;
674 0         0 print_command_n({ type => 'FILE' }, @name{qw(o m n)});
675 0         0 flush_buffer_3([], \@old, \@mrg, \@new);
676             } else {
677 0         0 s/^/-/ for @old;
678 0         0 s/^/+/ for @new;
679 0         0 print_command_n({ type => 'FILE' }, @name{qw(o n)});
680 0         0 flush_buffer([], \@old, \@new);
681             }
682             }
683             }
684             #
685             # #ifdef custom container
686             #
687             # #ifdef JA ::::::: ja
688             # japanese text japanese text
689             # #endif :::::::
690             # #ifdef EN ::::::: en
691             # english text english text
692             # #endif :::::::
693             #
694             elsif (/^(\#ifdef|:{7,})\h++(.*)/) {
695             COLON:
696             {
697 0         0 my($c1, $c2, $c3, $c4) = ($_);
  0         0  
698 0         0 my $start = $1;
699 0 0       0 my $end = $start eq '#ifdef' ? qr/^#endif$/ : qr/^$start$/;
700 0         0 my($m1, $m2) = ($2);
701              
702 0     0   0 my @old = read_until { /$end/ } *DIFF;
  0         0  
703 0   0     0 $c2 = pop @old // do {
704 0         0 flush_unknown($c1, @old);
705 0         0 last;
706             };
707 0         0 $c3 = ;
708 0 0       0 if ($c3 !~ /^${start}\h++(.*)/) {
709 0         0 flush_unknown($c1, @old, $c2, $c3);
710 0         0 last;
711             }
712 0         0 $m2 = $1;
713 0     0   0 my @new = read_until { /$end/ } *DIFF;
  0         0  
714 0   0     0 $c4 = pop @new // do {
715 0         0 flush_unknown($c1, @old, $c2, $c3, @new);
716 0         0 last;
717             };
718              
719 0         0 @old = (" $c1", map(s/^/-/r, @old), " $c2");
720 0         0 @new = (" $c3", map(s/^/+/r, @new), " $c4");
721 0         0 flush_buffer([], \@old, \@new);
722             }
723             }
724             else {
725 23         56 flush_unknown($_);
726             }
727             }
728             continue {
729 50         2937495 STDOUT->flush;
730             }
731              
732 9         433 close DIFF;
733 9 50       112 my $exit = $DIFF =~ /\|$/ ? $? >> 8 : 0;
734              
735 9 50       33 if ($readfile) {
736 0 0       0 if ($exit < 2) {
737 0         0 print_identical(-1);
738             }
739 0         0 close OLD;
740 0         0 close NEW;
741             }
742              
743 9         131 exit($exit > 1);
744              
745             ######################################################################
746              
747             ##
748             ## Convert diff -c output to -u compatible format.
749             ##
750             sub merge_diffc {
751 1     1   3 my @o = @{+shift};
  1         9  
752 1         3 my @n = @{+shift};
  1         6  
753 1         3 for (@o, @n) {
754 28 50       112 s/(?<= ^[ \-\+\!] ) [\t ]//x or die "Format error (-c).\n";
755             }
756              
757 1         2 my @buf;
758 1   66     6 while (@o or @n) {
759              
760 6         13 push @buf, \( my( @common, @old, @new ) );
761              
762 6   100     32 while (@o and $o[0] =~ /^ /) {
763 8         10 push @common, shift @o;
764 8 100       19 shift @n if @n;
765             }
766 6   100     17 while (@n and $n[0] =~ /^ /) {
767 3         9 push @common, shift @n;
768             }
769              
770 6   100     17 push @old, shift @o while @o and $o[0] =~ /^\-/;
771 6 100       10 next if @old;
772              
773 5   100     19 push @new, shift @n while @n and $n[0] =~ /^\+/;
774 5 100       7 next if @new;
775              
776 4   100     20 push @old, shift @o while @o and $o[0] =~ s/^!/-/;
777 4   100     22 push @new, shift @n while @n and $n[0] =~ s/^!/+/;
778             }
779              
780 1         4 @buf;
781             }
782              
783             sub flush_unknown {
784 23 50   23   50 if ($app->parallel > 2) {
    50          
785 0         0 flush_buffer_3( [ map s/^/ /r, @_ ] );
786             }
787             elsif ($app->parallel > 1) {
788 0         0 flush_buffer( [ map s/^/ /r, @_ ] );
789             }
790             else {
791 23         181 print $painter->('UNKNOWN', $_) for @_;
792             }
793             }
794              
795             sub flush_buffer {
796              
797 16     16   52 push @_, [] while @_ % 3;
798              
799 16 50       61 if ($app->view) {
800 0         0 @_ = do {
801 0         0 map { @$_ }
802             reduce {
803             [ [] ,
804 0         0 [ map { @$_ } $a->[1], $b->[0], $b->[1] ] ,
805 0     0   0 [ map { @$_ } $a->[2], $b->[0], $b->[2] ] ] }
  0         0  
806 0 0       0 map { $_ ? [ ( splice @_, 0, 3 ) ] : [ [], [], [] ] }
  0         0  
807             0 .. @_ / 3 ;
808             };
809             }
810              
811 16         136 while (my($s, $o, $n) = splice @_, 0, 3) {
812 31         61 for (@$s) {
813 32 50       146 s/^(.)// or die;
814 32         77 print_column_23($1, $_, $1, $_);
815 32         64 $oline++;
816 32         54 $nline++;
817             }
818              
819 31         69 my $max = $app->limit->{line};
820 31   100     209 my $one_side = !@$o || !@$n;
821 31         63 my $count = 0;
822 31   100     133 while (@$o or @$n) {
823 95         126 my $old = shift @$o;
824 95         139 my $new = shift @$n;
825 95 100 33     337 my $omark = $old ? $old =~ s/^(.)// && $1 : ' ';
826 95 100 33     494 my $nmark = $new ? $new =~ s/^(.)// && $1 : ' ';
827              
828 95         190 print_column_23($omark, $old, $nmark, $new);
829              
830 95 100       159 $oline++ if defined $old;
831 95 100       146 $nline++ if defined $new;
832              
833             # truncate one-sided (add/delete) section exceeding max lines
834 95 100 100     446 if ($max and $one_side and ++$count >= $max and @$o + @$n > 0) {
      100        
      66        
835 2         5 my $rest = @$o + @$n;
836 2         9 my $msg = $painter->(
837             'NOTICE',
838             sprintf "... %d lines omitted ...\n", $rest,
839             );
840             # show message on the side that has content
841             # suppress line number by localizing $oline/$nline
842             {
843 2         4 local($oline, $nline) = (undef, undef);
  2         4  
844 2 50       5 if (@$n) {
845 2         4 print_column_23(' ', undef, ' ', $msg);
846             } else {
847 0         0 print_column_23(' ', $msg, ' ', undef);
848             }
849             }
850             # advance line counter past omitted lines
851 2 50       6 $oline += $rest if !@$n;
852 2 50       6 $nline += $rest if !@$o;
853 2         16 last;
854             }
855             }
856             }
857             }
858              
859             sub flush_buffer_3 {
860              
861 0     0   0 push @_, [] while @_ % 4;
862              
863 0 0       0 if ($app->view) {
864 0         0 @_ = do {
865 0         0 map { @$_ }
866             reduce {
867             [ [] ,
868 0         0 [ map { @$_ } $a->[1], $b->[0], $b->[1] ] ,
869 0         0 [ map { @$_ } $a->[2], $b->[0], $b->[2] ] ,
870 0     0   0 [ map { @$_ } $a->[3], $b->[0], $b->[3] ] ] }
  0         0  
871 0 0       0 map { $_ ? [ splice @_, 0, 4 ] : [ [], [], [], [] ] }
  0         0  
872             0 .. @_ / 4;
873             };
874             }
875              
876 0         0 while (@_) {
877 0         0 my @d = splice @_, 0, 4;
878              
879 0         0 for my $common (@{shift @d}) {
  0         0  
880 0         0 $common =~ s/^ //;
881 0         0 print_column_23(' ', $common, ' ', $common, ' ', $common);
882 0         0 $oline++;
883 0         0 $nline++;
884 0         0 $mline++;
885             }
886              
887 0     0   0 while (first { @$_ > 0 } @d) {
  0         0  
888 0         0 my $old = shift @{$d[0]};
  0         0  
889 0         0 my $new = shift @{$d[1]};
  0         0  
890 0         0 my $mrg = shift @{$d[2]};
  0         0  
891 0 0 0     0 my $om = $old ? $old =~ s/^(?|(\-).| (\+)|( ) )// && $1 : ' ';
892 0 0 0     0 my $nm = $new ? $new =~ s/^(?|.(\-)|(\+) |( ) )// && $1 : ' ';
893 0 0 0     0 my $mm = $mrg ? $mrg =~ s/^(?|(\+).|.(\+)|( ) )// && $1 : ' ';
894              
895 0         0 print_column_23($om, $old, $nm, $new, $mm, $mrg);
896              
897 0 0       0 $oline++ if defined $old;
898 0 0       0 $nline++ if defined $new;
899 0 0       0 $mline++ if defined $mrg;
900             }
901             }
902             }
903              
904             sub print_identical {
905 0     0   0 my $n = shift;
906 0         0 while ($n--) {
907 0         0 my $old = ;
908 0         0 my $new = ;
909 0 0 0     0 defined $old or defined $new or last;
910 0         0 print_column_23(' ', $old, ' ', $new);
911 0         0 $oline++;
912 0         0 $nline++;
913 0         0 $mline++;
914             }
915             }
916              
917             sub linenum {
918 0     0   0 my $n = shift;
919 0 0       0 defined $n ? (sprintf $num_format, $n) : (' ' x $app->digit);
920             }
921              
922             sub print_column_23 {
923 129     129   209 my $column = @_ / 2;
924 129         186 my $width = column_width $column;
925 129         307 my($omark, $old, $nmark, $new, $mmark, $mrg) = @_;
926 129         255 my $print_number = $app->number;
927              
928 129         536 my($onum, $nnum, $mnum) = ('', '', '');
929 129 50       188 my $nspace = $print_number ? ' ' : '';
930 129 100       190 if (defined $old) {
931 78         375 $old =~ s/\R\z//;
932 78 50       139 $onum = linenum($oline) if $print_number;
933             }
934 129 100       224 if (defined $new) {
935 117         435 $new =~ s/\R\z//;
936 117 50       209 $nnum = linenum($nline) if $print_number;
937             }
938 129 50       215 if (defined $mrg) {
939 0         0 $mrg =~ s/\R\z//;
940 0 0       0 $mnum = linenum($mline) if $print_number;
941             }
942              
943             # truncate long lines before processing
944 129 100       234 if (my $max = $app->limit->{length}) {
945 128         602 for ($old, $new, $mrg) {
946 384 100 100     913 defined and length > $max or next;
947 1         5 state $fold = Text::ANSI::Fold->new;
948 1         15 my $orig_len = length;
949 1         4 ($_, undef) = $fold->fold($_, width => $max);
950 1         7376 my $truncated = $orig_len - length;
951 1         5 $_ .= $painter->('NOTICE',
952             sprintf " ... %d characters omitted ...", $truncated);
953             }
954             }
955              
956 129 100       359 my($OTEXT, $OLINE, $OMARK) =
957             $omark =~ /\S/ ? qw(OTEXT OLINE OMARK) : qw(UTEXT OULINE OUMARK);
958 129 100       301 my($NTEXT, $NLINE, $NMARK) =
959             $nmark =~ /\S/ ? qw(NTEXT NLINE NMARK) : qw(UTEXT NULINE NUMARK);
960 129 0       217 my($MTEXT, $MLINE, $MMARK) =
    50          
961             $mmark =~ /\S/ ? qw(MTEXT MLINE MMARK) : qw(UTEXT NULINE NUMARK)
962             if $column >= 3;
963              
964 129         123 while (1) {
965 135         484 (my $o, $old) = ansi_fold($old,
966             max(1, $width - length($onum . $nspace)),
967             @boundary);
968 135         22199 (my $n, $new) = ansi_fold($new,
969             max(1, $width - length($nnum . $nspace)),
970             @boundary);
971 135 50       24212 (my $m, $mrg) = ansi_fold($mrg,
972             max(1, $width - length($mnum . $nspace)),
973             @boundary)
974             if $column >= 3;
975              
976 135         153 my @f;
977 135         209 $f[0]{MARK} = $painter->($OMARK, $omark);
978 135 50       6154 $f[0]{LINE} = $painter->($OLINE, $onum) . $nspace if $print_number;
979 135 50       288 $f[0]{TEXT} = $painter->($OTEXT, $o) if $o ne "";
980 135         3634 $f[1]{MARK} = $painter->($NMARK, $nmark);
981 135 50       4115 $f[1]{LINE} = $painter->($NLINE, $nnum) . $nspace if $print_number;
982 135 50       258 $f[1]{TEXT} = $painter->($NTEXT, $n) if $n ne "";
983 135 50       4208 if ($column >= 3) {
984 0         0 $f[2]{MARK} = $painter->($MMARK, $mmark);
985 0 0       0 $f[2]{LINE} = $painter->($MLINE, $mnum) . $nspace if $print_number;
986 0 0       0 $f[2]{TEXT} = $painter->($MTEXT, $m) if $m ne "";
987             }
988 135         268 print_field_n(@f);
989              
990 135 50       343 last if $app->truncate;
991 135 50 66     1515 last unless $old ne '' or $new ne '' or ($mrg and $mrg ne '');
      33        
      66        
992              
993 6 50       12 if ($print_number) {
994 0         0 $onum =~ s/./ /g;
995 0         0 $nnum =~ s/./ /g;
996 0 0       0 $mnum =~ s/./ /g if $column >= 3;
997             }
998 6 50       16 $omark = $old ne '' ? '.' : ' ';
999 6 50       14 $nmark = $new ne '' ? '.' : ' ';
1000 6 0       27 $mmark = $mrg ne '' ? '.' : ' ' if $column >= 3;
    50          
1001             }
1002             }
1003              
1004             sub print_command_n {
1005 27 100   27   83 my $opt = ref $_[0] ? shift : {};
1006 27         59 my $column = @_;
1007 27         311 my $width = column_width $column;
1008 27         38 my @f;
1009              
1010 27   100     100 $opt->{type} //= 'COMMAND';
1011              
1012 27 100 50     130 $app->command or return if $opt->{type} eq 'COMMAND';
1013 27 100 50     179 $app->filename or return if $opt->{type} eq 'FILE';
1014              
1015 27         101 my @color = map { $_ . $opt->{type} } "O", "N", "M";
  81         179  
1016              
1017 27         83 for my $i (keys @_) {
1018 54         105 local $_ = $_[$i];
1019 54 50       177 chomp if defined;
1020 54         167 ($_) = ansi_fold($_, $width);
1021 54         101293 my %f;
1022 54 50       149 my $color = $i < @color ? $color[$i] : $color[-1];
1023 54         129 $f{TEXT} = $painter->($color, $_);
1024 54         8184 $f{MARK} = ' ';
1025 54         131 push @f, \%f;
1026             }
1027              
1028 27         112 print_field_n(@f);
1029             }
1030              
1031             sub print_field_n {
1032 162 50   162   318 if (@column >= @_) {
1033 0         0 @_ = @_[ @column[ keys @_ ] ];
1034             }
1035 162         457 while (my($i, $f) = each @_) {
1036 324 50       622 my $markpos = $i < @markpos ? $markpos[$i] : $markpos[-1];
1037 324         344 local $_;
1038 324 100 33     668 $_ = $f->{"MARK"} and print if $markpos eq LEFT;
1039 324 50       536 $_ = $f->{"LINE"} and print;
1040 324 50       920 $_ = $f->{"TEXT"} and print;
1041 324 100 33     1067 $_ = $f->{"MARK"} and print if $markpos eq RIGHT;
1042             }
1043 162         430 print "\n";
1044             }
1045              
1046             __END__