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.4501
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   42690 use v5.14;
  10         29  
87 10     10   35 use warnings;
  10         14  
  10         436  
88 10     10   4105 use utf8;
  10         2452  
  10         51  
89 10     10   5260 use Encode;
  10         149116  
  10         1084  
90 10     10   4955 use open IO => ':utf8';
  10         11774  
  10         54  
91 10     10   1069 use Carp;
  10         17  
  10         646  
92 10     10   4994 use charnames ':full';
  10         82585  
  10         72  
93 10     10   204534 use List::Util qw(min max reduce sum pairmap first);
  10         24  
  10         1636  
94 10     10   5580 use Pod::Usage;
  10         453227  
  10         1397  
95 10     10   5072 use Text::ParseWords qw(shellwords);
  10         13499  
  10         612  
96 10     10   5967 use Data::Dumper; {
  10         63666  
  10         968  
97 10         1507084 $Data::Dumper::Terse = 1;
  10         31  
98             }
99              
100 10     10   3930 use App::sdif;
  10         25  
  10         623  
101 10         31 my $version = $App::sdif::VERSION;
102              
103 10     10   3654 use App::sdif::Util;
  10         22  
  10         1096  
104 10     10   4474 use IO::Divert;
  10         6034  
  10         1305  
105              
106 10         60 my $default_cdif = 'cdif';
107 10         30 my @default_cdifopts = qw(--sdif);
108 10         20 my $default_lenience = 1;
109 10         23 my $default_256 = 1;
110 10         18 my $default_prefix = 1;
111 10         20 my $default_prefix_pattern = q/(?:\\| )*(?: )?/;
112 10         25 my @cdifopts;
113             my $read_stdin;
114              
115 10         13 our $screen_width;
116              
117 10 50       56 if (my $env = $ENV{'SDIFOPTS'}) {
118 0         0 unshift @ARGV, shellwords($env);
119             }
120              
121 10     10   57 use open IO => ':utf8', ':std';
  10         14  
  10         66  
122 10 50       26 map { $_ = decode 'utf8', $_ unless utf8::is_utf8($_) } @ARGV;
  41         704  
