view release on metacpan or  search on metacpan

ccdiff  view on Meta::CPAN

my $rev_color = $rc{bg};
my $cli_color = $ENV{CLICOLOR};	# https://bixense.com/clicolors/
my $no_colors = $ENV{NO_COLOR}; # https://no-color.org
my $old_label = $rc{old_label};
my $new_label = $rc{new_label};
my $list_colors;
my $diff_class;

if ($no_colors) {
    $ENV{CLICOLOR_FORCE}	and $no_colors = 0;
    }
elsif (defined $cli_color) {
    # true $cli_color is the default for ccdiff
    !$cli_color || !-t		and $no_colors = 1;
    }

unless (caller) {
    $ENV{CCDIFF_OPTIONS} and unshift @ARGV, split m/\s+/ => $ENV{CCDIFF_OPTIONS};
    GetOptions (
	"help|?"	=> sub { usage (0); },
	"V|version"	=> sub { say "$CMD [$VERSION]"; exit 0; },
	  "man"		=> sub { pod_nroff (); },
	  "info"	=> sub { pod_text  (); },

	"U|utf-8!"		=> \$opt_U,
	  "dc|diff-class=s"	=> \$diff_class,
	  "pp!"			=> sub { $diff_class = "PP" },

    #   "c|context:3"		=> \$opt_c,	# implement context-diff?
	"u|unified:3"		=> \$opt_u,
	"I|idx|index:-1"	=> \$opt_I,
	"t|threshold=i"		=> \$opt_t,
	"H|header!"		=> \$opt_H,
	  "HC|header-color=s"	=> \$opt_H,
	"h|heuristics=i"	=> \$opt_h,
	"e|ellipsis=i"		=> \$opt_e,
	  "emacs!"		=> \$emacs,

	"a|ascii"		=> sub { $opt_a ^= 1 },
	"m|markers"		=> sub { $opt_m ^= 1 },
	"r|reverse|invert"	=> sub { $opt_r ^= 1 },
	"s|swap!"		=> sub { $opt_s ^= 1 },

	"i|ignore-case!"			=> \$opt_i,
	"w|ignore-all-space!"			=> \$opt_w,
	"b|ignore-ws|ignore-space-change!"	=> \$opt_b,
	"Z|ignore-trailing-space!"		=> \$opt_Z,
	"E|ignore-tab-expansion!"		=> \$opt_E, # NYI
	"B|ignore-blank-lines!"			=> \$opt_B, # Partly implemented

	  "old-label|label-old=s"		=> \$old_label,
	  "new-label|label-new=s"		=> \$new_label,

	"p|pink!"		=> sub { $old_color = "magenta" },
	  "old=s"		=> \$old_color,
	  "new=s"		=> \$new_color,
	  "bg=s"		=> \$rev_color,
	  "no-colors"		=> \$no_colors,
	  "list-colors!"	=> \$list_colors,
	  "settings|defaults"	=> sub {
		binmode STDOUT, ":encoding(utf-8)";
		printf "%-10s : %s\n", $_, $rc{$_} // "<undef>" for sort keys %rc;
		exit 0;
		},

	"v|verbose:1"	=> \$opt_v,
	) or usage (1);
    }

$opt_w      and $opt_b = $opt_Z = $opt_E = $opt_B = 1;
$opt_h >= 1 and $opt_h /= 100;

sub pod_text {
    require Pod::Text::Color;
    my $m = $no_colors ? "Pod::Text" : "Pod::Text::Color";
    my $p = $m->new ();
    open my $fh, ">", \my $out;
    $p->parse_from_file ($0, $fh);
    close $fh;
    print $out;
    exit 0;
    } # pod_text

sub pod_nroff {
    first { -x "$_/nroff" } grep { -d } split m/:+/ => $ENV{PATH} or pod_text ();

    require Pod::Man;
    my $p = Pod::Man->new ();
    open my $fh, "|-", "nroff", "-man";
    $p->parse_from_file ($0, $fh);
    close $fh;
    exit 0;
    } # pod_nroff

# Color initialization
for ($old_color, $new_color, $rev_color) {
    s/^(.*)[ _]bold$/bold $1/i;
    s/^bold_/bold /i;
    }
my %clr = map { $_ => color (s{^(.*)[ _]bold$}{bold $1}ir =~
                             s{^bold[ _]}{bold }ir) }
	  map {( $_, "on_$_", "bold $_" )}
    qw( red green blue black white cyan magenta yellow );
$clr{$_} //= color ($_) for tac_colors ();
$no_colors and $clr{$_} = "" for keys %clr;
$clr{none} = $clr{on_none} = "";

my ($reset,   $bg_new,  $bg_old,
    $chr_cml, $chr_cmr, $chr_ctx, $chr_eli, $chr_eql, $chr_lft,
    $chr_new, $chr_old, $chr_rgt,
    $clr_dbg, $clr_grn, $clr_new, $clr_old, $clr_red, $clr_rev,
    $cmp_sub) = (RESET);

if ($list_colors) {
    my @clr = map { sprintf "%s%-18s%s", $clr{$_}, $_, $reset } sort keys %clr;
    while (@clr) {
	say join "  " => map { $_ // "" } splice @clr, 0, 4;
	}
    exit;
    }

ccdiff  view on Meta::CPAN

	ccdiff (@ARGV);
	}
    exit 0;
    }

