From 61bf6f3286d64bc4f71cea375b12cd50dc7d35d2 Mon Sep 17 00:00:00 2001 From: ryoskzypu Date: Sun, 30 Nov 2025 18:17:19 -0300 Subject: [PATCH 1/4] Add ANSI color support and customization Color support improves diff readability, but Text::Diff currently lacks it. Built-in ANSI color support would avoid fragile external wrappers (e.g. colordiff) or duplicated subclass code. Provide a configurable API for enabling colors and customizing palettes. Changes (Diff.pm) - Use three-arg open(). - Add ANSI color support and palette customization; document COLOR and PALETTE options in POD. - Fix minor style and whitespace issues. - Fix POD typo. Changes (Table.pm) - Remove unused Carp. - Split file_footer() into private functions for testing. - Add ANSI color support and palette customization. - Fix minor style and whitespace issues. - Fix POD formatting and typos. --- lib/Text/Diff.pm | 217 ++++++++++++++++++++++++++------ lib/Text/Diff/Table.pm | 275 +++++++++++++++++++++++++++++++++++------ 2 files changed, 417 insertions(+), 75 deletions(-) mode change 100644 => 100755 lib/Text/Diff.pm mode change 100644 => 100755 lib/Text/Diff/Table.pm diff --git a/lib/Text/Diff.pm b/lib/Text/Diff.pm old mode 100644 new mode 100755 index 7f3a613..20851a8 --- a/lib/Text/Diff.pm +++ b/lib/Text/Diff.pm @@ -6,6 +6,7 @@ use warnings; use Carp qw/ croak confess /; use Exporter (); use Algorithm::Diff (); +use Term::ANSIColor 2.02 qw/ :constants color colorvalid /; our $VERSION = '1.45'; our @ISA = qw/ Exporter /; @@ -25,6 +26,25 @@ my %internal_styles = ( Table => undef, ## "internal", but in another module ); +my %hunks = ( + header => undef, + line_number => undef, + delete_line => undef, + add_line => undef, + same_line => undef, + context_sep => undef, + oldstyle_sep => undef, + table_frame => undef, +); + +my %default_colors = ( + header => BOLD, + line_number => CYAN, + delete_line => RED, + add_line => GREEN, + reset => RESET, +); + sub diff { my @seqs = ( shift, shift ); my $options = shift || {}; @@ -59,10 +79,9 @@ sub diff { unless defined $options->{"MTIME_$AorB"}; local $/ = "\n"; - open F, "<$seq" or croak "$!: $seq"; - $seqs[$i] = []; - close F; - + open my $fh, "<", $seq or croak "Failed to open $seq: $!"; + $seqs[$i] = [<$fh>]; + close $fh; } elsif ( $type eq "GLOB" || UNIVERSAL::isa( $seq, "IO::Handle" ) ) { $options->{"OFFSET_$AorB"} = 1 @@ -78,7 +97,8 @@ sub diff { ## Config vars my $output; my $output_handler = $options->{OUTPUT}; - my $type = ref $output_handler ; + my $type = ref $output_handler; + my $is_tty; if ( ! defined $output_handler ) { $output = ""; $output_handler = sub { $output .= shift }; @@ -95,6 +115,8 @@ sub diff { $output_handler = sub { push @$out_ref, shift }; } elsif ( $type eq "GLOB" || UNIVERSAL::isa $output_handler, "IO::Handle" ) { + $is_tty = -t $output_handler ? 1 : 0; + my $output_handle = $output_handler; $output_handler = sub { print $output_handle shift }; } @@ -120,6 +142,15 @@ sub diff { ? @{$options->{KEYGEN_ARGS}} : (); + $options->{COLOR} = 0 unless defined $options->{COLOR}; + + if ( $options->{COLOR} ne "always" ) { + $options->{COLOR} = 0 if defined $is_tty && ! $is_tty || ! -t STDOUT; + } + + $options->{PALETTE} = $options->{COLOR} ? _get_colors($options->{PALETTE}) + : undef; + ## State vars my $diffs = 0; ## Number of discards this hunk my $ctx = 0; ## Number of " " (ctx_lines) ops pushed after last diff. @@ -140,8 +171,8 @@ sub diff { ## need to know the total length of both of the two ## subsequences so the line count can be printed in the ## header. - my $dis_a = sub {push @ops, [@_[0,1],"-"]; ++$diffs ; $ctx = 0 }; - my $dis_b = sub {push @ops, [@_[0,1],"+"]; ++$diffs ; $ctx = 0 }; + my $dis_a = sub { push @ops, [@_[0,1],"-"]; ++$diffs; $ctx = 0 }; + my $dis_b = sub { push @ops, [@_[0,1],"+"]; ++$diffs; $ctx = 0 }; Algorithm::Diff::traverse_sequences( @seqs, @@ -188,9 +219,15 @@ sub _header { ## remember to change Text::Diff::Table if this logic is tweaked. return "" unless defined $fn1 && defined $fn2; + $t1 = defined $t1 ? "\t" . localtime $t1 : (); + $t2 = defined $t2 ? "\t" . localtime $t2 : (); + + my $header = _is_color( $h->{PALETTE}{header} ); + my $reset = _is_color( $h->{PALETTE}{reset} ); + return join( "", - $p1, " ", $fn1, defined $t1 ? "\t" . localtime $t1 : (), "\n", - $p2, " ", $fn2, defined $t2 ? "\t" . localtime $t2 : (), "\n", + $header, $p1, " ", $fn1, $t1, $reset, "\n", + $header, $p2, " ", $fn2, $t2, $reset, "\n", ); } @@ -226,7 +263,7 @@ sub _range { } sub _op_to_line { - my ( $seqs, $op, $a_or_b, $op_prefixes ) = @_; + my ( $seqs, $op, $a_or_b, $op_prefixes, $options ) = @_; my $opcode = $op->[OPCODE]; return () unless defined $op_prefixes->{$opcode}; @@ -236,13 +273,63 @@ sub _op_to_line { return () unless defined $op_sym; $a_or_b = $op->[OPCODE] ne "+" ? 0 : 1 unless defined $a_or_b; - my @line = ( $op_sym, $seqs->[$a_or_b][$op->[$a_or_b]] ); - unless ( $line[1] =~ /(?:\n|\r\n)$/ ) { + + my $seq_line = $seqs->[$a_or_b][$op->[$a_or_b]]; + + my $colors = $options->{PALETTE}; + my $color = ""; + + if ( defined $colors && keys %{$colors} ) { + ## Do not colorize Unified " " OPCODE lines, unless its color option is + ## defined. + if ( $op_sym ne " " ) { + $color = $a_or_b eq A ? $colors->{delete_line} + : $colors->{add_line}; + } + elsif ( $op_sym eq " " && defined $colors->{same_line} ) { + $color = $colors->{same_line}; + } + } + + # Append a reset color before a line break or end of string. + $seq_line =~ s/(\r?\n$|\z)/$colors->{reset}$1/ if $color ne ""; + + my @line = ( $color . $op_sym, $seq_line ); + + unless ( $line[1] =~ /\r?\n$/ ) { $line[1] .= "\n\\ No newline at end of file\n"; } + return @line; } +sub _get_colors +{ + my ( $palette ) = @_; + + my %colors = %default_colors; + + if ( defined $palette && ref $palette eq "HASH" && keys %{$palette} ) { + for my $section ( keys %{$palette} ) { + next unless exists $hunks{$section}; + + my $ansi = $palette->{$section}; + + # Silently ignore invalid Term::ANSIColor colors. + $colors{$section} = color( $ansi ) if colorvalid( $ansi ); + } + } + + return \%colors; +} + +sub _is_color { + my ( $ansi, $reset ) = @_; + + return $reset if defined $ansi && defined $reset; + return defined $ansi ? $ansi : ""; +} + SCOPE: { package Text::Diff::Base; @@ -266,7 +353,7 @@ SCOPE: { sub Text::Diff::Unified::file_header { shift; ## No instance data - my $options = pop ; + my $options = pop; _header( { FILENAME_PREFIX_A => "---", FILENAME_PREFIX_B => "+++", %$options } @@ -275,42 +362,60 @@ sub Text::Diff::Unified::file_header { sub Text::Diff::Unified::hunk_header { shift; ## No instance data - pop; ## Ignore options - my $ops = pop; + my $options = pop; + my $ops = pop; return join( "", + _is_color( $options->{PALETTE}{line_number} ), "@@ -", _range( $ops, A, "unified" ), " +", _range( $ops, B, "unified" ), - " @@\n", + " @@", + _is_color( $options->{PALETTE}{reset} ), + "\n", ); } sub Text::Diff::Unified::hunk { shift; ## No instance data - pop; ## Ignore options - my $ops = pop; + my $options = pop; + my $ops = pop; my $prefixes = { "+" => "+", " " => " ", "-" => "-" }; - return join "", map _op_to_line( \@_, $_, undef, $prefixes ), @$ops + return join( "", + map _op_to_line( \@_, $_, undef, $prefixes, $options ), + @$ops, + ); } @Text::Diff::Context::ISA = qw( Text::Diff::Base ); sub Text::Diff::Context::file_header { - _header { FILENAME_PREFIX_A=>"***", FILENAME_PREFIX_B=>"---", %{$_[-1]} }; + _header( + { FILENAME_PREFIX_A => "***", FILENAME_PREFIX_B => "---", %{$_[-1]} } + ); } sub Text::Diff::Context::hunk_header { - return "***************\n"; + shift; ## No instance data + my $options = pop; + + my $colors = $options->{PALETTE}; + + return join( "", + _is_color( $colors->{context_sep} ), + "***************", + _is_color( $colors->{context_sep}, $colors->{reset} ), + "\n", + ); } sub Text::Diff::Context::hunk { shift; ## No instance data - pop; ## Ignore options - my $ops = pop; + my $options = pop; + my $ops = pop; ## Leave the sequences in @_[0,1] my $a_range = _range( $ops, A, "" ); @@ -319,7 +424,7 @@ sub Text::Diff::Context::hunk { ## Sigh. Gotta make sure that differences that aren't adds/deletions ## get prefixed with "!", and that the old opcodes are removed. my $after; - for ( my $start = 0; $start <= $#$ops ; $start = $after ) { + for ( my $start = 0; $start <= $#$ops; $start = $after ) { ## Scan until next difference $after = $start + 1; my $opcode = $ops->[$start]->[OPCODE]; @@ -338,14 +443,17 @@ sub Text::Diff::Context::hunk { } } + my $line_num = _is_color( $options->{PALETTE}{line_number} ); + my $reset = _is_color( $options->{PALETTE}{reset} ); + my $b_prefixes = { "+" => "+ ", " " => " ", "-" => undef, "!" => "! " }; my $a_prefixes = { "+" => undef, " " => " ", "-" => "- ", "!" => "! " }; return join( "", - "*** ", $a_range, " ****\n", - map( _op_to_line( \@_, $_, A, $a_prefixes ), @$ops ), - "--- ", $b_range, " ----\n", - map( _op_to_line( \@_, $_, B, $b_prefixes ), @$ops ), + $line_num . "*** ", $a_range, " ****" . $reset . "\n", + map( _op_to_line( \@_, $_, A, $a_prefixes, $options ), @$ops ), + $line_num . "--- ", $b_range, " ----" . $reset . "\n", + map( _op_to_line( \@_, $_, B, $b_prefixes, $options ), @$ops ), ); } @@ -362,18 +470,25 @@ sub _op { sub Text::Diff::OldStyle::hunk_header { shift; ## No instance data - pop; ## ignore options - my $ops = pop; + my $options = pop; + my $ops = pop; my $op = _op $ops; - return join "", _range( $ops, A, "" ), $op, _range( $ops, B, "" ), "\n"; + return join( "", + _is_color( $options->{PALETTE}{line_number} ), + _range( $ops, A, "" ), + $op, + _range( $ops, B, "" ), + _is_color( $options->{PALETTE}{reset} ), + "\n", + ); } sub Text::Diff::OldStyle::hunk { shift; ## No instance data - pop; ## ignore options - my $ops = pop; + my $options = pop; + my $ops = pop; ## Leave the sequences in @_[0,1] my $a_prefixes = { "+" => undef, " " => undef, "-" => "< " }; @@ -381,10 +496,14 @@ sub Text::Diff::OldStyle::hunk { my $op = _op $ops; + my $colors = $options->{PALETTE}; + my $sep = _is_color( $colors->{oldstyle_sep} ); + my $reset = _is_color( $colors->{oldstyle_sep}, $colors->{reset} ); + return join( "", - map( _op_to_line( \@_, $_, A, $a_prefixes ), @$ops ), - $op eq "c" ? "---\n" : (), - map( _op_to_line( \@_, $_, B, $b_prefixes ), @$ops ), + map( _op_to_line( \@_, $_, A, $a_prefixes, $options ), @$ops ), + $op eq "c" ? $sep . "---" . $reset . "\n" : (), + map( _op_to_line( \@_, $_, B, $b_prefixes, $options ), @$ops ), ); } @@ -512,6 +631,30 @@ Context. These are passed to L. +=item COLOR, PALETTE + +C output will be colorized based on GNU C colors depending on +the values passed. A true value colorizes only if C or C +handle is an interactive TTY, unless "always" is passed; if false is given, +never colorizes. Defaults to 0. + + COLOR => 1, # like: GNU diff "auto" + COLOR => "always", + +With PALETTE, C colors can be customized according to the +L spec by passing a hash with the following: + + ## Hunk sections and its default colors. + ## NOTE: invalid colors are ignored. + header => BOLD, # like: --- A Mon Nov 12 23:49:30 2001 + line_number => CYAN, # like: @@ -2,13 +2,13 @@ + delete_line => RED, # like: -5d + add_line => GREEN, # like: +5a + same_line => undef, # "Unified" unchanged lines + context_sep => undef, # "Context" separator: "***************" + oldstyle_sep => undef, # "OldStyle" separator: "---" + table_frame => undef, # "Table" frames: "+--+----+--+----+", "|", "*" + =back B: if neither C option is defined, the header will not be @@ -537,7 +680,7 @@ overloading: Some output formats are provided by external modules (which are loaded automatically), such as L. These are -are documented here to keep the documentation simple. +documented here to keep the documentation simple. =head2 Text::Diff::Base diff --git a/lib/Text/Diff/Table.pm b/lib/Text/Diff/Table.pm old mode 100644 new mode 100755 index 42710bf..28fca18 --- a/lib/Text/Diff/Table.pm +++ b/lib/Text/Diff/Table.pm @@ -3,8 +3,9 @@ package Text::Diff::Table; use 5.006; use strict; use warnings; -use Carp; use Text::Diff::Config; +use Text::Diff (); +use Term::ANSIColor 2.02 qw( colorstrip ); our $VERSION = '1.44'; our @ISA = qw( Text::Diff::Base Exporter ); @@ -63,7 +64,7 @@ SCOPE: { $_ = ord; exists $escapes{$_} ? $escapes{$_} - : $Text::Diff::Config::Output_Unicode + : $Text::Diff::Config::Output_Unicode ? $c : sprintf( "\\x{%04x}", $_ ); } split //, shift; @@ -97,9 +98,9 @@ sub hunk { push @A, $missing_elt while @A < @B; push @B, $missing_elt while @B < @A; } - push @A, [ $_->[0] + ( $options->{OFFSET_A} || 0), $seqs[0][$_->[0]] ] + push @A, [ $_->[0] + ( $options->{OFFSET_A} || 0 ), $seqs[0][$_->[0]] ] if $opcode eq " " || $opcode eq "-"; - push @B, [ $_->[1] + ( $options->{OFFSET_B} || 0), $seqs[1][$_->[1]] ] + push @B, [ $_->[1] + ( $options->{OFFSET_B} || 0 ), $seqs[1][$_->[1]] ] if $opcode eq " " || $opcode eq "+"; } @@ -107,8 +108,8 @@ sub hunk { push @B, $missing_elt while @B < @A; my @elts; for ( 0..$#A ) { - my ( $A, $B ) = (shift @A, shift @B ); - + my ( $A, $B ) = ( shift @A, shift @B ); + ## Do minimal cleaning on identical elts so these look "normal": ## tabs are expanded, trailing newelts removed, etc. For differing ## elts, make invisible characters visible if the invisible characters @@ -207,15 +208,13 @@ sub _glean_formats { my $self = shift; } -sub file_footer { - my $self = shift; - my @seqs = (shift,shift); - my $options = pop; +sub _header { + my ( $options ) = @_; my @heading_lines; - + if ( defined $options->{FILENAME_A} || defined $options->{FILENAME_B} ) { - push @heading_lines, [ + push @heading_lines, [ map( { ( "", escape( defined $_ ? $_ : "" ) ); @@ -249,6 +248,200 @@ sub file_footer { $options->{INDEX_LABEL}; } + return @heading_lines; +} + +sub _header_fmt { + my ( $options ) = @_; + + my ( $width, $four_column_mode, $palette ) = @{$options}{ + "width", + "column_mode", + "palette", + }; + + my @w = @{$width}; + + my $frame = Text::Diff::_is_color( $palette->{table_frame} ); + my $header = Text::Diff::_is_color( $palette->{header} ); + my $res = Text::Diff::_is_color( $palette->{reset} ); + + return $four_column_mode + ? ( + "=" => $frame . "| %$w[0]s|" . $res . + $header . "%-$w[1]s" . $res . + $frame . " | %$w[2]s|" . $res . + $header . "%-$w[3]s" . $res . + $frame . " |" . $res . + "\n", + ) + : ( + "=" => $frame . "| %$w[0]s|" . $res . + $header . "%-$w[1]s" . $res . + " " . $frame . "|" . $res . + $header . "%-$w[2]s" . $res . + " " . $frame . "|" . $res . + "\n", + ); +} + +sub _table_fmt { + my ( $options ) = @_; + + my ( $width, $four_column_mode, $palette ) = @{$options}{ + "width", + "column_mode", + "palette", + }; + + my @w = @{$width}; + + my $frame = Text::Diff::_is_color( $palette->{table_frame} ); + my $line_num = Text::Diff::_is_color( $palette->{line_number} ); + my $del_line = Text::Diff::_is_color( $palette->{delete_line} ); + my $add_line = Text::Diff::_is_color( $palette->{add_line} ); + my $same_line = Text::Diff::_is_color( $palette->{same_line} ); + my $res = Text::Diff::_is_color( $palette->{reset} ); + + return $four_column_mode + ? ( + "=" => $frame . "|" . $res . + " " . $line_num . "%$w[0]s" . $res . + $frame . "|" . $res . + $same_line . "%-$w[1]s" . $res . + " " . $frame . "|" . $res . + " " . $line_num . "%$w[2]s" . $res . + $frame . "|" . $res . + $same_line . "%-$w[3]s" . $res . + " " . $frame . "|" . $res . + "\n", + + "A" => $frame . "*" . $res . + " " . $line_num . "%$w[0]s" . $res . + $frame . "|" . $res . + $del_line . "%-$w[1]s" . $res . + " " . $frame . "* %$w[2]s|%-$w[3]s |" . $res . + "\n", + + "B" => $frame . "| %$w[0]s|%-$w[1]s *" . $res . + " " . $line_num . "%$w[2]s" . $res . + $frame . "|" . $res . + $add_line . "%-$w[3]s" . $res . + " " . $frame . "*" . $res . + "\n", + + "*" => $frame . "*" . $res . + " " . $line_num . "%$w[0]s" . $res . + $frame . "|" . $res . + $del_line . "%-$w[1]s" . $res . + " " . $frame . "*" . $res . + " " . $line_num . "%$w[2]s" . $res . + $frame . "|" . $res . + $add_line . "%-$w[3]s" . $res . + " " . $frame . "*" . $res . + "\n", + ) + : ( + "=" => $frame . "|" . $res . + " " . $line_num . "%$w[0]s" . $res . + $frame . "|" . $res . + $same_line . "%-$w[1]s" . $res . + " " . $frame . "|" . $res . + $same_line . "%-$w[2]s" . $res . + " " . $frame . "|" . $res . + "\n", + + "A" => $frame . "*" . $res . + " " . $line_num . "%$w[0]s" . $res . + $frame . "|" . $res . + $del_line . "%-$w[1]s" . $res . + " " . $frame . "|" . $res . + $add_line . "%-$w[2]s" . $res . + " " . $frame . "|" . $res . + "\n", + + "B" => $frame . "|" . $res . + " " . $line_num . "%$w[0]s" . $res . + $frame . "|" . $res . + $add_line . "%-$w[1]s" . $res . + " " . $frame . "|" . $res . + $del_line . "%-$w[2]s" . $res . + " " . $frame . "*" . $res . + "\n", + + "*" => $frame . "*" . $res . + " " . $line_num . "%$w[0]s" . $res . + $frame . "|" . $res . + $del_line . "%-$w[1]s" . $res . + " " . $frame . "|" . $res . + $add_line . "%-$w[2]s" . $res . + " " . $frame . "*" . $res . + "\n", + ); +} + +sub _bar_fmt { + my ( $options ) = @_; + + my ( $bar, $four_column_mode, $palette ) = @{$options}{ + "bar", + "column_mode", + "palette", + }; + + my $frame = Text::Diff::_is_color( $palette->{table_frame} ); + my $res = Text::Diff::_is_color( $palette->{reset} ); + + my @args = ('', '', ''); + push(@args, '') if $four_column_mode; + $bar = sprintf $bar, @args; + + ## Strip ANSI colors for correct symbol ("+", "-") replacements. + $bar = colorstrip( $bar ) if defined $palette && keys %{$palette}; + + $bar =~ s/\S/+/g; + $bar =~ s/ /-/g; + + ## Colorize + if ( defined $palette && keys %{$palette} ) { + chomp $bar; + $bar = $frame . $bar . $res . "\n"; + } + + return $bar; +} + +sub _heading { + my ( $options ) = @_; + + my ( $bar, $fmts, $lines ) = @{$options}{ + "bar", + "fmts", + "lines", + }; + + my %heading_fmts = %{$fmts}; + my @heading_lines = @${lines}; + + no warnings; + + return join( "", + $bar, + map { + sprintf( $heading_fmts{$_->[-1]}, @$_ ); + } ( + @heading_lines, + ), + ); +} + +sub file_footer { + my $self = shift; + my @seqs = ( shift, shift ); + my $options = pop; + + my @heading_lines = _header( $options ); + ## Not ushifting on to @{$self->{ELTS}} in case it's really big. Want ## to avoid the overhead. @@ -277,25 +470,32 @@ sub file_footer { } } - my %fmts = $four_column_mode - ? ( - "=" => "| %$w[0]s|%-$w[1]s | %$w[2]s|%-$w[3]s |\n", - "A" => "* %$w[0]s|%-$w[1]s * %$w[2]s|%-$w[3]s |\n", - "B" => "| %$w[0]s|%-$w[1]s * %$w[2]s|%-$w[3]s *\n", - "*" => "* %$w[0]s|%-$w[1]s * %$w[2]s|%-$w[3]s *\n", - ) - : ( - "=" => "| %$w[0]s|%-$w[1]s |%-$w[2]s |\n", - "A" => "* %$w[0]s|%-$w[1]s |%-$w[2]s |\n", - "B" => "| %$w[0]s|%-$w[1]s |%-$w[2]s *\n", - "*" => "* %$w[0]s|%-$w[1]s |%-$w[2]s *\n", - ); + my $palette = $options->{PALETTE}; - my @args = ('', '', ''); - push(@args, '') if $four_column_mode; - $fmts{bar} = sprintf $fmts{"="}, @args; - $fmts{bar} =~ s/\S/+/g; - $fmts{bar} =~ s/ /-/g; + my $fmt_opts = { + width => \@w, + column_mode => $four_column_mode, + palette => $palette, + }; + + my %heading_fmts = _header_fmt( $fmt_opts ); + my %fmts = _table_fmt( $fmt_opts ); + + $fmts{bar} = _bar_fmt( + { + bar => $fmts{"="}, + column_mode => $four_column_mode, + palette => $palette, + } + ); + + my $heading = _heading( + { + bar => $fmts{bar}, + fmts => \%heading_fmts, + lines => \@heading_lines, + } + ); # Sometimes the sprintf has too many arguments, # which results in a warning on Perl 5.021+ @@ -306,11 +506,10 @@ sub file_footer { no warnings; return join( "", + $heading, map { sprintf( $fmts{$_->[-1]}, @$_ ); } ( - ["bar"], - @heading_lines, @heading_lines ? ["bar"] : (), @{$self->{ELTS}}, ), @@ -327,12 +526,12 @@ __END__ =head1 NAME - Text::Diff::Table - Text::Diff plugin to generate "table" format output +Text::Diff::Table - Text::Diff plugin to generate "table" format output =head1 SYNOPSIS use Text::Diff; - + diff \@a, $b, { STYLE => "Table" }; =head1 DESCRIPTION @@ -358,9 +557,9 @@ diffs: This format also goes to some pains to highlight "invisible" characters on differing elements by selectively escaping whitespace. Each element is split in to three segments (leading whitespace, body, trailing whitespace). If -whitespace differs in a segement, that segment is whitespace escaped. +whitespace differs in a segment, that segment is whitespace escaped. -Here is an example of the selective whitespace. +Here is an example of the selective whitespace: +--+--------------------------+--------------------------+ | |demo_ws_A.txt |demo_ws_B.txt | @@ -394,10 +593,10 @@ call; so far I'm choosing not to. =head1 UNICODE -To output the raw unicode chracters consult the documentation of +To output the raw unicode characters consult the documentation of L. You can set the C environment variable to 1 to output it from the command line. For more information, -consult this bug: L . +consult this bug: L. =head1 LIMITATIONS From f8c67603f88acec8b09186c323c92f73159299ac Mon Sep 17 00:00:00 2001 From: ryoskzypu Date: Sun, 30 Nov 2025 18:19:06 -0300 Subject: [PATCH 2/4] Add COLORS and PALETTE tests --- t/colors.t | 655 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 655 insertions(+) create mode 100644 t/colors.t diff --git a/t/colors.t b/t/colors.t new file mode 100644 index 0000000..1a0d577 --- /dev/null +++ b/t/colors.t @@ -0,0 +1,655 @@ +#!/usr/bin/perl + +## Test COLOR and PALLETE options correctness; they must behave like described +## in POD. +## All styles (Unified, Context, OldStyle, and Table) outputs must match their +## respective expected colorized outputs. + +use strict; +use warnings; + +use Test::More 0.96; + +use File::Spec::Functions qw( catfile ); +use File::Temp qw( tempdir tempfile ); +use Text::Diff; +use Text::Diff::Table; +use IO::Handle; + +## Texts based on https://en.wikipedia.org/wiki/Diff#Default_output_format. + +my $TEXT_ORIG = <<'END'; +This part of the +document has stayed the +same. + +This paragraph contains +text that is outdated. + +It is important to spell +check this dokument. +Things can be added +after it. +END + +my $TEXT_NEW = <<'END'; +This is an important +notice! + +This part of the +document has stayed the +same. + +It is important to spell +check this document. +Things can be added +after it. + +This paragraph contains +important new additions +to this document. +END + +## Tests based on https://github.com/neilb/Text-Diff/blob/master/t/newlines.t. + +my %EXPECTED_OUTPUTS = ( + "Unified" => { + "default" => <<"END", +\x{1b}[36m\@\@ -1,11 +1,15 \@\@\x{1b}[0m +\x{1b}[32m+This is an important\x{1b}[0m +\x{1b}[32m+notice!\x{1b}[0m +\x{1b}[32m+\x{1b}[0m + This part of the + document has stayed the + same. + +\x{1b}[31m-This paragraph contains\x{1b}[0m +\x{1b}[31m-text that is outdated.\x{1b}[0m +\x{1b}[31m-\x{1b}[0m + It is important to spell +\x{1b}[31m-check this dokument.\x{1b}[0m +\x{1b}[32m+check this document.\x{1b}[0m + Things can be added + after it. +\x{1b}[32m+\x{1b}[0m +\x{1b}[32m+This paragraph contains\x{1b}[0m +\x{1b}[32m+important new additions\x{1b}[0m +\x{1b}[32m+to this document.\x{1b}[0m +END + "custom_palette" => <<"END", +\x{1b}[30;46m\@\@ -1,11 +1,15 \@\@\x{1b}[0m +\x{1b}[30;42m+This is an important\x{1b}[0m +\x{1b}[30;42m+notice!\x{1b}[0m +\x{1b}[30;42m+\x{1b}[0m +\x{1b}[30;47m This part of the\x{1b}[0m +\x{1b}[30;47m document has stayed the\x{1b}[0m +\x{1b}[30;47m same.\x{1b}[0m +\x{1b}[30;47m \x{1b}[0m +\x{1b}[30;41m-This paragraph contains\x{1b}[0m +\x{1b}[30;41m-text that is outdated.\x{1b}[0m +\x{1b}[30;41m-\x{1b}[0m +\x{1b}[30;47m It is important to spell\x{1b}[0m +\x{1b}[30;41m-check this dokument.\x{1b}[0m +\x{1b}[30;42m+check this document.\x{1b}[0m +\x{1b}[30;47m Things can be added\x{1b}[0m +\x{1b}[30;47m after it.\x{1b}[0m +\x{1b}[30;42m+\x{1b}[0m +\x{1b}[30;42m+This paragraph contains\x{1b}[0m +\x{1b}[30;42m+important new additions\x{1b}[0m +\x{1b}[30;42m+to this document.\x{1b}[0m +END + }, + "Context" => { + "default" => <<"END", +*************** +\x{1b}[36m*** 1,11 ****\x{1b}[0m +\x{1b}[31m This part of the\x{1b}[0m +\x{1b}[31m document has stayed the\x{1b}[0m +\x{1b}[31m same.\x{1b}[0m +\x{1b}[31m \x{1b}[0m +\x{1b}[31m- This paragraph contains\x{1b}[0m +\x{1b}[31m- text that is outdated.\x{1b}[0m +\x{1b}[31m- \x{1b}[0m +\x{1b}[31m It is important to spell\x{1b}[0m +\x{1b}[31m! check this dokument.\x{1b}[0m +\x{1b}[31m Things can be added\x{1b}[0m +\x{1b}[31m after it.\x{1b}[0m +\x{1b}[36m--- 1,15 ----\x{1b}[0m +\x{1b}[32m+ This is an important\x{1b}[0m +\x{1b}[32m+ notice!\x{1b}[0m +\x{1b}[32m+ \x{1b}[0m +\x{1b}[32m This part of the\x{1b}[0m +\x{1b}[32m document has stayed the\x{1b}[0m +\x{1b}[32m same.\x{1b}[0m +\x{1b}[32m \x{1b}[0m +\x{1b}[32m It is important to spell\x{1b}[0m +\x{1b}[32m! check this document.\x{1b}[0m +\x{1b}[32m Things can be added\x{1b}[0m +\x{1b}[32m after it.\x{1b}[0m +\x{1b}[32m+ \x{1b}[0m +\x{1b}[32m+ This paragraph contains\x{1b}[0m +\x{1b}[32m+ important new additions\x{1b}[0m +\x{1b}[32m+ to this document.\x{1b}[0m +END + "custom_palette" => <<"END", +\x{1b}[1;30;44m***************\x{1b}[0m +\x{1b}[30;46m*** 1,11 ****\x{1b}[0m +\x{1b}[30;41m This part of the\x{1b}[0m +\x{1b}[30;41m document has stayed the\x{1b}[0m +\x{1b}[30;41m same.\x{1b}[0m +\x{1b}[30;41m \x{1b}[0m +\x{1b}[30;41m- This paragraph contains\x{1b}[0m +\x{1b}[30;41m- text that is outdated.\x{1b}[0m +\x{1b}[30;41m- \x{1b}[0m +\x{1b}[30;41m It is important to spell\x{1b}[0m +\x{1b}[30;41m! check this dokument.\x{1b}[0m +\x{1b}[30;41m Things can be added\x{1b}[0m +\x{1b}[30;41m after it.\x{1b}[0m +\x{1b}[30;46m--- 1,15 ----\x{1b}[0m +\x{1b}[30;42m+ This is an important\x{1b}[0m +\x{1b}[30;42m+ notice!\x{1b}[0m +\x{1b}[30;42m+ \x{1b}[0m +\x{1b}[30;42m This part of the\x{1b}[0m +\x{1b}[30;42m document has stayed the\x{1b}[0m +\x{1b}[30;42m same.\x{1b}[0m +\x{1b}[30;42m \x{1b}[0m +\x{1b}[30;42m It is important to spell\x{1b}[0m +\x{1b}[30;42m! check this document.\x{1b}[0m +\x{1b}[30;42m Things can be added\x{1b}[0m +\x{1b}[30;42m after it.\x{1b}[0m +\x{1b}[30;42m+ \x{1b}[0m +\x{1b}[30;42m+ This paragraph contains\x{1b}[0m +\x{1b}[30;42m+ important new additions\x{1b}[0m +\x{1b}[30;42m+ to this document.\x{1b}[0m +END + }, + "OldStyle" => { + "default" => <<"END", +\x{1b}[36m0a1,3\x{1b}[0m +\x{1b}[32m> This is an important\x{1b}[0m +\x{1b}[32m> notice!\x{1b}[0m +\x{1b}[32m> \x{1b}[0m +\x{1b}[36m5,7d7\x{1b}[0m +\x{1b}[31m< This paragraph contains\x{1b}[0m +\x{1b}[31m< text that is outdated.\x{1b}[0m +\x{1b}[31m< \x{1b}[0m +\x{1b}[36m9c9\x{1b}[0m +\x{1b}[31m< check this dokument.\x{1b}[0m +--- +\x{1b}[32m> check this document.\x{1b}[0m +\x{1b}[36m11a12,15\x{1b}[0m +\x{1b}[32m> \x{1b}[0m +\x{1b}[32m> This paragraph contains\x{1b}[0m +\x{1b}[32m> important new additions\x{1b}[0m +\x{1b}[32m> to this document.\x{1b}[0m +END + "custom_palette" => <<"END", +\x{1b}[30;46m0a1,3\x{1b}[0m +\x{1b}[30;42m> This is an important\x{1b}[0m +\x{1b}[30;42m> notice!\x{1b}[0m +\x{1b}[30;42m> \x{1b}[0m +\x{1b}[30;46m5,7d7\x{1b}[0m +\x{1b}[30;41m< This paragraph contains\x{1b}[0m +\x{1b}[30;41m< text that is outdated.\x{1b}[0m +\x{1b}[30;41m< \x{1b}[0m +\x{1b}[30;46m9c9\x{1b}[0m +\x{1b}[30;41m< check this dokument.\x{1b}[0m +\x{1b}[1;30;44m---\x{1b}[0m +\x{1b}[30;42m> check this document.\x{1b}[0m +\x{1b}[30;46m11a12,15\x{1b}[0m +\x{1b}[30;42m> \x{1b}[0m +\x{1b}[30;42m> This paragraph contains\x{1b}[0m +\x{1b}[30;42m> important new additions\x{1b}[0m +\x{1b}[30;42m> to this document.\x{1b}[0m +END + }, + "Table" => { + "default" => <<"END", ++---+--------------------------+---+--------------------------+\x{1b}[0m +| | *\x{1b}[0m \x{1b}[36m 1\x{1b}[0m|\x{1b}[0m\x{1b}[32mThis is an important \x{1b}[0m *\x{1b}[0m +| | *\x{1b}[0m \x{1b}[36m 2\x{1b}[0m|\x{1b}[0m\x{1b}[32mnotice! \x{1b}[0m *\x{1b}[0m +| | *\x{1b}[0m \x{1b}[36m 3\x{1b}[0m|\x{1b}[0m\x{1b}[32m\\n \x{1b}[0m *\x{1b}[0m +|\x{1b}[0m \x{1b}[36m 1\x{1b}[0m|\x{1b}[0mThis part of the \x{1b}[0m |\x{1b}[0m \x{1b}[36m 4\x{1b}[0m|\x{1b}[0mThis part of the \x{1b}[0m |\x{1b}[0m +|\x{1b}[0m \x{1b}[36m 2\x{1b}[0m|\x{1b}[0mdocument has stayed the \x{1b}[0m |\x{1b}[0m \x{1b}[36m 5\x{1b}[0m|\x{1b}[0mdocument has stayed the \x{1b}[0m |\x{1b}[0m +|\x{1b}[0m \x{1b}[36m 3\x{1b}[0m|\x{1b}[0msame. \x{1b}[0m |\x{1b}[0m \x{1b}[36m 6\x{1b}[0m|\x{1b}[0msame. \x{1b}[0m |\x{1b}[0m +|\x{1b}[0m \x{1b}[36m 4\x{1b}[0m|\x{1b}[0m \x{1b}[0m |\x{1b}[0m \x{1b}[36m 7\x{1b}[0m|\x{1b}[0m \x{1b}[0m |\x{1b}[0m +*\x{1b}[0m \x{1b}[36m 5\x{1b}[0m|\x{1b}[0m\x{1b}[31mThis paragraph contains \x{1b}[0m * | |\x{1b}[0m +*\x{1b}[0m \x{1b}[36m 6\x{1b}[0m|\x{1b}[0m\x{1b}[31mtext that is outdated. \x{1b}[0m * | |\x{1b}[0m +*\x{1b}[0m \x{1b}[36m 7\x{1b}[0m|\x{1b}[0m\x{1b}[31m\\n \x{1b}[0m * | |\x{1b}[0m +|\x{1b}[0m \x{1b}[36m 8\x{1b}[0m|\x{1b}[0mIt is important to spell\x{1b}[0m |\x{1b}[0m \x{1b}[36m 8\x{1b}[0m|\x{1b}[0mIt is important to spell\x{1b}[0m |\x{1b}[0m +*\x{1b}[0m \x{1b}[36m 9\x{1b}[0m|\x{1b}[0m\x{1b}[31mcheck this dokument. \x{1b}[0m *\x{1b}[0m \x{1b}[36m 9\x{1b}[0m|\x{1b}[0m\x{1b}[32mcheck this document. \x{1b}[0m *\x{1b}[0m +|\x{1b}[0m \x{1b}[36m10\x{1b}[0m|\x{1b}[0mThings can be added \x{1b}[0m |\x{1b}[0m \x{1b}[36m10\x{1b}[0m|\x{1b}[0mThings can be added \x{1b}[0m |\x{1b}[0m +|\x{1b}[0m \x{1b}[36m11\x{1b}[0m|\x{1b}[0mafter it. \x{1b}[0m |\x{1b}[0m \x{1b}[36m11\x{1b}[0m|\x{1b}[0mafter it. \x{1b}[0m |\x{1b}[0m +| | *\x{1b}[0m \x{1b}[36m12\x{1b}[0m|\x{1b}[0m\x{1b}[32m\\n \x{1b}[0m *\x{1b}[0m +| | *\x{1b}[0m \x{1b}[36m13\x{1b}[0m|\x{1b}[0m\x{1b}[32mThis paragraph contains \x{1b}[0m *\x{1b}[0m +| | *\x{1b}[0m \x{1b}[36m14\x{1b}[0m|\x{1b}[0m\x{1b}[32mimportant new additions \x{1b}[0m *\x{1b}[0m +| | *\x{1b}[0m \x{1b}[36m15\x{1b}[0m|\x{1b}[0m\x{1b}[32mto this document. \x{1b}[0m *\x{1b}[0m ++---+--------------------------+---+--------------------------+\x{1b}[0m +END + "custom_palette" => <<"END", +\x{1b}[93m+---+--------------------------+---+--------------------------+\x{1b}[0m +\x{1b}[93m| | *\x{1b}[0m \x{1b}[30;46m 1\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;42mThis is an important \x{1b}[0m \x{1b}[93m*\x{1b}[0m +\x{1b}[93m| | *\x{1b}[0m \x{1b}[30;46m 2\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;42mnotice! \x{1b}[0m \x{1b}[93m*\x{1b}[0m +\x{1b}[93m| | *\x{1b}[0m \x{1b}[30;46m 3\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;42m\\n \x{1b}[0m \x{1b}[93m*\x{1b}[0m +\x{1b}[93m|\x{1b}[0m \x{1b}[30;46m 1\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47mThis part of the \x{1b}[0m \x{1b}[93m|\x{1b}[0m \x{1b}[30;46m 4\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47mThis part of the \x{1b}[0m \x{1b}[93m|\x{1b}[0m +\x{1b}[93m|\x{1b}[0m \x{1b}[30;46m 2\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47mdocument has stayed the \x{1b}[0m \x{1b}[93m|\x{1b}[0m \x{1b}[30;46m 5\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47mdocument has stayed the \x{1b}[0m \x{1b}[93m|\x{1b}[0m +\x{1b}[93m|\x{1b}[0m \x{1b}[30;46m 3\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47msame. \x{1b}[0m \x{1b}[93m|\x{1b}[0m \x{1b}[30;46m 6\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47msame. \x{1b}[0m \x{1b}[93m|\x{1b}[0m +\x{1b}[93m|\x{1b}[0m \x{1b}[30;46m 4\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47m \x{1b}[0m \x{1b}[93m|\x{1b}[0m \x{1b}[30;46m 7\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47m \x{1b}[0m \x{1b}[93m|\x{1b}[0m +\x{1b}[93m*\x{1b}[0m \x{1b}[30;46m 5\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;41mThis paragraph contains \x{1b}[0m \x{1b}[93m* | |\x{1b}[0m +\x{1b}[93m*\x{1b}[0m \x{1b}[30;46m 6\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;41mtext that is outdated. \x{1b}[0m \x{1b}[93m* | |\x{1b}[0m +\x{1b}[93m*\x{1b}[0m \x{1b}[30;46m 7\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;41m\\n \x{1b}[0m \x{1b}[93m* | |\x{1b}[0m +\x{1b}[93m|\x{1b}[0m \x{1b}[30;46m 8\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47mIt is important to spell\x{1b}[0m \x{1b}[93m|\x{1b}[0m \x{1b}[30;46m 8\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47mIt is important to spell\x{1b}[0m \x{1b}[93m|\x{1b}[0m +\x{1b}[93m*\x{1b}[0m \x{1b}[30;46m 9\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;41mcheck this dokument. \x{1b}[0m \x{1b}[93m*\x{1b}[0m \x{1b}[30;46m 9\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;42mcheck this document. \x{1b}[0m \x{1b}[93m*\x{1b}[0m +\x{1b}[93m|\x{1b}[0m \x{1b}[30;46m10\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47mThings can be added \x{1b}[0m \x{1b}[93m|\x{1b}[0m \x{1b}[30;46m10\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47mThings can be added \x{1b}[0m \x{1b}[93m|\x{1b}[0m +\x{1b}[93m|\x{1b}[0m \x{1b}[30;46m11\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47mafter it. \x{1b}[0m \x{1b}[93m|\x{1b}[0m \x{1b}[30;46m11\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;47mafter it. \x{1b}[0m \x{1b}[93m|\x{1b}[0m +\x{1b}[93m| | *\x{1b}[0m \x{1b}[30;46m12\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;42m\\n \x{1b}[0m \x{1b}[93m*\x{1b}[0m +\x{1b}[93m| | *\x{1b}[0m \x{1b}[30;46m13\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;42mThis paragraph contains \x{1b}[0m \x{1b}[93m*\x{1b}[0m +\x{1b}[93m| | *\x{1b}[0m \x{1b}[30;46m14\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;42mimportant new additions \x{1b}[0m \x{1b}[93m*\x{1b}[0m +\x{1b}[93m| | *\x{1b}[0m \x{1b}[30;46m15\x{1b}[0m\x{1b}[93m|\x{1b}[0m\x{1b}[30;42mto this document. \x{1b}[0m \x{1b}[93m*\x{1b}[0m +\x{1b}[93m+---+--------------------------+---+--------------------------+\x{1b}[0m +END + }, +); + +my $NAMES = { + never => "file diff 'never'", + auto => "file diff 'auto'", + always => "file diff 'always'", + invalid_hunks => "file diff 'always' (invalid hunks)", + invalid_palette => "file diff 'always' (invalid palette)", +}; + +my $PALETTE = { + valid => { + header => "bold blue", + line_number => "black on_cyan", + delete_line => "black on_red", + add_line => "black on_green", + same_line => "black on_white", + context_sep => "bold black on_blue", + oldstyle_sep => "bold black on_blue", + table_frame => "bright_yellow", + }, + invalid => { + header => "bogus bold blue", + line_number => "bogus black on_cyan", + delete_line => "bogus black on_red", + add_line => "bogus black on_green", + same_line => "bogus black on_white", + context_sep => "bogus bold black on_blue", + oldstyle_sep => "bogus bold black on_blue", + table_frame => "bogus bright_yellow", + }, +}; + +my $HUNKS = { + invalid => { + bogus_header => "bold blue", + bogus_line_number => "black on_cyan", + bogus_delete_line => "black on_red", + bogus_add_line => "black on_green", + bogus_same_line => "black on_white", + bogus_context_sep => "bold black on_blue", + bogus_oldstyle_sep => "bold black on_blue", + bogus_table_frame => "bright_yellow", + }, +}; + +sub _verbose_output { + note "Original text"; + note explain _indent( $TEXT_ORIG ); + note "\n"; + note "New text"; + note explain _indent( $TEXT_NEW ); + note "\n"; + + for my $style ( qw/ Unified Context OldStyle Table / ) { + note $style; + note "(expected default)"; + note explain _indent( $EXPECTED_OUTPUTS{$style}{default} ); + note "\n"; + note "(expected custom_palette)"; + note explain _indent( $EXPECTED_OUTPUTS{$style}{custom_palette} ); + note "\n"; + } +} + +sub _indent { + my $text = shift; + + return $text =~ s/^/ /mgr if defined $text; +} + +sub _spew { + my ( $content, $file ) = @_; + + open my $fh, ">", $file or die $!; + print $fh $content or die $!; + close $fh or die $!; +} + +## Generate diff() file header. +sub _file_header { + my ( $options ) = @_; + + my ( $file_a, $file_b, $style, $colors ) = @{$options}{ + "file_a", + "file_b", + "style", + "colors", + }; + + my $file_stats = { + FILENAME_A => $file_a, + MTIME_A => (stat( $file_a ))[9], + FILENAME_B => $file_b, + MTIME_B => (stat( $file_b ))[9], + PALETTE => $colors, + }; + + if ( $style eq "Table" ) { + my @heading_lines = Text::Diff::Table::_header( $file_stats ); + + my $fmt_opts = { + width => [2, 24, 2, 24], + column_mode => 1, + palette => $colors, + }; + + my %heading_fmts = Text::Diff::Table::_header_fmt( $fmt_opts ); + my %fmts = Text::Diff::Table::_table_fmt( $fmt_opts ); + + my $bar = Text::Diff::Table::_bar_fmt( + { + bar => $fmts{"="}, + column_mode => 1, + palette => $colors, + } + ); + + my $heading = Text::Diff::Table::_heading( + { + bar => $bar, + fmts => \%heading_fmts, + lines => \@heading_lines, + } + ); + + return $heading; + } + else { + my $header_sub = ( "Text::Diff::" . $style )->can( "file_header" ); + + return $header_sub->( + undef, + $file_stats, + ); + } +} + +_verbose_output(); + +## Initialize temporary directory and files. + +my $temp_dir = tempdir( CLEANUP => 1 ); +my $file_a = catfile( $temp_dir, "a.txt" ); +my $file_b = catfile( $temp_dir, "b.txt" ); + +_spew( $TEXT_ORIG, $file_a ); +_spew( $TEXT_NEW, $file_b ); + +## Tests + +## NOTE: +## A true value (auto) cannot be tested reliably, since TAP::Harness/prove seem +## to modify STDOUT. +for my $style ( qw/ Unified Context OldStyle Table / ) { + my $test = $EXPECTED_OUTPUTS{$style}; + + subtest $style => sub { + my $palette; + my $colors; + + for my $expected ( qw/ default custom_palette / ) { + ## Init test variables/closures. + + if ( $expected eq "default" ) { + $palette = undef; + $colors = Text::Diff::_get_colors(); + } + elsif ( $expected eq "custom_palette" ) { + $palette = $PALETTE->{valid}; + $colors = Text::Diff::_get_colors( $palette ); + } + + my $header_opts = { + file_a => $file_a, + file_b => $file_b, + style => $style, + colors => $colors, + }; + + my $get_opts = sub { + my ( $options ) = @_; + + my $diff_opts = $options->{diff}; + my $is = $options->{test}{is}; + my $isnt = $options->{test}{isnt}; + my $expected = $options->{test}{expected}; + + if ( defined $is || defined $isnt ) { + if ( defined $expected && $expected ne "invalid_default" ) { + $expected = _file_header( $header_opts ) . $test->{$expected}; + } + } + + if ( defined $expected && $expected eq "invalid_default" ) { + $expected = _file_header( + { + file_a => $file_a, + file_b => $file_b, + style => $style, + colors => Text::Diff::_get_colors(), + } + ) . $test->{default}; + } + + return ( $diff_opts, $is, $isnt, $expected ); + }; + + my $test_it = sub { + my ( $options ) = @_; + my ( $diff_opts, $is, $isnt, $expected ) = $get_opts->( $options ); + + my $diff = sub { + diff( + $file_a, $file_b, + { + STYLE => $style, + %{$diff_opts}, + } + ); + }; + + if ( defined $is ) { + is( + $diff->(), + $expected, + $options->{test}{name}, + ); + } + elsif ( defined $isnt ) { + isnt( + $diff->(), + $expected, + $options->{test}{name}, + ); + } + }; + + my $isnt_auto = sub { + { + diff => { + COLOR => 1, + PALETTE => $palette, + }, + test => { + isnt => 1, + expected => $expected, + name => $NAMES->{auto}, + } + } + }; + + my $is_always = sub { + { + diff => { + COLOR => "always", + PALETTE => $palette, + }, + test => { + is => 1, + expected => $expected, + name => $NAMES->{always}, + }, + } + }; + + my $isnt_hunks_invalid = sub { + ## Invalid hunks cannot get its expected custom palette colors. + { + diff => { + COLOR => "always", + PALETTE => $HUNKS->{invalid}, + }, + test => { + isnt => 1, + expected => $expected, + name => $NAMES->{invalid_hunks}, + }, + } + }; + + my $is_palette_valid = sub { + ## Invalid palettes get its expected default colors. + { + diff => { + COLOR => "always", + PALETTE => $PALETTE->{invalid}, + }, + test => { + is => 1, + expected => "invalid_default", + name => $NAMES->{invalid_palette}, + }, + } + }; + + ## Begin tests. + subtest $expected => sub { + $test_it->( + { + diff => { + COLOR => 0, + }, + test => { + isnt => 1, + expected => $expected, + name => $NAMES->{never}, + }, + } + ); + + $test_it->( $is_always->() ); + + ## Test bogus PALETTE input. + if ( $expected eq "custom_palette" ) { + $test_it->( $isnt_hunks_invalid->() ); + $test_it->( $is_palette_valid->() ); + } + + ## Non-TTY tests. + subtest "non-TTY" => sub { + subtest "STDOUT" => sub { + ## Emulate non-TTY STDOUT. + { + local *STDOUT; + + $test_it->( $isnt_auto->() ); + $test_it->( $is_always->() ); + + if ( $expected eq "custom_palette" ) { + $test_it->( $isnt_hunks_invalid->() ); + $test_it->( $is_palette_valid->() ); + } + } + }; + + ## OUTPUT option tests. + for my $output ( qw/ GLOB IO::Handle / ) { + subtest "OUTPUT ($output)" => sub { + my $io = IO::Handle->new if $output eq "IO::Handle"; + + my $output_test_it = sub { + my ( $options ) = @_; + my ( $diff_opts, $is, $isnt, $expected ) = $get_opts->( $options ); + + my $glob = tempfile( DIR => $temp_dir ); + + if ( $output eq "IO::Handle" ) { + if ( defined $io && $io->fdopen( fileno( $glob ), "r+" ) ) { + $glob = $io; + } else { + die "Failed to fdopen(): $!"; + } + } + + ## diff() output is sent to $glob handle. + diff( + $file_a, $file_b, + { + STYLE => $style, + %{$diff_opts}, + OUTPUT => $glob, + } + ); + + ## Rewind $glob before slurping it, so diff() + ## output can be captured. + seek $glob, 0, 0 or die $!; + my $diff = do { local $/; <$glob> }; + #print $diff; + close $glob or die $!; + + if ( defined $is ) { + is( + $diff, + $expected, + $options->{test}{name}, + ); + } + elsif ( defined $isnt ) { + isnt( + $diff, + $expected, + $options->{test}{name}, + ); + } + }; + + $output_test_it->( $isnt_auto->() ); + $output_test_it->( $is_always->() ); + + if ( $expected eq "custom_palette" ) { + $output_test_it->( $isnt_hunks_invalid->() ); + $output_test_it->( $is_palette_valid->() ); + } + }; + } + }; + }; + } + }; +} + +done_testing(); From fb55366ba47611860353f46358005e50afa88c07 Mon Sep 17 00:00:00 2001 From: ryoskzypu Date: Sun, 30 Nov 2025 18:19:38 -0300 Subject: [PATCH 3/4] Add Term::ANSIColor to Makefile.PL --- Makefile.PL | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile.PL b/Makefile.PL index 8de03da..7e88f0e 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -18,6 +18,7 @@ WriteMakefile( PREREQ_PM => { 'Exporter' => 0, 'Algorithm::Diff' => '1.19', + 'Term::ANSIColor' => '2.02', }, ( $] >= 5.005 ? ( AUTHOR => 'Adam Kennedy ', ) : () ), ( From 25fd49e189f01b7a4d7c2e90c6de663aa09a4be6 Mon Sep 17 00:00:00 2001 From: ryoskzypu Date: Sun, 30 Nov 2025 18:19:51 -0300 Subject: [PATCH 4/4] Update README with pod2text --- README | 121 +++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 83 insertions(+), 38 deletions(-) diff --git a/README b/README index bbe8f3c..d9a21b4 100644 --- a/README +++ b/README @@ -17,17 +17,17 @@ SYNOPSIS my $diff = diff \@records1, "file_B.txt"; DESCRIPTION - "diff()" provides a basic set of services akin to the GNU "diff" - utility. It is not anywhere near as feature complete as GNU "diff", but - it is better integrated with Perl and available on all platforms. It is - often faster than shelling out to a system's "diff" executable for small + diff() provides a basic set of services akin to the GNU "diff" utility. + It is not anywhere near as feature complete as GNU "diff", but it is + better integrated with Perl and available on all platforms. It is often + faster than shelling out to a system's "diff" executable for small files, and generally slower on larger files. Relies on Algorithm::Diff for, well, the algorithm. This may not produce the same exact diff as a system's local "diff" executable, but it will be a valid diff and comprehensible by "patch". We haven't seen any - differences between Algorithm::Diff's logic and GNU diff's, but we have - not examined them to make sure they are indeed identical. + differences between Algorithm::Diff's logic and GNU "diff"'s, but we + have not examined them to make sure they are indeed identical. Note: If you don't want to import the "diff" function, do one of the following: @@ -36,20 +36,23 @@ DESCRIPTION require Text::Diff; - That's a pretty rare occurence, so "diff()" is exported by default. - =head1 OPTIONS + That's a pretty rare occurrence, so diff() is exported by default. + If you pass a filename, but the file can't be read, then diff() will + "croak". + +OPTIONS diff() takes two parameters from which to draw input and a set of - options to control it's output. The options are: + options to control its output. The options are: FILENAME_A, MTIME_A, FILENAME_B, MTIME_B - The name of the file and the modification time "files" + The name of the file and the modification time "files". These are filled in automatically for each file when diff() is passed a filename, unless a defined value is passed in. If a filename is not passed in and FILENAME_A and FILENAME_B are not - provided or "undef", the header will not be printed. + provided or are "undef", the header will not be printed. Unused on "OldStyle" diffs. @@ -57,26 +60,25 @@ DESCRIPTION The index of the first line / element. These default to 1 for all parameter types except ARRAY references, for which the default is 0. This is because ARRAY references are presumed to be data structures, - while the others are line oriented text. + while the others are line-oriented text. STYLE "Unified", "Context", "OldStyle", or an object or class reference - for a class providing "file_header()", "hunk_header()", "hunk()", - "hunk_footer()" and "file_footer()" methods. The two footer() - methods are provided for overloading only; none of the formats - provide them. + for a class providing file_header(), hunk_header(), hunk(), + hunk_footer() and file_footer() methods. The two footer() methods + are provided for overloading only; none of the formats provide them. Defaults to "Unified" (unlike standard "diff", but Unified is what's most often used in submitting patches and is the most human readable of the three. - If the package indicated by the STYLE has no hunk() method, - c will load it automatically (lazy loading). Since all such - packages should inherit from Text::Diff::Base, this should be marvy. + If the package indicated by the STYLE has no hunk() method, diff() + will load it automatically (lazy loading). Since all such packages + should inherit from "Text::Diff::Base", this should be marvy. - Styles may be specified as class names ("STYLE =" "Foo"), in which - case they will be "new()"ed with no parameters, or as objects - ("STYLE =" Foo->new>). + Styles may be specified as class names ("STYLE => 'Foo'"), in which + case they will be new()ed with no parameters, or as objects ("STYLE + => Foo->new"). CONTEXT How many lines before and after each diff to display. Ignored on @@ -103,10 +105,33 @@ DESCRIPTION KEYGEN, KEYGEN_ARGS These are passed to "traverse_sequences" in Algorithm::Diff. + COLOR, PALETTE + diff() output will be colorized based on GNU "diff" colors depending + on the values passed. A true value colorizes only if "STDOUT" or + "OUTPUT" handle is an interactive TTY, unless "always" is passed; if + false is given, never colorizes. Defaults to 0. + + COLOR => 1, # like: GNU diff "auto" + COLOR => "always", + + With PALETTE, diff() colors can be customized according to the + Term::ANSIColor spec by passing a hash with the following: + + ## Hunk sections and its default colors. + ## NOTE: invalid colors are ignored. + header => BOLD, # like: --- A Mon Nov 12 23:49:30 2001 + line_number => CYAN, # like: @@ -2,13 +2,13 @@ + delete_line => RED, # like: -5d + add_line => GREEN, # like: +5a + same_line => undef, # "Unified" unchanged lines + context_sep => undef, # "Context" separator: "***************" + oldstyle_sep => undef, # "OldStyle" separator: "---" + table_frame => undef, # "Table" frames: "+--+----+--+----+", "|", "*" + Note: if neither "FILENAME_" option is defined, the header will not be - printed. If at one is present, the other and both MTIME_ options must be - present or "Use of undefined variable" warnings will be generated - (except on "OldStyle" diffs, which ignores these options). + printed. If at least one is present, the other and both "MTIME_" options + must be present or "Use of undefined variable" warnings will be + generated (except on "OldStyle" diffs, which ignores these options). Formatting Classes These functions implement the output formats. They are grouped in to @@ -116,7 +141,7 @@ Formatting Classes may provide them if need be. Each class has file_header(), hunk_header(), hunk(), and footer() - methods identical to those documented in the Text::Diff::Unified + methods identical to those documented in the "Text::Diff::Unified" section. header() is called before the hunk() is first called, footer() afterwards. The default footer function is an empty method provided for overloading: @@ -124,11 +149,11 @@ Formatting Classes sub footer { return "End of patch\n" } Some output formats are provided by external modules (which are loaded - automatically), such as Text::Diff::Table. These are are documented here - to keep the documentation simple. + automatically), such as Text::Diff::Table. These are documented here to + keep the documentation simple. Text::Diff::Base - Returns "" for all methods (other than "new()"). + Returns "" for all methods (other than new()). Text::Diff::Unified --- A Mon Nov 12 23:49:30 2001 @@ -150,11 +175,11 @@ Formatting Classes 12 13 - file_header + Text::Diff::Unified::file_header $s = Text::Diff::Unified->file_header( $options ); Returns a string containing a unified header. The sole parameter is - the options hash passed in to diff(), containing at least: + the "options" hash passed in to diff(), containing at least: FILENAME_A => $fn1, MTIME_A => $mtime1, @@ -168,10 +193,10 @@ Formatting Classes to override the default prefixes (default values shown). - hunk_header + Text::Diff::Unified::hunk_header Text::Diff::Unified->hunk_header( \@ops, $options ); - Returns a string containing the output of one hunk of unified diff. + Returns a string containing the heading of one hunk of unified diff. Text::Diff::Unified::hunk Text::Diff::Unified->hunk( \@seq_a, \@seq_b, \@ops, $options ); @@ -212,7 +237,7 @@ Formatting Classes * 9|embedded ws |embedded\tws * +--+--------------------------+--------------------------+ - See "Text::Diff::Table" for more details, including how the whitespace + See Text::Diff::Table for more details, including how the whitespace escaping works. Text::Diff::Context @@ -267,17 +292,37 @@ LIMITATIONS normal amount of Perlish overhead (one array location) per record. This is implied by the implementation of Algorithm::Diff, which takes two arrays. If Algorithm::Diff ever offers an incremental mode, this can be - changed (contact the maintainers of Algorithm::Diff and Text::Diff if + changed (contact the maintainers of Algorithm::Diff and "Text::Diff" if you need this; it shouldn't be too terribly hard to tie arrays in this fashion). - Does not provide most of the more refined GNU diff options: recursive + Does not provide most of the more refined GNU "diff" options: recursive directory tree scanning, ignoring blank lines / whitespace, etc., etc. These can all be added as time permits and need arises, many are rather easy; patches quite welcome. - Uses closures internally, this may lead to leaks on "perl" versions - 5.6.1 and prior if used many times over a process' life time. + Uses closures internally, this may lead to leaks on Perl versions 5.6.1 + and prior if used many times over a process' life time. + +SEE ALSO + Algorithm::Diff - the underlying implementation of the diff algorithm + used by "Text::Diff". + + YAML::Diff - find difference between two YAML documents. + + HTML::Differences - find difference between two HTML documents. This + uses a more sane approach than HTML::Diff. + + XML::Diff - find difference between two XML documents. + + Array::Diff - find the differences between two Perl arrays. + + Hash::Diff - find the differences between two Perl hashes. + + Data::Diff - find difference between two arbitrary data structures. + +REPOSITORY + AUTHOR Adam Kennedy