123              
124 10         150 my $app;
125              
126 10     10   6302 use Getopt::EX::Hashed; {
  10         65777  
  10         54  
127              
128 10         18 Getopt::EX::Hashed->configure( DEFAULT => [ is => 'rw' ] );
  10         121  
129              
130 10         357 has help => ' h ' ;
131 10         553 has version => ' ' ;
132 10         431 has man => ' ' ;
133 10         389 has debug => 'd + ' ;
134 10         366 has number => 'n ! ' ;
135 10         402 has digit => ' =i ' , default => 4 ;
136 10         382 has column => ' =s ' ;
137 10         388 has truncate => 't ! ' ;
138 10         330 has boundary => ' =s ' , default => 'word' ;
139 10         440 has onword => ' ! ' ;
140 10         384 has mark => ' =s ' , default => 'center' ;
141 10         395 has prefix => ' ! ' , default => $default_prefix ;
142 10         392 has prefix_pattern => ' =s ' , default => $default_prefix_pattern ;
143 10         376 has width => 'W =i ' ;
144 10         393 has margin => ' =i ' , default => 0 ;
145 10         386 has runin => ' =i ' ;
146 10         427 has runout => ' =i ' ;
147 10         457 has view => 'v ! ' ;
148 10         478 has parallel => 'V :2 ' , default => 0 ;
149 10         542 has ambiguous => ' =s ' , default => 'narrow' ;
150 10         468 has filename => ' ! ' , default => 1 ;
151 10         482 has command => ' ! ' , default => 1 ;
152 10         467 has diff => ' =s ' , default => 'diff' ;
153 10         524 has diffopts => ' =s@' , default => [] ;
154 10         502 has color => ' =s ' , default => 'always' ;
155 10         454 has colormap => 'cm=s@' , default => [] ;
156 10         463 has colordump => ' ' ;
157 10         515 has 256 => ' ! ' , default => $default_256 ;
158 10         499 has commandcolor => 'cc! ' , default => 1 ;
159 10         535 has filecolor => 'fc! ' , default => 1 ;
160 10         545 has linecolor => 'lc! ' , default => 1 ;
161 10         563 has markcolor => 'mc! ' , default => 1 ;
162 10         535 has textcolor => 'tc! ' , default => 1 ;
163 10         580 has unknowncolor => 'uc! ' , default => 1 ;
164 10         564 has cdif => ' :s ' , default => '' ;
165 10         636 has cdifopts => ' =s ' ;
166 10         654 has colortable => ' :s ' , any => qr/^(|6|12|24)$/ ;
167 10         728 has lenience => ' ! ' , default => $default_lenience ;
168 10         603 has limit => ' =s%' , default => { length => 10000 } ;
169 10         580 has visible => ' =i%' , default => {} ;
170 10         564 has tabstop => ' =i ' , default => 8 ;
171 10         583 has tabhead => ' =s ' ;
172 10         573 has tabstyle => 'ts=s ' ;
173 10         592 has tabspace => ' =s ' ;
174 10         625 has unit => 'by:s ' ;
175              
176 10         646 has ignore_case => 'i ' ;
177 10         624 has ignore_space_change => 'b ' ;
178 10         674 has ignore_all_space => 'w ' ;
179 10         654 has ignore_blank_lines => 'B ' ;
180 10         726 has context => 'C =i' ;
181 10         656 has unified => 'U =i' ;
182 10         803 has c => ' ' ;
183 10         739 has u => ' ' ;
184              
185             has '+onword'
186 10 0   0   747 => sub { $_->boundary = $_[1] ? 'word' : '' } ;
  0         0  
187              
188             has '+cdifopts'
189 10     0   400 => sub { push @cdifopts, shellwords $_[1] } ;
  0         0  
190              
191             has '+ignore_case'
192 10     0   569 => sub { push @{$app->diffopts}, '-i'; push @cdifopts, '-i' } ;
  0         0  
  0         0  
  0         0  
193             has '+ignore_space_change'
194 10     0   667 => sub { push @{$app->diffopts}, '-b'; push @cdifopts, '-w' } ;
  0         0  
  0         0  
  0         0  
195             has '+ignore_all_space'
196 10     0   617 => sub { push @{$app->diffopts}, '-w'; push @cdifopts, '-w' } ;
  0         0  
  0         0  
  0         0  
197             has '+ignore_blank_lines'
198 10     0   863 => sub { push @{$app->diffopts}, '-B' } ;
  0         0  
  0         0  
199              
200 10     0   626 has '+c' => sub { push @{$app->diffopts}, '-c' } ;
  0         0  
  0         0  
201 10     0   620 has '+u' => sub { push @{$app->diffopts}, '-u' } ;
  0         0  
  0         0  
202 10     0   710 has '+context' => sub { push @{$app->diffopts}, '-C' . $_[1] } ;
  0         0  
  0         0  
203 10     0   669 has '+unified' => sub { push @{$app->diffopts}, '-U' . $_[1] } ;
  0         0  
  0         0  
204              
205 10     5   625 has nocolor => 'no-color' , action => sub { $app->color = 'never' } ;
  5         3361  
206 10     5   768 has nocdif => 'no-cdif' , action => sub { $app->cdif = undef } ;
  5         75474  
207              
208 10 0   0   936 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         829 } ;
216              
217 10     0   450 has '+help' => sub { usage() } ;
  0         0  
218 10     0   291 has '+version' => sub { print "$version\n"; exit 0 } ;
  0         0  
  0         0  
219 10     0   276 has '+man' => sub { pod2usage {-verbose => 2} } ;
  0         0  
220              
221 10     10   11707 } no Getopt::EX::Hashed;
  10         13  
  10         37  