sub ccdiff {
    my $f1 = shift or usage (1);
    my $f2 = $_[0] // "-";

    -b $f1 || -c $f1 || -b $f2 || -c $f2 and
	die "Character and block devices are not supported\n";
    -d $f1 || -d $f2 and
	die "$CMD does not support directory diff\n";

    my $fh;

    if (@_ > 1 && ref $_[1]) { # optional hash with overruling arguments
	my %opt = %{$_[1]};
	foreach my $o (keys %opt) {
	    my $v = $opt{$o};
	    $o eq "ascii"			and $opt_a = $v;
	    $o eq "bg"				and $rev_color = $v;
#	    $o eq "context"			and $opt_c = $v;
	    $o eq "ellipsis"			and $opt_e = $v;
	    $o eq "emacs"			and $emacs = $v;
	    $o eq "header"			and $opt_H = $v;
	    $o eq "heuristics"			and $opt_h = $v;
	    $o eq "ignore-all-space"		and $opt_w = $v;
	    $o eq "ignore-blank-lines"		and $opt_B = $v;
	    $o eq "ignore-case"			and $opt_i = $v;
	    $o eq "ignore-space-change"		and $opt_b = $v;
	    $o eq "ignore-tab-expansion"	and $opt_E = $v;
	    $o eq "ignore-trailing-space"	and $opt_Z = $v;
	    $o eq "index"			and $opt_I = $v;
	    $o eq "list-colors"			and $list_colors = $v;
	    $o eq "markers"			and $opt_m = $v;
	    $o eq "new"				and $new_color = $v;
	    $o eq "old"				and $old_color = $v;
	    $o eq "new-label"			and $new_label = $v;
	    $o eq "old-label"			and $old_label = $v;
	    $o eq "reverse"			and $opt_r = $v;
	    $o eq "swap"			and $opt_s = $v;
	    $o eq "threshold"			and $opt_t = $v;
	    $o eq "unified"			and $opt_u = $v;
	    $o eq "unified"			and $opt_u = $v;
	    $o eq "utf-8"			and $opt_U = $v;
	    $o eq "verbose"			and $opt_v = $v;

	    if ($o eq "out") {
		open   $fh, ">", $v or die "Cannot select out: $!\n";
		select $fh;
		}
	    }
	}

    set_options ();
    $emacs and @_ == 0 && -f $f1 && -f "$f1~" and ($f1, $f2) = ("$f1~", $f1);

    $f1 eq "-" && $f2 eq "-" and usage (1);

        binmode STDERR, ":encoding(utf-8)";

    if ($opt_U) {
	binmode STDIN,  ":encoding(utf-8)";
	binmode STDOUT, ":encoding(utf-8)";
	}

    my @d1 = ref $f1 eq "ARRAY" ? @$f1 : $f1 eq "-" ? <STDIN> : do {
	open my $fh, "<", $f1 or die "$f1: $!\n";
	$opt_U and binmode $fh, ":encoding(utf-8)";
	<$fh>;
	};
    my @d2 = ref $f2 eq "ARRAY" ? @$f2 : $f2 eq "-" ? <STDIN> : do {
	open my $fh, "<", $f2 or die "$f2: $!\n";
	$opt_U and binmode $fh, ":encoding(utf-8)";
	<$fh>;
	};
    if ($opt_H) {
	my $hc = "";
	if ($opt_H =~ m/^\w\w+/) {
	    my ($hfg, $hbg) = split m/_?(?=on_)/ => lc $opt_H =~ s/\s+/_/gr;
	    $hfg && defined $clr{$hfg} and $hc .= $clr{$hfg};
	    $hbg && defined $clr{$hbg} and $hc .= $clr{$hbg};
	    }
	my $nl = max length $f1, length $f2, 7;
	my $sl = $hc ? ($ENV{COLUMNS} || 80) - 4 - $nl : 1;
	my $hi = -1;
	my @hi = ($old_label, $new_label);
	my @h  = map { $hi++; -f $_
	    ? { tag   => "",
		name  => $_,
		stamp => scalar localtime ((stat $_)[9]),
		}
	    : { tag   => "",
		name  => $hi[$hi] // "*STDIN",
		stamp => scalar localtime,
		}
	    } $f1, $f2;
	if (defined $opt_u) {
	    ($h[0]{tag}, $h[1]{tag}) = ("---", "+++");
	    $sl -= 2;
	    printf "%s%s %-*s %-*s%s\n", $hc, $_->{tag},
		$nl, $_->{name}, $sl, $_->{stamp}, $clr{reset} for @h;
	    }
	#elsif ($opt_c) { # diff -c also provides (ugly) headers, but opt_c is NYI
	#   }
	else {
	    ($h[0]{tag}, $h[1]{tag}) = ("<", ">");
	    printf "%s%s %-*s %-*s%s\n", $hc, $_->{tag},
		$nl, $_->{name}, $sl, $_->{stamp}, $clr{reset} for @h;
	    }
	}

    my $diff = $diff_class->new (\@d1, \@d2, $cmp_sub);
    $diff->Base (1);

    my ($N, $idx, @s) = (0, 0);
    while ($diff->Next) {
	$N++;
	if ($diff->Same) {
	    if (defined $opt_u) {
		@s = $diff->Items (1);
		$N > 1 and print "$chr_ctx$_" for grep { defined } @s[0..($opt_u - 1)];
		unshift @s, undef while @s < $opt_u;
		}
	    next;
	    }
	my $sep = "";
	my @d  = map {[ $diff->Items ($_) ]} 1, 2;
	my @do = @{$d[0]};
	my @dn = @{$d[1]};

	if ($opt_B and "@do" !~ m/\S/ && "@dn" !~ m/\S/) {
	    # Modify @s for -u?
	    next;