222              
223 10 50       305 $app = Getopt::EX::Hashed->new() or die;
224              
225 10         15145 my @SAVEDARGV = @ARGV;
226 10     10   5251 use Getopt::EX::Long qw(:DEFAULT Configure ExConfigure);
  10         789670  
  10         2277  
227 10         72 ExConfigure BASECLASS => [ "App::sdif", "Getopt::EX" ];
228 10         357 Configure "bundling";
229 10 50       382 $app->getopt or usage({status => 1});
230              
231 10 50       81349 warn "\@ARGV = (@SAVEDARGV)\n" if $app->debug;
232              
233 10         84 $App::sdif::Util::NO_WARNINGS = $app->lenience;
234              
235 10     10   4964 use Text::VisualWidth::PP qw(vwidth);
  10         31348  
  10         750  
236 10     10   4649 use Text::ANSI::Fold qw(ansi_fold :constants); {
  10         155176  
  10         7906  
237 10         42 Text::ANSI::Fold->configure(padding => 1,
  10         34  
238             expand => 1,
239             tabstop => $app->tabstop);
240             }
241              
242 10 50 0     664 $app->visible->{ht} //= 1 if $app->tabstyle;
243 10 50       68 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       88 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         56 my %colormap = do {
275 10 50       43 my $col = $app->{256} ? 0 : 1;
276 200 100   200   480 pairmap { $a => (ref $b eq 'ARRAY') ? $b->[$col] : $b } (
277 10         204 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   96 use Getopt::EX::Colormap;
  10         16  
  10         686  
301 10         50 $Getopt::EX::Colormap::NO_RESET_EL = 1;
302 10     10   70 use constant SGR_RESET => "\e[m";
  10         19  
  10         9101  
303             my $color_handler = Getopt::EX::Colormap
304             ->new(HASH => \%colormap)
305 10         86 ->load_params(@{$app->colormap});
  10         1052  
306              
307 10   33     300 $colormap{OUMARK} ||= $colormap{UMARK} || $colormap{OMARK};
      33        
308 10   33     86 $colormap{NUMARK} ||= $colormap{UMARK} || $colormap{NMARK};
      33        
309 10   33     83 $colormap{OULINE} ||= $colormap{ULINE} || $colormap{OLINE};
      33        
310 10   33     70 $colormap{NULINE} ||= $colormap{ULINE} || $colormap{NLINE};
      33        
311              
312 10         33 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         274 my($color, $label) = @$_;
321 60 50       107 $color and next;
322 0         0 for (grep /$label/, keys %colormap) {
323 0         0 $colormap{$_} = '';
324             }
325             }
326              
327 10 50       41 if ($app->colordump) {
328 0         0 print $color_handler->colormap(
329             name => '--changeme', option => '--colormap');
330 0         0 exit;
331             }
332              
333 10         45 my $painter = do {
334 10 100 33     27 if (($app->color eq 'always')
      66        
335             or (($app->color eq 'auto') and (-t STDOUT))) {
336 5     445   65 sub { $color_handler->color(@_) };
  445         1411  
337             } else {
338 5     175   78 sub { $_[1] } ;
  175         276  
339             }
340             };
341              
342             ##
343             ## setup cdif command and option
344             ##
345 10 100 66     30 if (defined $app->cdif and $app->cdif eq '') {
346 5         57 $app->cdif = $default_cdif;
347             }
348              
349 10         73 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         181 my($name, $type, $var, $default) = @$_;
357 40 100       82 if ($type eq "!") {
    50          
358 30 50       73 next if not defined $var;
359 30 50       61 next if $var == $default;
360 0 0       0 unshift @cdifopts, sprintf("--%s%s", $var ? '' : 'no-', $name);
361             } elsif ($type eq "=") {
362 10 50       42 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         41 unshift @cdifopts, @default_cdifopts;
370              
371 10         17 my($OLD, $NEW, $DIFF);
372 10 50       53 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     30 $DIFF = shift || '-';
377 10         41 $read_stdin++;
378             } else {
379 0         0 usage({status => 1}, "Unexpected arguments.\n\n");
380             }
381             my $readfile =
382 10   0     50 ($OLD and $NEW) && !$read_stdin && !(grep { /^-[cuCU]/ } @{$app->diffopts});
383              
384             use constant {
385 10         3151 RIGHT => 'right',
386             LEFT => 'left',
387             NO => 'no',
388 10     10   71 };
  10         19  
389 10         117 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       37 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         59 my @markpos = @{$markpos{$app->mark}};
  10         28  
402 10         59 my($omarkpos, $nmarkpos, $mmarkpos) = @markpos;
403              
404 10         38 my $num_format = sprintf '%%%dd', $app->digit;
405              
406 10   66     75 $screen_width = $app->width || &terminal_width;
407              
408             sub column_width {
409 156     156   244 my $column = shift;
410 156         202 state %column_width;
411 156   66     964 $column_width{$screen_width * 1000 + $column} //= do {
412 10     10   64 use integer;
  10         43  
  10         53  
413 9         25 my $w = $screen_width;
414 9 50       180 $w -= $column if $app->mark;
415 9         146 max 1, $w / $column;
416             };
417             }
418              
419             ##
420             ## --colortable
421             ##
422 10 100       64 if (defined(my $n = $app->colortable)) {
423 10     10   1273 no strict 'refs';
  10         15  
  10         106406  
424 1         6 &{"Getopt::EX::Colormap::colortable$n"}($screen_width);
  1         12  
425 1         0 exit;
426             }
427              
428             ##
429             ## Column order
430             ##
431 9 50       498 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         54 my $prefix_re = do {
441 9 50       23 if ($app->prefix) {
442 9         301 qr/$app->{prefix_pattern}/;
443             } else {
444 0         0 "";
445             }
446             };
447              
448 9 50       32 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       53 if ($app->cdif) {
455 4         11404 my $pid = open DIFF, '-|';
456 4 50       584 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       230 open(DIFF, $DIFF) || die "cannot open diff: $!\n";
475             }
476              
477 9 50       193 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         448 my @boundary = (boundary => $app->boundary);
493 9         385 my $color_re = qr{ \e \[ [\d;]* [mK] }x;
494              
495 9         166 our $oline = 1;
496 9         51 our $nline = 1;
497 9         78 our $mline = 1;
498              
499 9         2458276 while () {
500             #
501             # normal diff
502             #
503 50 100       2038 if (/^([\d,]+)([adc])([\d,]+)$/) {
    100          
    100          
    100          
    100          
    50          
    50          
    50          
    50          
504 5         13 my(@old, @new);
505 5         60 my($left, $ctrl, $right) = ($1, $2, $3);
506 5         49 my($l1, $l2) = range($left);
507 5         17 my($r1, $r2) = range($right);
508 5 50       17 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     46 if ($app->debug || $read_stdin) {
513 5         188 print_command_n($_, $_);
514             }
515 5 100 100     39 if ($ctrl eq 'd' || $ctrl eq 'c') {
516 4         25 ($oline) = $left =~ /^(\d+)/;
517 4         12 my $n = $l2 - $l1 + 1;
518 4         24 @old = read_line(*DIFF, $n);
519 4 50       9 $readfile and read_line(*OLD, $n);
520             }
521 5 100       44 read_line(*DIFF, 1) if $ctrl eq 'c';
522 5 100 100     24 if ($ctrl eq 'a' || $ctrl eq 'c') {
523 4         17 ($nline) = $right =~ /^(\d+)/;
524 4         9 my $n = $r2 - $r1 + 1;
525 4         26 @new = read_line(*DIFF, $n);
526 4 50       8 $readfile and read_line(*NEW, $n);
527             }
528             map {
529 5         11 s/^([<>])\s?/{'<' => '-', '>' => '+'}->{$1}/e
  12         37  
  12         58  
530             } @old, @new;
531 5         18 flush_buffer([], \@old, \@new);
532             }
533             #
534             # context diff
535             #
536             elsif (/^\*\*\* /) {
537 1         18 my $next = ;
538 1         33 print_command_n({ type => 'FILE' }, $_, $next);
539             }
540             elsif ($_ eq "***************\n") {
541 1         3 my(@old, @new);
542 1         12448 my $ohead = $_ = ;
543 1         43 my($left, $right);
544 1 50       55 unless (($left) = /^\*\*\* ([\d,]+) \*\*\*\*$/) {
545 0         0 print;
546 0         0 next;
547             }
548 1         28 my $oline = range($left);
549 1         8 my $dline = 0;
550 1         3 my $cline = 0;
551 1         13 my $nhead = $_ = ;
552 1 50       8 unless (($right) = /^--- ([\d,]+) ----$/) {
553 1         21 @old = read_line(*DIFF, $oline - 1, $nhead);
554 1         4 $nhead = $_ = ;
555 1 50       25 unless (($right) = /^--- ([\d,]+) ----$/) {
556 0         0 print $ohead, @old, $_;
557 0         0 next;
558             }
559 1         6 for (@old) {
560 14 100       38 /^-/ and ++$dline;
561 14 100       39 /^!/ and ++$cline;
562             }
563             }
564 1         6 my $nline = range($right);
565 1 50 33     22 if (@old == 0 or $cline != 0 or ($oline - $dline != $nline)) {
      33        
566 1         5 @new = read_line(*DIFF, $nline);
567             }
568 1         7 print_command_n($ohead, $nhead);
569 1         7 ($oline) = $left =~ /^(\d+)/;
570 1         16 ($nline) = $right =~ /^(\d+)/;
571              
572 1         6 my @buf = merge_diffc(\@old, \@new);
573 1         7 flush_buffer(@buf);
574             }
575             #
576             # unified diff
577             #
578             elsif (/^($prefix_re)(--- (?s:.*))/) {
579 10         89 my($prefix, $left) = ($1, $2);
580 10         43 my $right = ;
581 10         186 local $screen_width = $screen_width;
582 10 100       36 if ($prefix) {
583 4         92 $right =~ s/^\Q$prefix//;
584 4         13 print $prefix;
585 4         13 $screen_width -= length $prefix;
586             }
587 10         95 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         168 ($oline, $nline) = @+{qw(oline nline)};
600 10   50     126 my($o, $n) = ($+{o}//1, $+{n}//1);
      100        
601 10         72 my($prefix, $command) = @+{qw(prefix command)};
602              
603 10         33 local $screen_width = $screen_width;
604 10         69 my($divert, %read_opt);
605 10 100       37 if ($prefix) {
606 4         21 $screen_width -= length $prefix;
607 4         15 $read_opt{prefix} = $prefix;
608 4     4   81 $divert = IO::Divert->new(FINAL => sub { s/^/$prefix/mg });
  4         383  
609             }
610              
611 10         3988 print_command_n({ type => 'COMMAND' }, $command, $command);
612 10         122 my @buf = read_unified_2 \%read_opt, *DIFF, $o, $n;
613              
614 10         177 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         57 flush_unknown($_);
726             }
727             }
728             continue {
729 50         3211090 STDOUT->flush;
730             }
731              
732 9         448 close DIFF;
733 9 50       116 my $exit = $DIFF =~ /\|$/ ? $? >> 8 : 0;
734              
735 9 50       34 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         138 exit($exit > 1);
744              
745             ######################################################################
746              
747             ##
748             ## Convert diff -c output to -u compatible format.
749             ##
750             sub merge_diffc {
751 1     1   4 my @o = @{+shift};
  1         9  
752 1         3 my @n = @{+shift};
  1         7  
753 1         4 for (@o, @n) {
754 28 50       146 s/(?<= ^[ \-\+\!] ) [\t ]//x or die "Format error (-c).\n";
755             }
756              
757 1         3 my @buf;
758 1   66     35 while (@o or @n) {
759              
760 6         17 push @buf, \( my( @common, @old, @new ) );
761              
762 6   100     45 while (@o and $o[0] =~ /^ /) {
763 8         18 push @common, shift @o;
764 8 100       38 shift @n if @n;
765             }
766 6   100     34 while (@n and $n[0] =~ /^ /) {
767 3         13 push @common, shift @n;
768             }
769              
770 6   100     39 push @old, shift @o while @o and $o[0] =~ /^\-/;
771 6 100       16 next if @old;
772              
773 5   100     31 push @new, shift @n while @n and $n[0] =~ /^\+/;
774 5 100       13 next if @new;
775              
776 4   100     44 push @old, shift @o while @o and $o[0] =~ s/^!/-/;
777 4   100     39 push @new, shift @n while @n and $n[0] =~ s/^!/+/;
778             }
779              
780 1         8 @buf;
781             }
782              
783             sub flush_unknown {
784 23 50   23   79 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         229 print $painter->('UNKNOWN', $_) for @_;
792             }
793             }
794              
795             sub flush_buffer {
796              
797 16     16   71 push @_, [] while @_ % 3;
798              
799 16 50       108 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         195 while (my($s, $o, $n) = splice @_, 0, 3) {
812 31         82 for (@$s) {
813 32 50       233 s/^(.)// or die;
814 32         112 print_column_23($1, $_, $1, $_);
815 32         72 $oline++;
816 32         94 $nline++;
817             }
818              
819 31         103 my $max = $app->limit->{line};
820 31   100     271 my $one_side = !@$o || !@$n;
821 31         49 my $count = 0;
822 31   100     194 while (@$o or @$n) {
823 95         145 my $old = shift @$o;
824 95         150 my $new = shift @$n;
825 95 100 33     485 my $omark = $old ? $old =~ s/^(.)// && $1 : ' ';
826 95 100 33     571 my $nmark = $new ? $new =~ s/^(.)// && $1 : ' ';
827              
828 95         221 print_column_23($omark, $old, $nmark, $new);
829              
830 95 100       224 $oline++ if defined $old;
831 95 100       194 $nline++ if defined $new;
832              
833             # truncate one-sided (add/delete) section exceeding max lines
834 95 100 100     557 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         3 local($oline, $nline) = (undef, undef);
  2         5  
844 2 50       4 if (@$n) {
845 2         5 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       4 $oline += $rest if !@$n;
852 2 50       8 $nline += $rest if !@$o;
853 2         14 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   291 my $column = @_ / 2;
924 129         301 my $width = column_width $column;
925 129         397 my($omark, $old, $nmark, $new, $mmark, $mrg) = @_;
926 129         323 my $print_number = $app->number;
927              
928 129         905 my($onum, $nnum, $mnum) = ('', '', '');
929 129 50       238 my $nspace = $print_number ? ' ' : '';
930 129 100       237 if (defined $old) {
931 78         520 $old =~ s/\R\z//;
932 78 50       289 $onum = linenum($oline) if $print_number;
933             }
934 129 100       242 if (defined $new) {
935 117         566 $new =~ s/\R\z//;
936 117 50       258 $nnum = linenum($nline) if $print_number;
937             }
938 129 50       236 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       351 if (my $max = $app->limit->{length}) {
945 128         791 for ($old, $new, $mrg) {
946 384 100 100     1160 defined and length > $max or next;
947 1         5 state $fold = Text::ANSI::Fold->new;
948 1         16 my $orig_len = length;
949 1         3 ($_, undef) = $fold->fold($_, width => $max);
950 1         7403 my $truncated = $orig_len - length;
951 1         7 $_ .= $painter->('NOTICE',
952             sprintf " ... %d characters omitted ...", $truncated);
953             }
954             }
955              
956 129 100       502 my($OTEXT, $OLINE, $OMARK) =
957             $omark =~ /\S/ ? qw(OTEXT OLINE OMARK) : qw(UTEXT OULINE OUMARK);
958 129 100       505 my($NTEXT, $NLINE, $NMARK) =
959             $nmark =~ /\S/ ? qw(NTEXT NLINE NMARK) : qw(UTEXT NULINE NUMARK);
960 129 0       301 my($MTEXT, $MLINE, $MMARK) =
    50          
961             $mmark =~ /\S/ ? qw(MTEXT MLINE MMARK) : qw(UTEXT NULINE NUMARK)
962             if $column >= 3;
963              
964 129         149 while (1) {
965 135         666 (my $o, $old) = ansi_fold($old,
966             max(1, $width - length($onum . $nspace)),
967             @boundary);
968 135         30690 (my $n, $new) = ansi_fold($new,
969             max(1, $width - length($nnum . $nspace)),
970             @boundary);
971 135 50       32322 (my $m, $mrg) = ansi_fold($mrg,
972             max(1, $width - length($mnum . $nspace)),
973             @boundary)
974             if $column >= 3;
975              
976 135         202 my @f;
977 135         341 $f[0]{MARK} = $painter->($OMARK, $omark);
978 135 50       8338 $f[0]{LINE} = $painter->($OLINE, $onum) . $nspace if $print_number;
979 135 50       349 $f[0]{TEXT} = $painter->($OTEXT, $o) if $o ne "";
980 135         5498 $f[1]{MARK} = $painter->($NMARK, $nmark);
981 135 50       6425 $f[1]{LINE} = $painter->($NLINE, $nnum) . $nspace if $print_number;
982 135 50       351 $f[1]{TEXT} = $painter->($NTEXT, $n) if $n ne "";
983 135 50       5396 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         347 print_field_n(@f);
989              
990 135 50       468 last if $app->truncate;
991 135 50 66     1911 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       13 $omark = $old ne '' ? '.' : ' ';
999 6 50       11 $nmark = $new ne '' ? '.' : ' ';
1000 6 0       22 $mmark = $mrg ne '' ? '.' : ' ' if $column >= 3;
    50          
1001             }
1002             }
1003              
1004             sub print_command_n {
1005 27 100   27   107 my $opt = ref $_[0] ? shift : {};
1006 27         54 my $column = @_;
1007 27         306 my $width = column_width $column;
1008 27         51 my @f;
1009              
1010 27   100     125 $opt->{type} //= 'COMMAND';
1011              
1012 27 100 50     161 $app->command or return if $opt->{type} eq 'COMMAND';
1013 27 100 50     267 $app->filename or return if $opt->{type} eq 'FILE';
1014              
1015 27         122 my @color = map { $_ . $opt->{type} } "O", "N", "M";
  81         290  
1016              
1017 27         99 for my $i (keys @_) {
1018 54         133 local $_ = $_[$i];
1019 54 50       212 chomp if defined;
1020 54         379 ($_) = ansi_fold($_, $width);
1021 54         113832 my %f;
1022 54 50       186 my $color = $i < @color ? $color[$i] : $color[-1];
1023 54         167 $f{TEXT} = $painter->($color, $_);
1024 54         11621 $f{MARK} = ' ';
1025 54         167 push @f, \%f;
1026             }
1027              
1028 27         123 print_field_n(@f);
1029             }
1030              
1031             sub print_field_n {
1032 162 50   162   414 if (@column >= @_) {
1033 0         0 @_ = @_[ @column[ keys @_ ] ];
1034             }
1035 162         618 while (my($i, $f) = each @_) {
1036 324 50       755 my $markpos = $i < @markpos ? $markpos[$i] : $markpos[-1];
1037 324         393 local $_;
1038 324 100 33     833 $_ = $f->{"MARK"} and print if $markpos eq LEFT;
1039 324 50       649 $_ = $f->{"LINE"} and print;
1040 324 50       1290 $_ = $f->{"TEXT"} and print;
1041 324 100 33     1395 $_ = $f->{"MARK"} and print if $markpos eq RIGHT;
1042             }
1043 162         547 print "\n";
1044             }
1045              
1046             __END__